commit b4be1027a73cf4c79e272e599bb2a08ce8095df5 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sat Nov 25 12:52:09 2023 +0800 ; Correct typos * doc/lispref/frames.texi (Window System Selections): Correct documentation typos. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index ca8c79395ed..ec6f7fd9462 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4014,7 +4014,7 @@ Window System Selections selection}. @xref{Cut and Paste,, Cut and Paste, emacs, The GNU Emacs Manual}, for Emacs commands that make use of these selections. This section documents the low-level functions for reading and setting -window-system selections; @xref{Accessing Selections} for +window-system selections; @xref{Accessing Selections}, for documentation concerning selection types and data formats under particular window systems. @@ -4052,7 +4052,7 @@ Window System Selections The @var{data-type} argument specifies the form of data conversion to use, to convert the raw data obtained from another program into Lisp -data. @xref{X Selections} for an enumeration of data types valid +data. @xref{X Selections}, for an enumeration of data types valid under X, and @xref{Other Selections} for those elsewhere. @end defun commit 207ee7f9880c72920d4b323d7d6ed16544ba948b Author: Po Lu Date: Sat Nov 25 10:40:13 2023 +0800 Dismiss Android Back key events that are canceled * java/org/gnu/emacs/EmacsWindow.java (onKeyDown): Disregard KEYCODE_BACK events. (onKeyUp): If the event is KEYCODE_BACK, deliver the disregarded key press event, unless FLAG_CANCELED is set. diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 013f09cb756..7d161fdcf88 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -648,6 +648,21 @@ private static class Coordinate long serial; String characters; + if (keyCode == KeyEvent.KEYCODE_BACK) + { + /* New Android systems display Back navigation buttons on a + row of virtual buttons at the bottom of the screen. These + buttons function much as physical buttons do, in that key + down events are produced when a finger taps them, even if + the finger is not ultimately released after the OS's + gesture navigation is activated. + + Deliver onKeyDown events in onKeyUp instead, so as not to + navigate backwards during gesture navigation. */ + + return; + } + state = eventModifiers (event); /* Ignore meta-state understood by Emacs for now, or key presses @@ -677,7 +692,7 @@ private static class Coordinate public void onKeyUp (int keyCode, KeyEvent event) { - int state, state_1; + int state, state_1, unicode_char; long time; /* Compute the event's modifier mask. */ @@ -691,11 +706,21 @@ private static class Coordinate = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK); - EmacsNative.sendKeyRelease (this.handle, - event.getEventTime (), - state, keyCode, - getEventUnicodeChar (event, - state_1)); + unicode_char = getEventUnicodeChar (event, state_1); + + if (keyCode == KeyEvent.KEYCODE_BACK) + { + /* If the key press's been canceled, return immediately. */ + + if ((event.getFlags () & KeyEvent.FLAG_CANCELED) != 0) + return; + + EmacsNative.sendKeyPress (this.handle, event.getEventTime (), + state, keyCode, unicode_char); + } + + EmacsNative.sendKeyRelease (this.handle, event.getEventTime (), + state, keyCode, unicode_char); if (keyCode == KeyEvent.KEYCODE_VOLUME_DOWN) { commit 505edceaf44a9d4e072975473170a674b949e504 Author: Spencer Baugh Date: Tue Nov 21 10:11:52 2023 -0500 Use the project--list as history when prompting for a project The project--list is already ordered such that the most recently used projects are at the front. Now we use it as the minibuffer history when prompting for a project. To avoid savehist from picking up project--list as a minibuffer history variable and overriding our own persistence mechanism, we don't pass project--list directly as a history variable, but instead pass project--dir-history or project--name-history, dynamically-bound to an appropriate value. project--dir-history and project--name-history won't be persisted since they're always unbound at the top level; but if they are persisted anyway somehow, it won't affect us. If we later find a way to rely on savehist for persistence instead of having our own mechanism, we can change the in-memory format of project--list to be just a list of directories, and our explicit calls to project--add-dir can be replaced by let-binding history-delete-duplicates=t, history-length=t. * lisp/progmodes/project.el (project--remember-dir): Add. (project-remember-project): Use project--remember-dir. (project--name-history, project-prompt-project-name) (project--dir-history, project-prompt-project-dir): Pass a preprocessed project--list as HIST to completing-read. (bug#67310) (project-switch-project): Call project--remember-dir. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 95db9d0ef4c..bdf8aab003b 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1721,13 +1721,12 @@ project--write-project-list (current-buffer))) (write-region nil nil filename nil 'silent)))) -;;;###autoload -(defun project-remember-project (pr &optional no-write) - "Add project PR to the front of the project list. +(defun project--remember-dir (root &optional no-write) + "Add project root ROOT to the front of the project list. Save the result in `project-list-file' if the list of projects has changed, and NO-WRITE is nil." (project--ensure-read-project-list) - (let ((dir (abbreviate-file-name (project-root pr)))) + (let ((dir (abbreviate-file-name root))) (unless (equal (caar project--list) dir) (dolist (ent project--list) (when (equal dir (car ent)) @@ -1736,6 +1735,13 @@ project-remember-project (unless no-write (project--write-project-list))))) +;;;###autoload +(defun project-remember-project (pr &optional no-write) + "Add project PR to the front of the project list. +Save the result in `project-list-file' if the list of projects +has changed, and NO-WRITE is nil." + (project--remember-dir (project-root pr) no-write)) + (defun project--remove-from-project-list (project-root report-message) "Remove directory PROJECT-ROOT of a missing project from the project list. If the directory was in the list before the removal, save the @@ -1757,6 +1763,8 @@ project-forget-project (project--remove-from-project-list project-root "Project `%s' removed from known projects")) +(defvar project--dir-history) + (defun project-prompt-project-dir () "Prompt the user for a directory that is one of the known project roots. The project is chosen among projects known from the project list, @@ -1769,27 +1777,37 @@ project-prompt-project-dir ;; completion style). (project--file-completion-table (append project--list `(,dir-choice)))) + (project--dir-history (project-known-project-roots)) (pr-dir "")) (while (equal pr-dir "") ;; If the user simply pressed RET, do this again until they don't. - (setq pr-dir (completing-read "Select project: " choices nil t))) + (setq pr-dir + (let (history-add-new-input) + (completing-read "Select project: " choices nil t nil 'project--dir-history)))) (if (equal pr-dir dir-choice) (read-directory-name "Select directory: " default-directory nil t) pr-dir))) +(defvar project--name-history) + (defun project-prompt-project-name () "Prompt the user for a project, by name, that is one of the known project roots. The project is chosen among projects known from the project list, see `project-list-file'. It's also possible to enter an arbitrary directory not in the list." (let* ((dir-choice "... (choose a dir)") + project--name-history (choices (let (ret) - (dolist (dir (project-known-project-roots)) + ;; Iterate in reverse order so project--name-history is in + ;; the correct order. + (dolist (dir (reverse (project-known-project-roots))) ;; we filter out directories that no longer map to a project, ;; since they don't have a clean project-name. - (if-let (proj (project--find-in-directory dir)) - (push (cons (project-name proj) proj) ret))) + (when-let (proj (project--find-in-directory dir)) + (let ((name (project-name proj))) + (push name project--name-history) + (push (cons name proj) ret)))) ret)) ;; XXX: Just using this for the category (for the substring ;; completion style). @@ -1798,7 +1816,9 @@ project-prompt-project-name (pr-name "")) (while (equal pr-name "") ;; If the user simply pressed RET, do this again until they don't. - (setq pr-name (completing-read "Select project: " table nil t))) + (setq pr-name + (let (history-add-new-input) + (completing-read "Select project: " table nil t nil 'project--name-history)))) (if (equal pr-name dir-choice) (read-directory-name "Select directory: " default-directory nil t) (let ((proj (assoc pr-name choices))) @@ -2064,6 +2084,7 @@ project-switch-project When called in a program, it will use the project corresponding to directory DIR." (interactive (list (funcall project-prompter))) + (project--remember-dir dir) (let ((command (if (symbolp project-switch-commands) project-switch-commands (project--switch-project-command))) commit 2ed9c9f1b3230bb99b60646fe1cf46664453f693 Author: F. Jason Park Date: Thu Oct 7 14:26:36 2021 +0200 Optionally allow substitution patterns in erc-prompt * etc/ERC-NEWS: Add entry for `erc-prompt-format'. * lisp/erc/erc-compat.el (erc-compat--defer-format-spec-in-buffer): New macro to wrap `format-spec' specification values in functions that run in the current buffer and fall back to the empty string. * lisp/erc/erc.el (erc-prompt): Add predefined Custom choice for function type in `erc-prompt-format'. (erc--prompt-format-face-example): New "pre-propertized" value for option `erc-prompt-format'. (erc-prompt-format): New companion option for `erc-prompt' choice `erc-prompt-format'. New function of the same name to perform format substitutions and serve as a Custom choice value for `erc-prompt'. Based on work and ideas originally proposed by Stefan Kangas. (erc--away-indicator, erc-away-status-indicator, erc--format-away-indicator): New formatting function and helper variables for displaying short away status. (erc--user-modes-indicator): New variable. (erc--format-user-modes): New function. (erc--format-channel-status-prefix): New function. (erc--format-modes): New function. * test/lisp/erc/erc-scenarios-prompt-format.el: New file. (Bug#51082) Co-authored-by: Stefan Kangas diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 32272208704..7b39af03a88 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -191,6 +191,16 @@ been restored with a slightly revised role contingent on a few assumptions explained in its doc string. For clarity, it has been renamed 'erc-ensure-target-buffer-on-privmsg'. +** A smarter, more responsive prompt. +ERC's prompt can be told to respond dynamically to incoming and +outgoing messages by leveraging the familiar function variant of the +option 'erc-prompt'. With this release, only predefined functions can +take full advantage of this new dynamism, but an interface to empower +third parties with the same possibilities may follow suit. To get +started, customize 'erc-prompt' to 'erc-prompt-format', and see the +option of the same name ('erc-prompt-format') for a rudimentary +templating facility reminiscent of 'erc-mode-line-format'. + ** Module 'scrolltobottom' now optionally more aggressive. Enabling the experimental option 'erc-scrolltobottom-all' makes ERC more vigilant about staking down the input area in all ERC windows. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 4c376cfbc22..e0f6e9b5134 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -459,6 +459,26 @@ erc-compat--current-lisp-time '(let (current-time-list) (current-time)) '(current-time))) +(defmacro erc-compat--defer-format-spec-in-buffer (&rest spec) + "Transform SPEC forms into functions that run in the current buffer. +For convenience, ensure function wrappers return \"\" as a +fallback." + (cl-check-type (car spec) cons) + (let ((buffer (make-symbol "buffer"))) + `(let ((,buffer (current-buffer))) + ,(list '\` + (mapcar + (pcase-lambda (`(,k . ,v)) + (cons k + (list '\,(if (>= emacs-major-version 29) + `(lambda () + (or (if (eq ,buffer (current-buffer)) + ,v + (with-current-buffer ,buffer + ,v)) + "")) + `(or ,v ""))))) + spec))))) (provide 'erc-compat) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8cd69d1431e..a2f4562d333 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -751,7 +751,74 @@ erc-string-no-properties (defcustom erc-prompt "ERC>" "Prompt used by ERC. Trailing whitespace is not required." :group 'erc-display - :type '(choice string function)) + :type '(choice string + (function-item :tag "Interpret format specifiers" + erc-prompt-format) + function)) + +(defvar erc--prompt-format-face-example + #("%p%m%a\u00b7%b>" + 0 2 (font-lock-face erc-my-nick-prefix-face) + 2 4 (font-lock-face font-lock-keyword-face) + 4 6 (font-lock-face erc-error-face) + 6 7 (font-lock-face shadow) + 7 9 (font-lock-face font-lock-constant-face) + 9 10 (font-lock-face shadow)) + "An example value for option `erc-prompt-format' with faces.") + +(defcustom erc-prompt-format erc--prompt-format-face-example + "Format string when `erc-prompt' is `erc-prompt-format'. +ERC recognizes these substitution specifiers: + + %a - away indicator + %b - buffer name + %t - channel or query target, server domain, or dialed address + %S - target@network or buffer name + %s - target@server or server + %N - current network, like Libera.Chat + %p - channel membership prefix, like @ or + + %n - current nickname + %c - channel modes with args for select modes + %C - channel modes with all args + %u - user modes + %m - channel modes sans args in channels, user modes elsewhere + %M - like %m but show nothing in query buffers + +To pick your own colors, do something like: + + (setopt erc-prompt-format + (concat + (propertize \"%b\" \\='font-lock-face \\='erc-input-face) + (propertize \"%a\" \\='font-lock-face \\='erc-error-face))) + +Please remember that ERC ignores this option completely unless +the \"parent\" option `erc-prompt' is set to `erc-prompt-format'." + :package-version '(ERC . "5.6") + :group 'erc-display + :type `(choice (const :tag "{Prefix}{Mode}{Away}{MIDDLE DOT}{Buffer}>" + ,erc--prompt-format-face-example) + string)) + +(defun erc-prompt-format () + "Make predefined `format-spec' substitutions. + +See option `erc-prompt-format' and option `erc-prompt'." + (format-spec erc-prompt-format + (erc-compat--defer-format-spec-in-buffer + (?C erc--channel-modes 3 ",") + (?M erc--format-modes 'no-query-p) + (?N erc-format-network) + (?S erc-format-target-and/or-network) + (?a erc--format-away-indicator) + (?b buffer-name) + (?c erc-format-channel-modes) + (?m erc--format-modes) + (?n erc-current-nick) + (?p erc--format-channel-status-prefix) + (?s erc-format-target-and/or-server) + (?t erc-format-target) + (?u erc--format-user-modes)) + 'ignore-missing)) ; formerly `only-present' (defun erc-prompt () "Return the input prompt as a string. @@ -8311,6 +8378,62 @@ erc-format-away-status (format-time-string erc-mode-line-away-status-format a) ""))) +(defvar-local erc--away-indicator nil + "Cons containing an away indicator for the connection.") + +(defvar erc-away-status-indicator "A" + "String shown by various formatting facilities to indicate away status. +Currently only used by the option `erc-prompt-format'.") + +(defun erc--format-away-indicator () + "Return char with `display' property of `erc--away-indicator'." + (and-let* ((indicator (erc-with-server-buffer + (or erc--away-indicator + (setq erc--away-indicator (list ""))))) + (newcar (if (erc-away-time) erc-away-status-indicator ""))) + ;; Inform other buffers of the change when necessary. + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (eq newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(away?)" 'display indicator) + newcar)))) + +(defvar-local erc--user-modes-indicator nil + "Cons containing connection-wide indicator for user modes.") + +;; If adding more of these functions, should factor out commonalities. +;; As of ERC 5.6, this is identical to the away variant aside from +;; the var names and `eq', which isn't important. +(defun erc--format-user-modes () + "Return server's user modes as a string" + (and-let* ((indicator (erc-with-server-buffer + (or erc--user-modes-indicator + (setq erc--user-modes-indicator (list ""))))) + (newcar (erc--user-modes 'string))) + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (string= newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(user-modes?)" 'display indicator) + newcar)))) + +(defun erc--format-channel-status-prefix () + "Return the current channel membership prefix." + (and (erc--target-channel-p erc--target) + (erc-get-user-mode-prefix (erc-current-nick)))) + +(defun erc--format-modes (&optional no-query-p) + "Return a string of channel modes in channels and user modes elsewhere. +With NO-QUERY-P, return nil instead of user modes in query +buffers. Also return nil when mode information is unavailable." + (cond ((erc--target-channel-p erc--target) + (erc--channel-modes 'string)) + ((not (and erc--target no-query-p)) + (erc--format-user-modes)))) + (defun erc-format-channel-modes () "Return the current channel's modes." (concat (apply #'concat diff --git a/test/lisp/erc/erc-scenarios-prompt-format.el b/test/lisp/erc/erc-scenarios-prompt-format.el new file mode 100644 index 00000000000..7eccb859dbc --- /dev/null +++ b/test/lisp/erc/erc-scenarios-prompt-format.el @@ -0,0 +1,117 @@ +;;; erc-scenarios-prompt-format.el --- erc-prompt-format-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2023 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-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(defvar erc-fill-wrap-align-prompt) +(defvar erc-fill-wrap-use-pixels) + +(defun erc-scenarios-prompt-format--assert (needle &rest props) + (save-excursion + (goto-char erc-insert-marker) + (should (search-forward needle nil t)) + (pcase-dolist (`(,k . ,v) props) + (should (equal (get-text-property (point) k) v))))) + +;; This makes assertions about the option `erc-fill-wrap-align-prompt' +;; as well as the standard value of `erc-prompt-format'. One minor +;; omission is that this doesn't check behavior in query buffers. +(ert-deftest erc-scenarios-prompt-format () + :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 'chan-changed)) + (erc-modules (cons 'fill-wrap erc-modules)) + (erc-fill-wrap-align-prompt t) + (erc-fill-wrap-use-pixels nil) + (erc-prompt #'erc-prompt-format) + (erc-autojoin-channels-alist '((Libera.Chat "#chan"))) + (expect (erc-d-t-make-expecter)) + ;; Collect samples of `line-prefix' to verify deltas as the + ;; prompt grows and shrinks. + (line-prefixes nil) + (stash-pfx (lambda () + (pcase (get-text-property erc-insert-marker 'line-prefix) + (`(space :width (- erc-fill--wrap-value ,n)) + (car (push n line-prefixes))))))) + + (ert-info ("Connect to Libera.Chat") + (with-current-buffer (erc :server "127.0.0.1" + :port (process-contact dumb-server :service) + :nick "tester" + :full-name "tester") + (funcall expect 5 "Welcome to the Libera.Chat") + (funcall stash-pfx) + (funcall expect 5 "changed mode") + ;; New prompt is shorter than default with placeholders, like + ;; "(foo?)(bar?)" (assuming we win the inherent race). + (should (>= (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "user-" '(display . ("Ziw"))))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (should-not erc-channel-key) + (should-not erc-channel-user-limit) + + (ert-info ("Receive notice that mode has changed") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))) + (funcall stash-pfx) + (erc-scenarios-common-say "ready before") + (funcall expect 10 " has changed mode for #chan to +Qu") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u"))) + ;; Prompt is longer now, so too is the `line-prefix' subtrahend. + (should (< (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "Qntu") + (erc-scenarios-prompt-format--assert "#chan>")) + + (ert-info ("Key stored locally") + (erc-scenarios-common-say "ready key") + (funcall expect 10 " has changed mode for #chan to +k hunter2") + ;; Prompt has grown by 1. + (should (< (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "Qkntu")) + + (ert-info ("Limit stored locally") + (erc-scenarios-common-say "ready limit") + (funcall expect 10 " has changed mode for #chan to +l 3") + (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3)) + (should (equal erc-channel-modes '("Q" "n" "t" "u"))) + ;; Prompt has grown by 1 again. + (should (< (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "Qklntu")) + + (ert-info ("Modes removed and local state deletion succeeds") + (erc-scenarios-common-say "ready drop") + (funcall expect 10 " has changed mode for #chan to -lu") + (funcall expect 10 " has changed mode for #chan to -Qk *") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))) + ;; Prompt has shrunk. + (should (> (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "nt")) + + (should-not erc-channel-key) + (should-not erc-channel-user-limit) + (funcall expect 10 " after")))) + +;;; erc-scenarios-prompt-format.el ends here commit 7cbe6ae7124cade32bce1268212e2279dcb6df20 Author: F. Jason Park Date: Sun Nov 19 17:18:29 2023 -0800 Add merged-message indicator option for erc-fill-wrap * lisp/erc/erc-fill.el (erc-fill): Use `when-let' instead of `when-let*'. (erc-fill-wrap-merge): Mention companion options in doc string. (erc-fill-wrap-merge-indicator): New option to display a distinguishing "indicator" in the form of a one-character string between messages from the same speaker. (erc-fill-wrap-mode, erc-fill-wrap-disable): Mention `erc-fill-wrap-merge-indicator' in doc string and kill related local variables. (erc-fill--wrap-merge-indicator-pre, erc-fill--wrap-merge-indicator-post): New internal variables for caching merge indicator. (erc-fill--wrap-insert-merged-post, erc-fill--wrap-insert-merged-pre): New functions for adding merge indicators either before or after a message. (erc-fill-wrap): Add logic for deferring to merge-indicator helpers when needed. * test/lisp/erc/erc-fill-tests.el (erc-fill-wrap-tests--merge-action, erc-fill-wrap--merge-action): Move body of latter test into former, a new fixture function. (erc-fill-wrap--merge-action/indicator-pre, erc-fill-wrap--merge-action/indicator-post): New tests. * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld: New test data file. * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld: New test data file. (Bug#60936) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 50b5aefd27a..83f60fd3162 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -173,8 +173,8 @@ erc-fill (save-restriction (narrow-to-region (point) (point-max)) (funcall (or erc-fill--function erc-fill-function)) - (when-let* ((erc-fill-line-spacing) - (p (point-min))) + (when-let ((erc-fill-line-spacing) + (p (point-min))) (widen) (when (or (erc--check-msg-prop 'erc-msg 'msg) (and-let* ((m (save-excursion @@ -258,12 +258,41 @@ erc-fill-wrap-force-screen-line-movement :type '(set (const nil) (const non-input))) (defcustom erc-fill-wrap-merge t - "Whether to consolidate messages from the same speaker. -This tells ERC to omit redundant speaker labels for subsequent -messages less than a day apart." + "Whether to consolidate consecutive messages from the same speaker. +When non-nil, ERC omits redundant speaker labels for subsequent +messages less than a day apart. To help distinguish between +merged messages, see related options `erc-fill-line-spacing', for +graphical displays, and `erc-fill-wrap-merge-indicator' for text +terminals." :package-version '(ERC . "5.6") :type 'boolean) +(defcustom erc-fill-wrap-merge-indicator nil + "Indicator to help distinguish between merged messages. +Only matters when the option `erc-fill-wrap-merge' is enabled. +If the first element is the symbol `pre', ERC uses this option to +generate a replacement for the speaker's name tag. If the first +element is `post', ERC affixes a short string to the end of the +previous message. (Note that the latter variant nullifies any +intervening padding supplied by `erc-fill-line-spacing' and is +meant to supplant that option in text terminals.) In either +case, the second element should be a character, like ?>, and the +last element a valid face. When in doubt, try the first prefab +choice, (pre #xb7 shadow), which replaces a continued speaker's +name with a nondescript dot-product-like glyph in `shadow' face. +This option is currently experimental, and changing its value +mid-session is not supported." + :package-version '(ERC . "5.6") + :type '(choice (const nil) + (const :tag "Leading MIDDLE DOT as speaker (U+00B7)" + (pre #xb7 shadow)) + (const :tag "Trailing PARAGRAPH SIGN (U+00B6)" + (post #xb6 shadow)) + (const :tag "Leading > as speaker" (pre ?> shadow)) + (const :tag "Trailing ~" (post ?~ shadow)) + (list :tag "User-provided" + (choice (const pre) (const post)) character face))) + (defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args) (apply (pcase erc-fill--wrap-visual-keys ('non-input @@ -417,7 +446,8 @@ fill-wrap 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-line-spacing' and `erc-fill-wrap-merge'. +`erc-fill-line-spacing', `erc-fill-wrap-merge', and +`erc-fill-wrap-merge-indicator'. This module imposes various restrictions on the appearance of timestamps. Most notably, it insists on displaying them in the @@ -471,6 +501,8 @@ fill-wrap (kill-local-variable 'erc-fill--wrap-visual-keys) (kill-local-variable 'erc-fill--wrap-last-msg) (kill-local-variable 'erc--inhibit-prompt-display-property-p) + (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) + (kill-local-variable 'erc-fill--wrap-merge-indicator-post) (remove-hook 'erc--refresh-prompt-hook #'erc-fill--wrap-indent-prompt) (remove-hook 'erc-button--prev-next-predicate-functions @@ -550,6 +582,49 @@ erc-fill--wrap-measure (defvar erc-fill--wrap-action-dedent-p t "Whether to dedent speakers in CTCP \"ACTION\" lines.") +(defvar-local erc-fill--wrap-merge-indicator-pre nil) +(defvar-local erc-fill--wrap-merge-indicator-post nil) + +;; To support `erc-fill-line-spacing' with the "post" variant, we'd +;; need to use a new "replacing" `display' spec value for each +;; insertion, and add a sentinel property alongside it atop every +;; affected newline, e.g., (erc-fill-eol-display START-POS), where +;; START-POS is the position of the newline in the replacing string. +;; Then, upon spotting this sentinel in `erc-fill' (and maybe +;; `erc-fill-wrap-refill-buffer'), we'd add `line-spacing' to the +;; corresponding `display' replacement, starting at START-POS. +(defun erc-fill--wrap-insert-merged-post () + "Add `display' property at end of previous line." + (save-excursion + (goto-char (point-min)) + (save-restriction + (widen) + (cl-assert (= ?\n (char-before (point)))) + (unless erc-fill--wrap-merge-indicator-pre + (let ((option erc-fill-wrap-merge-indicator)) + (setq erc-fill--wrap-merge-indicator-pre + (propertize (concat (string (nth 1 option)) "\n") + 'font-lock-face (nth 2 option))))) + (unless (eq (field-at-pos (- (point) 2)) 'erc-timestamp) + (put-text-property (1- (point)) (point) + 'display erc-fill--wrap-merge-indicator-pre))) + 0)) + +(defun erc-fill--wrap-insert-merged-pre () + "Add `display' property in lieu of speaker." + (if erc-fill--wrap-merge-indicator-post + (progn + (put-text-property (point-min) (point) 'display + (car erc-fill--wrap-merge-indicator-post)) + (cdr erc-fill--wrap-merge-indicator-post)) + (let* ((option erc-fill-wrap-merge-indicator) + (s (concat (propertize (string (nth 1 option)) + 'font-lock-face (nth 2 option)) + " "))) + (put-text-property (point-min) (point) 'display s) + (cdr (setq erc-fill--wrap-merge-indicator-post + (cons s (erc-fill--wrap-measure (point-min) (point)))))))) + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -583,7 +658,11 @@ erc-fill-wrap (erc-fill--wrap-continued-message-p)) (put-text-property (point-min) (point) 'display "") - 0) + (if erc-fill-wrap-merge-indicator + (pcase (car erc-fill-wrap-merge-indicator) + ('pre (erc-fill--wrap-insert-merged-pre)) + ('post (erc-fill--wrap-insert-merged-post))) + 0)) (t (erc-fill--wrap-measure (point-min) (point)))))))) (add-text-properties diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index c21f3935503..bfdf8cd7320 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -294,8 +294,7 @@ erc-fill-wrap--merge (erc-fill-tests--simulate-refill) ; idempotent (erc-fill-tests--compare "merge-02-right")))))) -(ert-deftest erc-fill-wrap--merge-action () - :tags '(:unstable) +(defun erc-fill-wrap-tests--merge-action (compare-file) (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) @@ -336,7 +335,23 @@ erc-fill-wrap--merge-action (should (= erc-fill--wrap-value 27)) (erc-fill-tests--wrap-check-prefixes "*** " " " " " " " "* bob " " " "* " " ") - (erc-fill-tests--compare "merge-wrap-01")))) + (erc-fill-tests--compare compare-file)))) + +(ert-deftest erc-fill-wrap--merge-action () + :tags '(:unstable) + (erc-fill-wrap-tests--merge-action "merge-wrap-01")) + +(ert-deftest erc-fill-wrap--merge-action/indicator-pre () + :tags '(:unstable) + (let ((erc-fill-wrap-merge-indicator '(pre ?> shadow))) + (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-pre-01"))) + +;; One crucial thing this test asserts is that the indicator is +;; omitted when the previous line ends in a stamp. +(ert-deftest erc-fill-wrap--merge-action/indicator-post () + :tags '(:unstable) + (let ((erc-fill-wrap-merge-indicator '(post ?~ shadow))) + (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-post-01"))) (ert-deftest erc-fill-line-spacing () :tags '(:unstable) 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 new file mode 100644 index 00000000000..893588c028f --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld @@ -0,0 +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-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-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-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-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 msg 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-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-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 msg 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-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 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 new file mode 100644 index 00000000000..2b67cbbf90e --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld @@ -0,0 +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-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-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-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-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 msg 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-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-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 msg 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-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 commit 8bb68a522f3aad104b68ca4e479f4ccc3fc6cb03 Author: F. Jason Park Date: Sun Nov 19 17:18:29 2023 -0800 Optionally align prompt to prefix in erc-fill-wrap * lisp/erc/erc-fill.el (erc-fill-wrap-align-prompt): New option for aligning prompt with leading portion of messages at the common "static center" pivot-column barrier, so it appears "dedented" along with all speaker name tags. Tests for this functionality appear in the subsequent patch of this same change set. (erc-fill-wrap-use-pixels): Demote from user option to normal variable because it has no practical use other than for testing. Don't rename as internal variable to spare the improbable user of ERC on HEAD who's already customized this. (erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): Take care to disable prompt-in-left-margin behavior when option `erc-fill-wrap-align-prompt' is non-nil. (erc-fill--wrap-measure): Improve doc string and always attempt to leverage `buffer-text-pixel-size', even when the variable `erc-fill-wrap-use-pixels' is nil. (erc-fill--wrap-indent-prompt): New function to massage prompt `line-prefix' after updates, such as changes to away status. (Bug#51082) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index e48d5540c86..50b5aefd27a 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -138,6 +138,11 @@ erc-fill-wrap-margin-side :package-version '(ERC . "5.6") :type '(choice (const nil) (const left) (const right))) +(defcustom erc-fill-wrap-align-prompt nil + "Whether to align the prompt at the common `wrap-prefix'." + :package-version '(ERC . "5.6") + :type 'boolean) + (defcustom erc-fill-line-spacing nil "Extra space between messages on graphical displays. Its value should be larger than that of the variable @@ -223,13 +228,11 @@ erc-fill-variable (defvar-local erc-fill--wrap-value nil) (defvar-local erc-fill--wrap-visual-keys nil) -(defcustom erc-fill-wrap-use-pixels t +(defvar erc-fill-wrap-use-pixels t "Whether to calculate padding in pixels when possible. A value of nil means ERC should use columns, which may happen regardless, depending on the Emacs version. This option only -matters when `erc-fill-wrap-mode' is enabled." - :package-version '(ERC . "5.6") - :type 'boolean) +matters when `erc-fill-wrap-mode' is enabled.") (defcustom erc-fill-wrap-visual-keys 'non-input "Whether to retain keys defined by `visual-line-mode'. @@ -448,6 +451,13 @@ fill-wrap (or (eq erc-fill-wrap-margin-side 'left) (eq (default-value 'erc-insert-timestamp-function) #'erc-insert-timestamp-left))) + (when erc-fill-wrap-align-prompt + (add-hook 'erc--refresh-prompt-hook + #'erc-fill--wrap-indent-prompt nil t)) + (when erc-stamp--margin-left-p + (if erc-fill-wrap-align-prompt + (setq erc-stamp--skip-left-margin-prompt-p t) + (setq erc--inhibit-prompt-display-property-p t))) (setq erc-fill--function #'erc-fill-wrap) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions @@ -460,6 +470,9 @@ fill-wrap (kill-local-variable 'erc-fill--function) (kill-local-variable 'erc-fill--wrap-visual-keys) (kill-local-variable 'erc-fill--wrap-last-msg) + (kill-local-variable 'erc--inhibit-prompt-display-property-p) + (remove-hook 'erc--refresh-prompt-hook + #'erc-fill--wrap-indent-prompt) (remove-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p t)) 'local) @@ -515,15 +528,20 @@ erc-fill--wrap-continued-message-p (defun erc-fill--wrap-measure (beg end) "Return display spec width for inserted region between BEG and END. -Ignore any `invisible' props that may be present when figuring." - (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size)) +Ignore any `invisible' props that may be present when figuring. +Expect the target region to be free of `line-prefix' and +`wrap-prefix' properties, and expect `display-line-numbers-mode' +to be disabled." + (if (fboundp 'buffer-text-pixel-size) ;; `buffer-text-pixel-size' can move point! (save-excursion (save-restriction (narrow-to-region beg end) (let* ((buffer-invisibility-spec) (rv (car (buffer-text-pixel-size)))) - (if (zerop rv) 0 (list rv))))) + (if erc-fill-wrap-use-pixels + (if (zerop rv) 0 (list rv)) + (/ rv (frame-char-width)))))) (- end beg))) ;; An escape hatch for third-party code expecting speakers of ACTION @@ -575,6 +593,21 @@ erc-fill-wrap 'erc-fill--wrap-value)) wrap-prefix (space :width erc-fill--wrap-value)))))) +(defun erc-fill--wrap-indent-prompt () + "Recompute the `line-prefix' of the prompt." + ;; Clear an existing `line-prefix' before measuring (bug#64971). + (remove-text-properties erc-insert-marker erc-input-marker + '(line-prefix nil wrap-prefix nil)) + ;; Restoring window configuration seems to prevent unwanted + ;; recentering reminiscent of `scrolltobottom'-related woes. + (let ((c (and (get-buffer-window) (current-window-configuration))) + (len (erc-fill--wrap-measure erc-insert-marker erc-input-marker))) + (when c + (set-window-configuration c)) + (put-text-property erc-insert-marker erc-input-marker + 'line-prefix + `(space :width (- erc-fill--wrap-value ,len))))) + (defvar erc-fill--wrap-rejigger-last-message nil "Temporary working instance of `erc-fill--wrap-last-msg'.") commit 0d6c8d41ab7172a496c6db951c270821807dce99 Author: F. Jason Park Date: Sat Nov 18 23:44:20 2023 -0800 Use overlay instead of text prop to hide ERC's prompt * lisp/erc/erc-backend.el (erc--hidden-prompt-overlay): New variable, a buffer-local handle for the prompt overlay. (erc--reveal-prompt): Delete overlay instead of text prop. (erc--conceal-prompt): Add overlay instead of text prop. (erc--unhide-prompt): Run `erc--refresh-prompt-hook' after revealing. (erc--hide-prompt): Run `erc--refresh-prompt-hook' after hiding. * lisp/erc/erc-stamp.el (erc-stamp--adjust-margin): Attempt a more accurate estimate of the prompt's width in columns when initially setting left-margin. (erc-stamp--skip-left-margin-prompt-p): New variable to inhibit normal behavior of displaying prompt in left margin. (erc-stamp--display-margin-mode): Allow opting out of prompt-in-left-margin behavior. (erc--reveal-prompt): Delete unneeded method implementation. (erc--conceal-prompt): Put overlay in margin. * test/lisp/erc/erc-tests.el (erc-hide-prompt): Use `get-char-property' instead of `get-text-property' in order to accommodate overlay-based prompt hiding. (Bug#51082) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 371b4591915..7ff55de0d0c 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1043,13 +1043,20 @@ erc-process-sentinel-1 ;; unexpected disconnect (erc-process-sentinel-2 event buffer)))) +(defvar-local erc--hidden-prompt-overlay nil + "Overlay for hiding the prompt when disconnected.") + (cl-defmethod erc--reveal-prompt () - (remove-text-properties erc-insert-marker erc-input-marker - '(display nil))) + (when erc--hidden-prompt-overlay + (delete-overlay erc--hidden-prompt-overlay) + (setq erc--hidden-prompt-overlay nil))) (cl-defmethod erc--conceal-prompt () - (add-text-properties erc-insert-marker (1- erc-input-marker) - `(display ,erc-prompt-hidden))) + (when-let (((null erc--hidden-prompt-overlay)) + (ov (make-overlay erc-insert-marker (1- erc-input-marker) + nil 'front-advance))) + (overlay-put ov 'display erc-prompt-hidden) + (setq erc--hidden-prompt-overlay ov))) (defun erc--prompt-hidden-p () (and (marker-position erc-insert-marker) @@ -1061,7 +1068,8 @@ erc--unhide-prompt (marker-position erc-input-marker)) (with-silent-modifications (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t) - (erc--reveal-prompt)))) + (erc--reveal-prompt) + (run-hooks 'erc--refresh-prompt-hook)))) (defun erc--unhide-prompt-on-self-insert () (when (and (eq this-command #'self-insert-command) @@ -1086,7 +1094,8 @@ erc--hide-prompt (with-silent-modifications (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt 'hidden) - (erc--conceal-prompt)) + (erc--conceal-prompt) + (run-hooks 'erc--refresh-prompt-hook)) (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t)))) (defun erc-process-sentinel (cproc event) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 6eeb7706a61..e6a8f36c332 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -360,7 +360,18 @@ erc-stamp--adjust-margin (if resetp (or (and (not (zerop cols)) cols) erc-stamp--margin-width - (max (if leftp (string-width (erc-prompt)) 0) + (max (if leftp + (cond ((fboundp 'erc-fill--wrap-measure) + (let* ((b erc-insert-marker) + (e (1- erc-input-marker)) + (w (erc-fill--wrap-measure b e))) + (/ (if (consp w) (car w) w) + (frame-char-width)))) + ((fboundp 'string-pixel-width) + (/ (string-pixel-width (erc-prompt)) + (frame-char-width))) + (t (string-width (erc-prompt)))) + 0) (1+ (string-width (or (if leftp erc-timestamp-last-inserted @@ -407,6 +418,9 @@ erc-stamp-prefix-log-filter (defvar erc-stamp--inherited-props '(line-prefix wrap-prefix) "Extant properties at the start of a message inherited by the stamp.") +(defvar-local erc-stamp--skip-left-margin-prompt-p nil + "Don't display prompt in left margin.") + (declare-function erc--remove-text-properties "erc" (string)) ;; Currently, `erc-insert-timestamp-right' hard codes its display @@ -437,7 +451,8 @@ erc-stamp--display-margin-mode #'erc--remove-text-properties) (add-hook 'erc--setup-buffer-hook #'erc-stamp--refresh-left-margin-prompt nil t) - (when erc-stamp--margin-left-p + (when (and erc-stamp--margin-left-p + (not erc-stamp--skip-left-margin-prompt-p)) (add-hook 'erc--refresh-prompt-hook #'erc-stamp--display-prompt-in-left-margin nil t))) (remove-function (local 'filter-buffer-substring-function) @@ -451,6 +466,7 @@ erc-stamp--display-margin-mode (kill-local-variable (if erc-stamp--margin-left-p 'left-margin-width 'right-margin-width)) + (kill-local-variable 'erc-stamp--skip-left-margin-prompt-p) (kill-local-variable 'fringes-outside-margins) (kill-local-variable 'erc-stamp--margin-left-p) (kill-local-variable 'erc-stamp--margin-width) @@ -485,18 +501,16 @@ erc-stamp--refresh-left-margin-prompt (setq erc-stamp--last-prompt nil)) (erc--refresh-prompt))) -(cl-defmethod erc--reveal-prompt - (&context (erc-stamp--display-margin-mode (eql t)) - (erc-stamp--margin-left-p (eql t))) - (put-text-property erc-insert-marker (1- erc-input-marker) - 'display `((margin left-margin) ,erc-stamp--last-prompt))) - (cl-defmethod erc--conceal-prompt (&context (erc-stamp--display-margin-mode (eql t)) - (erc-stamp--margin-left-p (eql t))) - (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start))) - (put-text-property erc-insert-marker (1- erc-input-marker) - 'display `((margin left-margin) ,prompt)))) + (erc-stamp--margin-left-p (eql t)) + (erc-stamp--skip-left-margin-prompt-p null)) + (when-let (((null erc--hidden-prompt-overlay)) + (prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)) + (ov (make-overlay erc-insert-marker (1- erc-input-marker) + nil 'front-advance))) + (overlay-put ov 'display `((margin left-margin) ,prompt)) + (setq erc--hidden-prompt-overlay ov))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8c85f37dfe5..980928aceac 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -187,101 +187,101 @@ erc-hide-prompt (with-current-buffer "ServNet" (should (= (point) erc-insert-marker)) (erc--hide-prompt erc-server-process) - (should (string= ">" (get-text-property (point) 'display)))) + (should (string= ">" (get-char-property (point) 'display)))) (with-current-buffer "#chan" (goto-char erc-insert-marker) - (should (string= ">" (get-text-property (point) 'display))) + (should (string= ">" (get-char-property (point) 'display))) (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) (goto-char erc-input-marker) (ert-simulate-command '(self-insert-command 1 ?/)) (goto-char erc-insert-marker) - (should-not (get-text-property (point) 'display)) + (should-not (get-char-property (point) 'display)) (should-not (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))) (with-current-buffer "bob" (goto-char erc-insert-marker) - (should (string= ">" (get-text-property (point) 'display))) + (should (string= ">" (get-char-property (point) 'display))) (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) (goto-char erc-input-marker) (ert-simulate-command '(self-insert-command 1 ?/)) (goto-char erc-insert-marker) - (should-not (get-text-property (point) 'display)) + (should-not (get-char-property (point) 'display)) (should-not (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))) (with-current-buffer "ServNet" - (should (get-text-property erc-insert-marker 'display)) + (should (get-char-property erc-insert-marker 'display)) (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) (erc--unhide-prompt) (should-not (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: server") (setq erc-hide-prompt '(server)) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) - (should (string= ">" (get-text-property erc-insert-marker 'display)))) + (should (string= ">" (get-char-property erc-insert-marker 'display)))) (with-current-buffer "#chan" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "ServNet" (erc--unhide-prompt) (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: channel") (setq erc-hide-prompt '(channel)) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "#chan" - (should (string= ">" (get-text-property erc-insert-marker 'display))) + (should (string= ">" (get-char-property erc-insert-marker 'display))) (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) (erc--unhide-prompt) (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: query") (setq erc-hide-prompt '(query)) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should (string= ">" (get-text-property erc-insert-marker 'display))) + (should (string= ">" (get-char-property erc-insert-marker 'display))) (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) (erc--unhide-prompt) (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "#chan" - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: nil") (setq erc-hide-prompt nil) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "#chan" - (should-not (get-text-property erc-insert-marker 'display)) + (should-not (get-char-property erc-insert-marker 'display)) (erc--unhide-prompt) ; won't blow up when prompt already showing - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (when noninteractive (kill-buffer "#chan") commit 3c9cba9df3d392a89314e06a6396c4157065f3b0 Author: F. Jason Park Date: Sat Nov 18 23:04:50 2023 -0800 Don't inherit properties when refreshing ERC's prompt * lisp/erc/erc.el (erc--merge-prop-behind-p): New variable to be dynamically bound around rare calls to `erc--merge-props' when the latter should append to the end of existing list-valued text properties. (erc--inhibit-prompt-display-property-p): New variable to be non-nil in buffers where an active module needs to reserve all uses of the `display' text property in the prompt region for itself. (erc--prompt-properties): Collect all common prompt properties in one place for code reuse and maintenance purposes. (erc--refresh-prompt-continue, erc--refresh-prompt-continue-request): New function and state variable for custom `erc-prompt' functions to indicate to ERC that they need the prompt to be refreshed in all buffers and not just the current one. (erc--refresh-prompt): Merge `erc-prompt-face' behind any applied by a customized `erc-prompt' function value. Crucially, don't inherit properties at the beginning of the prompt because doing so may clobber any added by a custom `erc-prompt' function. Instead, apply known properties from `erc-display-prompt' manually. Integrate `erc--refresh-prompt-continue' logic. (erc--merge-prop): Recognize flag to activate `append' behavior in which new prop values are appended to the tail of existing ones rather than consed in front. This functionality could be extended to arbitrary splices as well. (erc-display-prompt): Use common text properties defined elsewhere. * test/lisp/erc/erc-tests.el (erc--merge-prop): Add assertion for `erc--merge-prop-behind-p' non-nil behavior. (Bug#51082) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0654da5e16d..8cd69d1431e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2993,23 +2993,70 @@ erc--assert-input-bounds (cl-assert (< erc-insert-marker erc-input-marker)) (cl-assert (= (field-end erc-insert-marker) erc-input-marker))))) -(defvar erc--refresh-prompt-hook nil) +(defvar erc--merge-prop-behind-p nil + "When non-nil, put merged prop(s) behind existing.") + +(defvar erc--refresh-prompt-hook nil + "Hook called after refreshing the prompt in the affected buffer.") + +(defvar-local erc--inhibit-prompt-display-property-p nil + "Tell `erc-prompt' related functions to avoid the `display' text prop. +Modules can enable this when needing to reserve the prompt's +display property for some other purpose, such as displaying it +elsewhere, abbreviating it, etc.") + +(defconst erc--prompt-properties '( rear-nonsticky t + erc-prompt t ; t or `hidden' + field erc-prompt + front-sticky t + read-only t) + "Mandatory text properties added to ERC's prompt.") + +(defvar erc--refresh-prompt-continue-request nil + "State flag for refreshing prompt in all buffers. +When the value is zero, functions assigned to the variable +`erc-prompt' can set this to run `erc--refresh-prompt-hook' (1) +or `erc--refresh-prompt' (2) in all buffers of the server.") + +(defun erc--refresh-prompt-continue (&optional hooks-only-p) + "Ask ERC to refresh the prompt in all buffers. +Functions assigned to `erc-prompt' can call this if needing to +recreate the prompt in other buffers as well. With HOOKS-ONLY-P, +run `erc--refresh-prompt-hook' in other buffers instead of doing +a full refresh." + (when (and erc--refresh-prompt-continue-request + (zerop erc--refresh-prompt-continue-request)) + (setq erc--refresh-prompt-continue-request (if hooks-only-p 1 2)))) (defun erc--refresh-prompt () "Re-render ERC's prompt when the option `erc-prompt' is a function." (erc--assert-input-bounds) (unless (erc--prompt-hidden-p) - (when (functionp erc-prompt) - (save-excursion - (goto-char erc-insert-marker) - (set-marker-insertion-type erc-insert-marker nil) - ;; Avoid `erc-prompt' (the named function), which appends a - ;; space, and `erc-display-prompt', which propertizes all but - ;; that space. - (insert-and-inherit (funcall erc-prompt)) - (set-marker-insertion-type erc-insert-marker t) - (delete-region (point) (1- erc-input-marker)))) - (run-hooks 'erc--refresh-prompt-hook))) + (let ((erc--refresh-prompt-continue-request + (or erc--refresh-prompt-continue-request 0))) + (when (functionp erc-prompt) + (save-excursion + (goto-char (1- erc-input-marker)) + ;; Avoid `erc-prompt' (the named function), which appends a + ;; space, and `erc-display-prompt', which propertizes all + ;; but that space. + (let ((s (funcall erc-prompt)) + (p (point)) + (erc--merge-prop-behind-p t)) + (erc--merge-prop 0 (length s) 'font-lock-face 'erc-prompt-face s) + (add-text-properties 0 (length s) erc--prompt-properties s) + (insert s) + (delete-region erc-insert-marker p)))) + (run-hooks 'erc--refresh-prompt-hook) + (when-let (((> erc--refresh-prompt-continue-request 0)) + (n erc--refresh-prompt-continue-request) + (erc--refresh-prompt-continue-request -1) + (b (current-buffer))) + (erc-with-all-buffers-of-server erc-server-process + (lambda () (not (eq b (current-buffer)))) + (if (= n 1) + (run-hooks 'erc--refresh-prompt-hook) + (erc--refresh-prompt))))))) (defun erc--check-msg-prop (prop &optional val) "Return PROP's value in `erc--msg-props' when populated. @@ -3247,9 +3294,12 @@ erc--merge-prop new) (while (< pos to) (setq new (if old - (if (listp val) - (append val (ensure-list old)) - (cons val (ensure-list old))) + ;; Can't `nconc' without more info. + (if erc--merge-prop-behind-p + `(,@(ensure-list old) ,@(ensure-list val)) + (if (listp val) + (append val (ensure-list old)) + (cons val (ensure-list old)))) val)) (put-text-property pos end prop new object) (setq pos end @@ -5209,12 +5259,7 @@ erc-display-prompt ;; Do not extend the text properties when typing at the end ;; of the prompt, but stuff typed in front of the prompt ;; shall remain part of the prompt. - (setq prompt (propertize prompt - 'rear-nonsticky t - 'erc-prompt t ; t or `hidden' - 'field 'erc-prompt - 'front-sticky t - 'read-only t)) + (setq prompt (apply #'propertize prompt erc--prompt-properties)) (erc-put-text-property 0 (1- (length prompt)) 'font-lock-face (or face 'erc-prompt-face) prompt) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 59ad65d65b4..8c85f37dfe5 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1881,6 +1881,18 @@ erc--merge-prop (buffer-substring 1 4) #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z))))) + ;; Flag `erc--merge-prop-behind-p'. + (goto-char (point-min)) + (insert "jkl\n") + (erc--merge-prop 2 3 'erc-test '(y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" 1 2 (erc-test (y z))))) + (let ((erc--merge-prop-behind-p t)) + (erc--merge-prop 1 3 'erc-test '(w x))) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("jkl" 0 1 (erc-test (w x)) 1 2 (erc-test (y z w x))))) + (when noninteractive (kill-buffer)))) commit 4064985b807e00432775543798180e7b81eb5ea9 Author: F. Jason Park Date: Thu Nov 23 13:30:06 2023 -0800 Fix speedbar help-echo in erc-nickbar-mode * lisp/erc/erc-speedbar.el (erc-speedbar-buttons): "Spoof" `dframe-help-echo-function' in channel buffers to get around the fact that we're not using the real speedbar frame. (erc-speedbar--fmt-sentinel): New variable. (erc-speedbar-expand-channel): Use cached channel-mode string for mode item. Use button chars to mark mode and topic items and move verbose labels into mouse-hover text. Also set face for mode and topic. (erc-speedbar-item-info): Look for `speedbar-token' as a fallback even when the primary pattern doesn't match. If the value's contents are structured like a `format' function call, use them. (erc-speedbar--emulate-sidebar): Add comment about speedbar setting everything globally in older Emacsen. (Bug#63595) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index ab06de6a42c..93be7b9f074 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -135,6 +135,14 @@ erc-speedbar-buttons (erase-buffer) (let (serverp chanp queryp) (with-current-buffer buffer + ;; The function `dframe-help-echo' checks the default value of + ;; `dframe-help-echo-function' when deciding whether to visit + ;; the buffer and fire the callback. This works in normal + ;; speedbar frames because the event handler runs in the + ;; `window-buffer' of the active frame. But in our hacked + ;; version, where the frame is hidden, `speedbar-item-info' + ;; never runs without this workaround. + (setq-local dframe-help-echo-function #'ignore) (setq serverp (erc--server-buffer-p)) (setq chanp (erc-channel-p (erc-default-target))) (setq queryp (erc-query-buffer-p))) @@ -212,6 +220,11 @@ erc-speedbar-insert-target (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil depth))) +(defconst erc-speedbar--fmt-sentinel (gensym "erc-speedbar-") + "Symbol for identifying a nonstandard `speedbar-token' text property. +When encountered, ERC assumes the value's tail contains +`format'-compatible args.") + (defun erc-speedbar-expand-channel (text channel indent) "For the line matching TEXT, in CHANNEL, expand or contract a line. INDENT is the current indentation level." @@ -221,35 +234,17 @@ erc-speedbar-expand-channel (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) - (let ((modes (with-current-buffer channel - (concat (apply #'concat - erc-channel-modes) - (cond - ((and erc-channel-user-limit - erc-channel-key) - (if erc-show-channel-key-p - (format "lk %.0f %s" - erc-channel-user-limit - erc-channel-key) - (format "kl %.0f" erc-channel-user-limit))) - (erc-channel-user-limit - ;; Emacs has no bignums - (format "l %.0f" erc-channel-user-limit)) - (erc-channel-key - (if erc-show-channel-key-p - (format "k %s" erc-channel-key) - "k")) - (t ""))))) + (let ((modes (buffer-local-value 'erc--mode-line-mode-string channel)) (topic (erc-controls-interpret (with-current-buffer channel erc-channel-topic)))) - (speedbar-make-tag-line - 'angle ?i nil nil - (concat "Modes: +" modes) nil nil nil - (1+ indent)) + (when modes + (speedbar-make-tag-line + 'angle ?m nil (list erc-speedbar--fmt-sentinel "Mode: %s" modes) + modes nil nil 'erc-notice-face (1+ indent))) (unless (string= topic "") (speedbar-make-tag-line - 'angle ?i nil nil - (concat "Topic: " topic) nil nil nil + 'angle ?t nil (list erc-speedbar--fmt-sentinel "Topic: %s" topic) + topic nil nil 'erc-notice-face (1+ indent))) (unless (pcase erc-speedbar-hide-mode-topic ('nil 'show) @@ -428,6 +423,13 @@ erc-speedbar-item-info (message "%s: %s" txt (car data))) ((bufferp data) (message "Channel: %s" txt)) + ;; Print help if line has a non-standard ([-+?=]) button + ;; char and a `speedbar-token' property with a known CAR. + ((and-let* ((p (text-property-not-all (pos-bol) (pos-eol) + 'speedbar-token nil)) + (v (get-text-property p 'speedbar-token)) + ((eq erc-speedbar--fmt-sentinel (car v)))) + (apply #'message (cdr v)))) (t (message "%s" txt))))) @@ -469,6 +471,7 @@ erc-speedbar--emulate-sidebar (cl-assert (eq speedbar-buffer (current-buffer))) (cl-assert (eq speedbar-frame (selected-frame))) (setq erc-speedbar--hidden-speedbar-frame speedbar-frame + ;; In Emacs 27, this is not `local-variable-if-set-p'. dframe-controlled #'erc-speedbar--dframe-controlled) (add-hook 'window-configuration-change-hook #'erc-speedbar--emulate-sidebar-set-window-preserve-size nil t) commit 5bc84a0c9e4be93eada835ee41951296017c6faa Author: F. Jason Park Date: Mon Nov 20 19:45:30 2023 -0800 Cache UI string for channel modes in ERC * etc/ERC-NEWS: Add entry for more expansive "%m" in header line. * lisp/erc/erc-common.el (erc--channel-mode-types): New slot `shortargs' for caching truncated mode args. * lisp/erc/erc.el (erc--mode-line-chanmodes-arg-len): New internal variable for adjusting the truncation length of channel-mode arguments as they appear in the header line. (erc--mode-line-mode-string): New variable for caching the relevant "modestring", if any, in ERC buffers. (erc--process-channel-modes): Don't associate args with group 4/D, which are all nullary modes. This fixes a bug in which arguments were associated with the wrong letters. Also, set cached mode string for channel. (erc--user-modes): Simplify slightly by removing likely useless variant for overloaded arg AS-TYPE. This function is new in ERC 5.6. (erc--channel-modes): New function. A higher-level getter for current channel mode representation to complement `erc--user-modes'. (erc--parse-user-modes): Set `erc--mode-line-mode-string in server buffers. (erc--handle-channel-mode): Change model to associate modes of type A with a running plus/minus tally of state changes since joining the channel. (erc-update-mode-line-buffer): Use cached verbose representation of channel or user modes instead of calling `erc-format-channel-modes'. * test/lisp/erc/erc-tests.el (erc--update-channel-modes): Update to reflect new running tally associations for type A modes. (erc--channel-modes): New test. (erc--user-modes): Update to reflect parameter simplification. (Bug#67220) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3bb9a30cfb2..32272208704 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -253,6 +253,15 @@ whenever ERC rejects prompt input containing whitespace-only lines. When paired with option 'erc-send-whitespace-lines', ERC echoes a tally of blank lines padded and trailing blanks culled. +** A context-dependent mode segment in header and mode lines. +The "%m" specifier has traditionally expanded to a lone "+" in server +and query buffers and a string containing all switch modes (plus +"limit" and "key" args) in channel buffers. It now becomes a string +of user modes in server buffers and disappears completely in query +buffers. In channels, it's grown to include all letters and their +possibly truncated arguments, with the exception of stateful list +modes, like "b". + ** 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 diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e876afe2644..8daedf9b019 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -116,7 +116,8 @@ erc--isupport-data (cl-defstruct (erc--channel-mode-types (:include erc--isupport-data)) "Server-local \"CHANMODES\" data." (fallbackp nil :type boolean) - (table (make-char-table 'erc--channel-mode-types) :type char-table)) + (table (make-char-table 'erc--channel-mode-types) :type char-table) + (shortargs (make-hash-table :test #'equal))) ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f4c3f77593c..0654da5e16d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6652,6 +6652,12 @@ erc--channel-mode-types "Possibly stale `erc--channel-mode-types' instance for the server. Use the getter of the same name to retrieve the current value.") +(defvar-local erc--mode-line-mode-string nil + "Computed mode-line or header-line component for user/channel modes.") + +(defvar erc--mode-line-chanmodes-arg-len 10 + "Max length at which to truncate channel-mode args in header line.") + (defun erc--channel-mode-types () "Return variable `erc--channel-mode-types', possibly initializing it." (erc--with-isupport-data CHANMODES erc--channel-mode-types @@ -6686,13 +6692,16 @@ erc--process-channel-modes (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) (erc--handle-channel-mode group c +p - (and (or (/= group ?c) +p) + (and (/= group ?d) + (or (/= group ?c) +p) (pop args))) t)) ((not fallbackp) (erc-display-message nil '(notice error) (erc-server-buffer) (format "Unknown channel mode: %S" c)))))) (setq erc-channel-modes (sort erc-channel-modes #'string<)) + (setq erc--mode-line-mode-string + (concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len))) (erc-update-mode-line (current-buffer)))) (defvar-local erc--user-modes nil @@ -6703,16 +6712,60 @@ erc--user-modes "Return user \"MODE\" letters in a form described by AS-TYPE. When AS-TYPE is the symbol `strings' (plural), return a list of strings. When it's `string' (singular), return the same list -concatenated into a single string. When it's a single char, like -?+, return the same value as `string' but with AS-TYPE prepended. -When AS-TYPE is nil, return a list of chars." +concatenated into a single string. When AS-TYPE is nil, return a +list of chars." (let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes)))) (pcase as-type ('strings (mapcar #'char-to-string modes)) ('string (apply #'string modes)) - ((and (pred characterp) c) (apply #'string (cons c modes))) (_ modes)))) +(defun erc--channel-modes (&optional as-type sep) + "Return channel \"MODE\" settings in a form described by AS-TYPE. +When AS-TYPE is the symbol `strings' (plural), return letter keys +as a list of sorted string. When it's `string' (singular), +return keys as a single string. When it's a number N, return a +single string consisting of the concatenated and sorted keys +followed by a space and then their corresponding args, each +truncated to N chars max. ERC joins these args together with +SEP, which defaults to a single space. Otherwise, return a +sorted alist of letter and arg pairs. In all cases that include +values, respect `erc-show-channel-key-p' and optionally omit the +secret key associated with the letter k." + (and-let* ((modes erc--channel-modes) + (tobj (erc--channel-mode-types)) + (types (erc--channel-mode-types-table tobj))) + (let (out) + (maphash (lambda (k v) + (unless (eq ?a (aref types k)) + (push (cons k + (and (not (eq t v)) + (not (and (eq k ?k) + (not (bound-and-true-p + erc-show-channel-key-p)))) + v)) + out))) + modes) + (setq out (cl-sort out #'< :key #'car)) + (pcase as-type + ('strings (mapcar (lambda (o) (char-to-string (car o))) out)) + ('string (apply #'string (mapcar #'car out))) + ((and (pred natnump) c) + (let (keys vals) + (pcase-dolist (`(,k . ,v) out) + (when v + (push (if (> (length v) c) + (with-memoization + (gethash (list c k v) + (erc--channel-mode-types-shortargs tobj)) + (truncate-string-to-width v c 0 nil t)) + v) + vals)) + (push k keys)) + (concat (apply #'string (nreverse keys)) (and vals " ") + (string-join (nreverse vals) (or sep " "))))) + (_ out))))) + (defun erc--parse-user-modes (string &optional current extrap) "Return lists of chars from STRING to add to and drop from CURRENT. Expect STRING to be a so-called \"modestring\", the second @@ -6743,11 +6796,14 @@ erc--parse-user-modes (defun erc--update-user-modes (string) "Update `erc--user-modes' from \"MODE\" STRING. Return its value, a list of characters sorted by character code." - (setq erc--user-modes - (pcase-let ((`(,adding ,dropping) - (erc--parse-user-modes string erc--user-modes))) - (sort (seq-difference (nconc erc--user-modes adding) dropping) - #'<)))) + (prog1 + (setq erc--user-modes + (pcase-let ((`(,adding ,dropping) + (erc--parse-user-modes string erc--user-modes))) + (sort (seq-difference (nconc erc--user-modes adding) dropping) + #'<))) + (setq erc--mode-line-mode-string + (concat "+" (erc--user-modes 'string))))) (defun erc--update-channel-modes (string &rest args) "Update `erc-channel-modes' and call individual mode handlers. @@ -6791,14 +6847,24 @@ erc--handle-channel-mode (erc-log (format "Channel-mode %c (type %s, arg %S) %s" letter type arg (if state 'enabled 'disabled)))) -(cl-defmethod erc--handle-channel-mode :before (_ c state arg) - "Record STATE change and ARG, if enabling, for mode letter C." +(cl-defmethod erc--handle-channel-mode :before (type c state arg) + "Record STATE change for mode letter C. +When STATE is non-nil, add or update C's mapping in +`erc--channel-modes', associating it with ARG if C takes a +parameter and t otherwise. When STATE is nil, forget the +mapping. For type A, add up update a permanent mapping for C, +associating it with an integer indicating a running total of +STATE changes since joining the channel. In most cases, this +won't match the number known to the server." (unless erc--channel-modes (cl-assert (erc--target-channel-p erc--target)) (setq erc--channel-modes (make-hash-table))) - (if state - (puthash c (or arg t) erc--channel-modes) - (remhash c erc--channel-modes))) + (if (= type ?a) + (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1))) + (gethash c erc--channel-modes)) + (if state + (puthash c (or arg t) erc--channel-modes) + (remhash c erc--channel-modes)))) (cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _) "Update `erc-channel-modes' for any character C of nullary type D. @@ -8231,7 +8297,7 @@ erc-update-mode-line-buffer (with-current-buffer buffer (let ((spec `((?a . ,(erc-format-away-status)) (?l . ,(erc-format-lag-time)) - (?m . ,(erc-format-channel-modes)) + (?m . ,(or erc--mode-line-mode-string "")) (?n . ,(or (erc-current-nick) "")) (?N . ,(erc-format-network)) (?o . ,(or (erc-controls-strip erc-channel-topic) "")) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8dbe44ce5ed..59ad65d65b4 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -796,13 +796,57 @@ erc--update-channel-modes (erc--update-channel-modes "+qu" "fool!*@*") (should (equal (pop calls) '(?d ?u t nil))) (should (equal (pop calls) '(?a ?q t "fool!*@*"))) - (should (equal "fool!*@*" (gethash ?q erc--channel-modes))) + (should (equal 1 (gethash ?q erc--channel-modes))) (should (eq t (gethash ?u erc--channel-modes))) (should (equal erc-channel-modes '("u"))) - (should-not (erc-channel-user-owner-p "bob"))) + (should-not (erc-channel-user-owner-p "bob")) + + ;; Remove fool!*@* from list mode "q". + (erc--update-channel-modes "-uq" "fool!*@*") + (should (equal (pop calls) '(?a ?q nil "fool!*@*"))) + (should (equal (pop calls) '(?d ?u nil nil))) + (should-not (gethash ?u erc--channel-modes)) + (should-not erc-channel-modes) + (should (equal 0 (gethash ?q erc--channel-modes)))) (should-not calls)))) +(ert-deftest erc--channel-modes () + (setq erc--isupport-params (make-hash-table) + erc--target (erc--target-from-string "#test") + erc-server-parameters + '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) + + (erc-tests--set-fake-server-process "sleep" "1") + + (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) + (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) + + (should (equal (erc--channel-modes 'string) "klt")) + (should (equal (erc--channel-modes 'strings) '("k" "l" "t"))) + (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t)))) + (should (equal (erc--channel-modes 3 ",") "klt h2,3")) + + ;; Truncation cache populated and used. + (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) + first-run) + (should (zerop (hash-table-count cache))) + (should (equal (erc--channel-modes 1 ",") "klt h,3")) + (should (equal (setq first-run (map-pairs cache)) '(((1 ?k "h2") . "h")))) + (cl-letf (((symbol-function 'truncate-string-to-width) + (lambda (&rest _) (ert-fail "Shouldn't run")))) + (should (equal (erc--channel-modes 1 ",") "klt h,3"))) + ;; Same key for only entry matches that of first result. + (should (pcase (map-pairs cache) + ((and '(((1 ?k "h2") . "h")) second-run) + (eq (pcase first-run (`((,k . ,_)) k)) + (pcase second-run (`((,k . ,_)) k))))))) + + (should (equal (erc--channel-modes 0 ",") "klt ,")) + (should (equal (erc--channel-modes 2) "klt h2 3")) + (should (equal (erc--channel-modes 1) "klt h 3")) + (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces + (ert-deftest erc--update-user-modes () (let ((erc--user-modes (list ?a))) (should (equal (erc--update-user-modes "+a") '(?a))) @@ -818,8 +862,7 @@ erc--user-modes (let ((erc--user-modes '(?a ?b))) (should (equal (erc--user-modes) '(?a ?b))) (should (equal (erc--user-modes 'string) "ab")) - (should (equal (erc--user-modes 'strings) '("a" "b"))) - (should (equal (erc--user-modes '?+) "+ab")))) + (should (equal (erc--user-modes 'strings) '("a" "b"))))) (ert-deftest erc--parse-user-modes () (should (equal (erc--parse-user-modes "a" '(?a)) '(() ()))) commit 2fca889cfb4fa495a6ffa0c7fe368551ee9a32bc Author: Alan Mackenzie Date: Fri Nov 24 12:22:08 2023 +0000 CC Mode: Fontify int unsigned Foo; This fixes bug#59953. Foo now gets fontified when unsigned comes after int. * lisp/progmodes/cc-engine.el (c-forward-type): Refactor nested `if' forms into a cond form. Loop around matches for c-opt-type-component-key, advancing over them. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index d903dd0694e..018a194ac14 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9440,37 +9440,47 @@ c-forward-type (or c-promote-possible-types (eq res t))) (c-record-type-id (cons (match-beginning 1) (match-end 1)))) - (if (and c-opt-type-component-key + (cond + ((and c-opt-type-component-key (save-match-data (looking-at c-opt-type-component-key))) ;; There might be more keywords for the type. - (let (safe-pos) - (c-forward-keyword-clause 1 t) - (while (progn - (setq safe-pos (point)) - (c-forward-syntactic-ws) - (looking-at c-opt-type-component-key)) - (when (and c-record-type-identifiers - (looking-at c-primitive-type-key)) - (c-record-type-id (cons (match-beginning 1) - (match-end 1)))) - (c-forward-keyword-clause 1 t)) - (if (looking-at c-primitive-type-key) - (progn - (when c-record-type-identifiers - (c-record-type-id (cons (match-beginning 1) - (match-end 1)))) - (c-forward-keyword-clause 1 t) - (setq res t)) - (goto-char safe-pos) - (setq res 'prefix)) - (setq pos (point))) - (if (save-match-data (c-forward-keyword-clause 1 t)) - (setq pos (point)) - (if pos - (goto-char pos) - (goto-char (match-end 1)) - (setq pos (point))))) + (let (safe-pos) + (c-forward-keyword-clause 1 t) + (while (progn + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (looking-at c-opt-type-component-key)) + (when (and c-record-type-identifiers + (looking-at c-primitive-type-key)) + (c-record-type-id (cons (match-beginning 1) + (match-end 1)))) + (c-forward-keyword-clause 1 t)) + (if (looking-at c-primitive-type-key) + (progn + (when c-record-type-identifiers + (c-record-type-id (cons (match-beginning 1) + (match-end 1)))) + (c-forward-keyword-clause 1 t) + (setq res t) + (while (progn + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (looking-at c-opt-type-component-key)) + (c-forward-keyword-clause 1 t))) + (goto-char safe-pos) + (setq res 'prefix)) + (setq pos (point)))) + ((save-match-data (c-forward-keyword-clause 1 t)) + (while (progn + (setq pos (point)) + (c-forward-syntactic-ws) + (and c-opt-type-component-key + (looking-at c-opt-type-component-key))) + (c-forward-keyword-clause 1 t))) + (pos (goto-char pos)) + (t (goto-char (match-end 1)) + (setq pos (point)))) (c-forward-syntactic-ws)) ((and (eq name-res t) commit 36d9b8ce84afc8aaae3ce067fd24e172c0f631cf Author: Alan Mackenzie Date: Fri Nov 24 10:03:33 2023 +0000 CC Mode: Add second anchor point to class-open and class-close This fixes the second (last) part of bug#66911. The new second anchor points allow the indentation of braces in template classes to be anchored on the keyword 'class' rather than the `template' at the beginning of the statement. * lisp/progmodes/cc-engine.el (c-add-class-syntax): Add &rest args parameter for additional anchor points. Pass these to c-add-syntax. (c-guess-continued-construct): CASE B.1: Note return value from c-looking-at-decl-block and pass this to c-add-syntax for a class-open construct. (c-guess-basic-syntax): CASE 4: Duplicate anchor position for class-open. (c-guess-basic-syntax): CASE 5A.2: Note return value of c-looking-at-decl-block and pass it as extra argument to c-add-syntax for a class-open construct. (c-guess-basic-syntax): CASE 5G: Call c-looking-at-decl-block to determine the second anchor point for a class-close, and pass it to c-add-class-syntax. * doc/misc/cc-mode.texi (Class Symbols): Document the anchor points for class-open and class-close. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 4ab95798468..8bc19235516 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -4507,6 +4507,13 @@ Class Symbols the keyword @code{class} is meaningless in C and Objective-C.}. Similarly, line 18 is assigned @code{class-close} syntax. +Note that @code{class-open} and @code{class-close} syntactic elements +have two anchor points. The first is the position of the beginning of +the statement, the second is the position of the keyword which defines +the construct (e.g. @code{class}). These are usually the same +position, but differ when the statement starts off with +@code{template} (C++ Mode) or @code{generic} (Java Mode) or similar. + @ssindex inher-intro @ssindex inher-cont Line 2 introduces the inheritance list for the class so it is assigned diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 1fc02d1ad07..d903dd0694e 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12618,7 +12618,7 @@ c-looking-at-decl-block (c-syntactic-skip-backward c-block-prefix-charset limit t) (while - (or + (or ;; Could be after a template arglist.... (and c-recognize-<>-arglists (eq (char-before) ?>) @@ -14174,7 +14174,8 @@ c-add-stmt-syntax (defun c-add-class-syntax (symbol containing-decl-open containing-decl-start - containing-decl-kwd) + containing-decl-kwd + &rest args) ;; The inclass and class-close syntactic symbols are added in ;; several places and some work is needed to fix everything. ;; Therefore it's collected here. @@ -14189,7 +14190,7 @@ c-add-class-syntax ;; Ought to use `c-add-stmt-syntax' instead of backing up to boi ;; here, but we have to do like this for compatibility. (back-to-indentation) - (c-add-syntax symbol (point)) + (apply #'c-add-syntax symbol (point) args) (if (and (c-keyword-member containing-decl-kwd 'c-inexpr-class-kwds) (/= containing-decl-start (c-point 'boi containing-decl-start))) @@ -14223,9 +14224,10 @@ c-guess-continued-construct ;; CASE B.1: class-open ((save-excursion (and (eq (char-after) ?{) - (c-looking-at-decl-block t) + (setq placeholder (c-looking-at-decl-block t)) (setq beg-of-same-or-containing-stmt (point)))) - (c-add-syntax 'class-open beg-of-same-or-containing-stmt)) + (c-add-syntax 'class-open beg-of-same-or-containing-stmt + (c-point 'boi placeholder))) ;; CASE B.2: brace-list-open ((or (consp special-brace-list) @@ -14720,7 +14722,10 @@ c-guess-basic-syntax 'lambda-intro-cont))) (goto-char (cdr placeholder)) (back-to-indentation) - (c-add-stmt-syntax tmpsymbol nil t + (c-add-stmt-syntax tmpsymbol + (and (eq tmpsymbol 'class-open) + (list (point))) + t (c-most-enclosing-brace state-cache (point)) paren-state) (unless (eq (point) (cdr placeholder)) @@ -14763,9 +14768,10 @@ c-guess-basic-syntax (goto-char indent-point) (skip-chars-forward " \t") (and (eq (char-after) ?{) - (c-looking-at-decl-block t) + (setq tmp-pos (c-looking-at-decl-block t)) (setq placeholder (point)))) - (c-add-syntax 'class-open placeholder)) + (c-add-syntax 'class-open placeholder + (c-point 'boi tmp-pos))) ;; CASE 5A.3: brace list open ((save-excursion @@ -15163,10 +15169,14 @@ c-guess-basic-syntax ((and containing-sexp (eq char-after-ip ?}) (eq containing-decl-open containing-sexp)) + (save-excursion + (goto-char containing-decl-open) + (setq tmp-pos (c-looking-at-decl-block t))) (c-add-class-syntax 'class-close containing-decl-open containing-decl-start - containing-decl-kwd)) + containing-decl-kwd + (c-point 'boi tmp-pos))) ;; CASE 5H: we could be looking at subsequent knr-argdecls ((and c-recognize-knr-p commit 0858d10aebed44f7d66548d061af03b3cb136d04 Author: Po Lu Date: Fri Nov 24 10:39:49 2023 +0800 Prevent touch screen translation from entering invalid state * lisp/subr.el (touch-screen-events-received): New variable. (read--potential-mouse-event): If a touch screen event's been registered thus far, continue as though xterm-mouse-mode is enabled. * lisp/touch-screen.el (touch-screen-handle-touch): Set that variable. If t-s-c-t already exists but the new touch point was assigned the same number by the system, replace the current tool with it rather than installing it as the anciliary tool. diff --git a/lisp/subr.el b/lisp/subr.el index 304b71e6168..7f2dcdc4d90 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3332,22 +3332,30 @@ read-key (message nil) (use-global-map old-global-map)))) +(defvar touch-screen-events-received nil + "Whether a touch screen event has ever been translated. +The value of this variable governs whether +`read--potential-mouse-event' calls read-key or read-event.") + ;; FIXME: Once there's a safe way to transition away from read-event, ;; callers to this function should be updated to that way and this ;; function should be deleted. (defun read--potential-mouse-event () - "Read an event that might be a mouse event. + "Read an event that might be a mouse event. This function exists for backward compatibility in code packaged with Emacs. Do not call it directly in your own packages." - ;; `xterm-mouse-mode' events must go through `read-key' as they - ;; are decoded via `input-decode-map'. - (if xterm-mouse-mode - (read-key nil - ;; Normally `read-key' discards all mouse button - ;; down events. However, we want them here. - t) - (read-event))) + ;; `xterm-mouse-mode' events must go through `read-key' as they + ;; are decoded via `input-decode-map'. + (if (or xterm-mouse-mode + ;; If a touch screen is being employed, then mouse events + ;; are subject to translation as well. + touch-screen-events-received) + (read-key nil + ;; Normally `read-key' discards all mouse button + ;; down events. However, we want them here. + t) + (read-event))) (defvar read-passwd-map ;; BEWARE: `defconst' would purecopy it, breaking the sharing with diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index f6a47e69d81..56adb75cefc 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1456,8 +1456,15 @@ touch-screen-handle-touch generated instead of throwing `input-event'. Otherwise, throw `input-event' with a single input event if that event should take the place of EVENT within the key sequence being translated, or -`nil' if all tools have been released." +`nil' if all tools have been released. + +Set `touch-screen-events-received' to `t' to indicate that touch +screen events have been received, and thus by extension require +functions undertaking event management themselves to call +`read-key' rather than `read-event'." (interactive "e\ni\np") + (unless touch-screen-events-received + (setq touch-screen-events-received t)) (if interactive ;; Called interactively (probably from wid-edit.el.) ;; Add any event generated to `unread-command-events'. @@ -1484,7 +1491,19 @@ touch-screen-handle-touch (cancel-timer touch-screen-current-timer) (setq touch-screen-current-timer nil)) ;; If a tool already exists... - (if touch-screen-current-tool + (if (and touch-screen-current-tool + ;; ..and the number of this tool is at variance with + ;; that of the current tool: if a `touchscreen-end' + ;; event is delivered that is somehow withheld from + ;; this function and the system does not assign + ;; monotonically increasing touch point identifiers, + ;; then the ancillary tool will be set to a tool + ;; bearing the same number as the current tool, and + ;; consequently the mechanism for detecting + ;; erroneously retained touch points upon the + ;; registration of `touchscreen-update' events will + ;; not be activated. + (not (eq touchpoint (car touch-screen-current-tool)))) ;; Then record this tool as the ``auxiliary tool''. ;; Updates to the auxiliary tool are considered in unison ;; with those to the current tool; the distance between commit 354a2958f9ae547529b8f35cbd8659a0136d0d56 Author: Po Lu Date: Fri Nov 24 08:45:18 2023 +0800 ; Complete merge of emoji.el * lisp/international/emoji.el (emoji-list): Import changes from emacs-29. diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 8bb31e15b61..f2814c7a84b 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -156,11 +156,11 @@ emoji-insert-glyph ;;;###autoload (defun emoji-list () - "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." - (interactive "*") + (interactive) (let ((buf (current-buffer))) (emoji--init) (switch-to-buffer (get-buffer-create "*Emoji*")) @@ -273,7 +273,9 @@ emoji-list-select (let ((buf emoji--insert-buffer)) (quit-window) (if (buffer-live-p buf) - (switch-to-buffer buf) + (progn + (switch-to-buffer buf) + (barf-if-buffer-read-only)) (error "Buffer disappeared"))) (let ((derived (gethash glyph emoji--derived))) (if derived commit 1737ffd3a83b0d2fd4a114e9b5187d28d577dc38 Merge: cd263043538 1978b603bc3 Author: Po Lu Date: Fri Nov 24 08:44:34 2023 +0800 Merge from savannah/emacs-29 1978b603bc3 Make python-ts-mode's syntax-highlighting more standardized 99658346d1e ; Improve documentation of desktop.el in user manual f7dc0202127 Fix "Text is read-only" on backspacing initial Calc input 662d54775d5 Add a doc string to simple.el (bug#67355) 5a5e36d2aad ; Improve function documentation tips 86016d8ecdb Mention "visual line" in user manual 4bb65ed77a8 ; * doc/lispref/minibuf.texi (Programmed Completion): Imp... dfb3dcb404c Allow listing Emoji from a read-only buffer # Conflicts: # lisp/calc/calc.el # lisp/international/emoji.el commit cd263043538fd960083c7c98390d3c679c5012f3 Merge: ad26461b48d 8256bf4cdfb Author: Po Lu Date: Fri Nov 24 08:38:06 2023 +0800 ; Merge from savannah/emacs-29 The following commits were skipped: 8256bf4cdfb Fix CRLF handling in Tramp (don't merge) 81b63ec032f Annotate java-ts-mode-test-movement with expected result 054202d48c3 Backport: Add more java indentation tests d2776d8254f Backport: Add test for java indentation (bug#61115) commit ad26461b48ddc6d8d07e818b0536674f73f41b22 Merge: 37b18d88bbc 9af03e0e189 Author: Po Lu Date: Fri Nov 24 08:38:06 2023 +0800 Merge from savannah/emacs-29 9af03e0e189 typescript-ts-mode: Support indentation for conditionals ... commit 37b18d88bbcba9ed67955e4a6054fba0c4f49419 Merge: 9db8c349f06 61cdf42a48f Author: Po Lu Date: Fri Nov 24 08:38:05 2023 +0800 ; Merge from savannah/emacs-29 The following commit was skipped: 61cdf42a48f Backport: Add some basic tests for java-ts-mode and types... commit 9db8c349f0674c356ad1c04e62d75af958c486e8 Merge: 29d42d9158a d72a4ed65ce Author: Po Lu Date: Fri Nov 24 08:38:03 2023 +0800 Merge from savannah/emacs-29 d72a4ed65ce Fix 'with-sqlite-transaction' when BODY fails a7b3c923733 ; * doc/emacs/cmdargs.texi (Initial Options): Fix last ch... fd76a80864d ; Mention that -x and --script ignore file-locals e0469ddb9d4 ; * doc/emacs/search.texi (Special Isearch): More accurat... e521669fb3f Fix wording in ELisp Intro manual da946ca6924 Add missing python-ts-mode keyword (bug#67015) 0128495afde Fix string-pixel-width with global setting of display-lin... # Conflicts: # etc/NEWS commit 1978b603bc3068140833e478a8103fea1d185aec Author: Dmitry Gutov Date: Fri Nov 24 00:00:32 2023 +0200 Make python-ts-mode's syntax-highlighting more standardized This was brought up in a Reddit discussion. * lisp/progmodes/python.el (python--treesit-fontify-variable): Use font-lock-variable-use-face (since it applies to references). (python-ts-mode): Move 'property' from 3rd to 4th treesit-font-lock-level. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e17651d9275..a7944576196 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1225,7 +1225,7 @@ python--treesit-fontify-variable (when (python--treesit-variable-p node) (treesit-fontify-with-override (treesit-node-start node) (treesit-node-end node) - 'font-lock-variable-name-face override start end))) + 'font-lock-variable-use-face override start end))) ;;; Indentation @@ -6717,8 +6717,8 @@ python-ts-mode '(( comment definition) ( keyword string type) ( assignment builtin constant decorator - escape-sequence number property string-interpolation ) - ( bracket delimiter function operator variable))) + escape-sequence number string-interpolation ) + ( bracket delimiter function operator variable property))) (setq-local treesit-font-lock-settings python--treesit-settings) (setq-local imenu-create-index-function #'python-imenu-treesit-create-index) commit 29d42d9158ae836fc30d72dbdf4a8236a01de87f Author: Juri Linkov Date: Thu Nov 23 20:12:40 2023 +0200 Support dired-movement-style in dired-next-dirline and dired-prev-dirline * lisp/dired.el (dired-movement-style): Mention dired-next-dirline and dired-prev-dirline in the docstring (bug#67303). (dired-next-line): Refactor most code to dired--move-to-next-line. (dired--move-to-next-line): New function with code from dired-next-line. (dired--trivial-next-dirline): Rename from dired-next-dirline. (dired-next-dirline): New function body that uses dired-movement-style, dired--move-to-next-line and dired--trivial-next-dirline. (dired-prev-dirline): Mention dired-movement-style in the docstring. diff --git a/etc/NEWS b/etc/NEWS index c0f76ed052b..259af667c03 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -490,10 +490,11 @@ that shows as diffs replacements in the marked files in Dired. --- *** New user option 'dired-movement-style'. -When non-nil, make 'dired-next-line' and 'dired-previous-line' skip -empty lines. It also controls how to move point when encountering a -boundary (e.g., if every line is visible, invoking 'dired-next-line' -at the last line will move to the first line). The default is nil. +When non-nil, make 'dired-next-line', 'dired-previous-line', +'dired-next-dirline', 'dired-prev-dirline' skip empty lines. +It also controls how to move point when encountering a boundary +(e.g., if every line is visible, invoking 'dired-next-line' at +the last line will move to the first line). The default is nil. ** Ediff diff --git a/lisp/dired.el b/lisp/dired.el index c212e3094f8..a3d7c636d29 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -499,7 +499,8 @@ dired-guess-shell-znew-switches (defcustom dired-movement-style nil "Non-nil means point skips empty lines when moving in Dired buffers. -This affects only `dired-next-line' and `dired-previous-line'. +This affects only `dired-next-line', `dired-previous-line', +`dired-next-dirline', `dired-prev-dirline'. Possible non-nil values: * `cycle': when moving from the last/first visible line, cycle back @@ -2688,11 +2689,11 @@ dired-toggle-read-only (defun dired--trivial-next-line (arg) "Move down ARG lines, then position at filename." (let ((line-move-visual) - (goal-column)) + (goal-column)) (line-move arg t)) ;; We never want to move point into an invisible line. (while (and (invisible-p (point)) - (not (if (and arg (< arg 0)) (bobp) (eobp)))) + (not (if (and arg (< arg 0)) (bobp) (eobp)))) (forward-char (if (and arg (< arg 0)) -1 1))) (dired-move-to-filename)) @@ -2705,44 +2706,41 @@ dired-next-line is controlled by `dired-movement-style'." (interactive "^p" dired-mode) (if dired-movement-style - (let ((old-position (progn - ;; It's always true that we should move - ;; to the filename when possible. - (dired-move-to-filename) - (point))) - ;; Up/Down indicates the direction. - (moving-down (if (cl-plusp arg) - 1 ; means Down. - -1))) ; means Up. - ;; Line by line in case we forget to skip empty lines. - (while (not (zerop arg)) - (dired--trivial-next-line moving-down) - (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. - (goto-char (if (cl-plusp moving-down) - (point-min) - (point-max))) - ;; `bounded': go back to the last non-empty line. - (while (string-match-p "\\`[[:blank:]]*\\'" - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))) - (dired--trivial-next-line (- moving-down))) - ;; Encountered a boundary, so let's stop movement. - (setq arg moving-down))) - (when (not (string-match-p "\\`[[:blank:]]*\\'" - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)))) - ;; Has moved to a non-empty line. This movement does - ;; make sense. - (cl-decf arg moving-down)) - (setq old-position (point)))) + (dired--move-to-next-line arg #'dired--trivial-next-line) (dired--trivial-next-line arg))) +(defun dired--move-to-next-line (arg jumpfun) + (let ((old-position (progn + ;; It's always true that we should move + ;; to the filename when possible. + (dired-move-to-filename) + (point))) + ;; Up/Down indicates the direction. + (moving-down (if (cl-plusp arg) + 1 ; means Down. + -1))) ; means Up. + ;; Line by line in case we forget to skip empty lines. + (while (not (zerop arg)) + (funcall jumpfun moving-down) + (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. + (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))) + ;; Encountered a boundary, so let's stop movement. + (setq arg moving-down))) + (unless (dired-between-files) + ;; Has moved to a non-empty line. This movement does + ;; make sense. + (cl-decf arg moving-down)) + (setq old-position (point))))) + (defun dired-previous-line (arg) "Move up ARG lines, then position at filename. The argument ARG (interactively, prefix argument) says how many lines @@ -2753,9 +2751,8 @@ dired-previous-line (interactive "^p" dired-mode) (dired-next-line (- (or arg 1)))) -(defun dired-next-dirline (arg &optional opoint) +(defun dired--trivial-next-dirline (arg &optional opoint) "Goto ARGth next directory file line." - (interactive "p" dired-mode) (or opoint (setq opoint (point))) (if (if (> arg 0) (re-search-forward dired-re-dir nil t arg) @@ -2763,10 +2760,24 @@ dired-next-dirline (re-search-backward dired-re-dir nil t (- arg))) (dired-move-to-filename) ; user may type `i' or `f' (goto-char opoint) - (error "No more subdirectories"))) + (unless dired-movement-style + (error "No more subdirectories")))) + +(defun dired-next-dirline (arg &optional _opoint) + "Goto ARGth next directory file line. + +Whether to skip empty lines and how to move from last line +is controlled by `dired-movement-style'." + (interactive "p" dired-mode) + (if dired-movement-style + (dired--move-to-next-line arg #'dired--trivial-next-dirline) + (dired--trivial-next-dirline arg))) (defun dired-prev-dirline (arg) - "Goto ARGth previous directory file line." + "Goto ARGth previous directory file line. + +Whether to skip empty lines and how to move from last line +is controlled by `dired-movement-style'." (interactive "p" dired-mode) (dired-next-dirline (- arg))) commit 51222153df13c44f2dc74e17da21d95a29f91776 Author: Manuel Giraud Date: Thu Nov 23 09:14:16 2023 -0800 Remove spurious "nil" from Gnus mode line Bug#67322 * lisp/gnus/gnus.el (gnus-mode-line-buffer-identification): Handle a nil return value from `gnus-emacs-version'. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index ffe81e5c585..6bf66233101 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -319,7 +319,8 @@ gnus-mode-line-buffer-identification (not (stringp str)) (not (string-match "^Gnus:" str))) (list str) - (let ((load-path (append (mm-image-load-path) load-path))) + (let ((load-path (append (mm-image-load-path) load-path)) + (gnus-emacs-version (gnus-emacs-version))) ;; Add the Gnus logo. (add-text-properties 0 5 @@ -328,13 +329,15 @@ gnus-mode-line-buffer-identification '((:type svg :file "gnus-pointer.svg" :ascent center) (:type xpm :file "gnus-pointer.xpm" - :ascent center) + :ascent center) (:type xbm :file "gnus-pointer.xbm" :ascent center)) t) - 'help-echo (format - "This is %s, %s." - gnus-version (gnus-emacs-version))) + 'help-echo (if gnus-emacs-version + (format + "This is %s, %s." + gnus-version gnus-emacs-version) + (format "This is %s." gnus-version))) str) (list str))))) commit 7705bdfa5b89f78dab049f73f636b9680a3c12bc Author: Stefan Monnier Date: Mon Nov 13 19:09:17 2023 -0500 Adjust affected callers of derived-mode-p` to use the new convention * lisp/align.el (align-rules-list): Prefer `derived-mode-p` over `provided-mode-derived-p`. (align--rule-should-run): * lisp/window.el (display-buffer-reuse-mode-window): * lisp/whitespace.el (whitespace-enable-predicate): * lisp/transient.el (transient--do-suffix-p): * lisp/so-long.el (so-long--set-auto-mode): * lisp/simple.el (command-completion-with-modes-p): * lisp/progmodes/tcl.el (tcl-current-word): * lisp/progmodes/idlwave.el (idlwave-fix-keywords): * lisp/progmodes/gdb-mi.el (gdb, gdb-locals-mode-map) (gdb-registers-mode-map, gdb-function-buffer-p): * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-style-setter) (c-ts-mode-set-style): * lisp/progmodes/bug-reference.el (bug-reference--try-setup-gnus-article): * lisp/help-fns.el (help-fns--list-local-commands): * lisp/emulation/viper.el (viper-mode) (viper-this-major-mode-requires-vi-state): * lisp/emacs-lisp/easy-mmode.el (easy-mmode--globalized-predicate-p): * lisp/dired.el (dired-hide-details-mode, dired-click-to-select-mode): * lisp/calendar/todo-mode.el (todo-reset-nondiary-marker) (todo-reset-done-string, todo-reset-comment-string): * lisp/vc/vc.el (vc-deduce-backend): Use new calling convention for `derived-mode-p` and `provided-mode-derived-p`. diff --git a/lisp/align.el b/lisp/align.el index 9fa78525ecb..4daa20ddd2a 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -555,8 +555,7 @@ align-rules-list (repeat . t) (run-if . ,(lambda () (and (not (eq '- current-prefix-arg)) - (not (apply #'provided-mode-derived-p - major-mode align-tex-modes)))))) + (not (derived-mode-p align-tex-modes)))))) ;; With a negative prefix argument, lists of dollar figures will ;; be aligned. @@ -1286,7 +1285,7 @@ align--rule-should-run This is decided by the `modes' and `run-if' keys in the alist RULE. Their meaning is documented in `align-rules-list' (which see)." (let-alist rule - (not (or (and .modes (not (apply #'derived-mode-p (eval .modes)))) + (not (or (and .modes (not (derived-mode-p (eval .modes)))) (and .run-if (not (funcall .run-if))))))) (defun align-region (beg end separate rules exclude-rules diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 4f6a964eb4d..ab9d629d9fc 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -6350,7 +6350,7 @@ todo-reset-nondiary-marker (replace-match (nth 1 value) t t nil 2)) (forward-line))) (if buf - (when (derived-mode-p 'todo-mode 'todo-archive-mode) + (when (derived-mode-p '(todo-mode todo-archive-mode)) (todo-category-select)) (save-buffer) (kill-buffer))))))))) @@ -6394,7 +6394,7 @@ todo-reset-done-string (replace-match value t t nil 1) (forward-line))) (if buf - (when (derived-mode-p 'todo-mode 'todo-archive-mode) + (when (derived-mode-p '(todo-mode todo-archive-mode)) (todo-category-select)) (save-buffer) (kill-buffer))))))))) @@ -6420,7 +6420,7 @@ todo-reset-comment-string (replace-match value t t nil 1) (forward-line))) (if buf - (when (derived-mode-p 'todo-mode 'todo-archive-mode) + (when (derived-mode-p '(todo-mode todo-archive-mode)) (todo-category-select)) (save-buffer) (kill-buffer))))))))) diff --git a/lisp/dired.el b/lisp/dired.el index 583cb2475e2..c212e3094f8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3074,7 +3074,7 @@ dired-hide-details-mode See options: `dired-hide-details-hide-symlink-targets' and `dired-hide-details-hide-information-lines'." :group 'dired - (unless (derived-mode-p 'dired-mode 'wdired-mode) + (unless (derived-mode-p '(dired-mode wdired-mode)) (error "Not a Dired buffer")) (dired-hide-details-update-invisibility-spec) (if dired-hide-details-mode @@ -5101,7 +5101,7 @@ dired-click-to-select-mode completes." :group 'dired :lighter " Click-To-Select" - (unless (derived-mode-p 'dired-mode 'wdired-mode) + (unless (derived-mode-p '(dired-mode wdired-mode)) (error "Not a Dired buffer")) (if dired-click-to-select-mode (setq-local tool-bar-map diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 529f6e90e88..c9e7b3a4dfe 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -661,7 +661,7 @@ easy-mmode--globalized-predicate-p (throw 'found nil)) ((and (consp elem) (eq (car elem) 'not)) - (when (apply #'derived-mode-p (cdr elem)) + (when (derived-mode-p (cdr elem)) (throw 'found nil))) ((symbolp elem) (when (derived-mode-p elem) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 96da914275b..767ad57c471 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -593,8 +593,8 @@ viper-mode )) (viper-set-expert-level 'dont-change-unless))) - (or (apply #'derived-mode-p viper-emacs-state-mode-list) ; don't switch to Vi - (apply #'derived-mode-p viper-insert-state-mode-list) ; don't switch + (or (derived-mode-p viper-emacs-state-mode-list) ; don't switch to Vi + (derived-mode-p viper-insert-state-mode-list) ; don't switch (viper-change-state-to-vi)) )) @@ -607,9 +607,9 @@ viper-mode ;; that are not listed in viper-vi-state-mode-list (defun viper-this-major-mode-requires-vi-state (mode) (let ((major-mode mode)) - (cond ((apply #'derived-mode-p viper-vi-state-mode-list) t) - ((apply #'derived-mode-p viper-emacs-state-mode-list) nil) - ((apply #'derived-mode-p viper-insert-state-mode-list) nil) + (cond ((derived-mode-p viper-vi-state-mode-list) t) + ((derived-mode-p viper-emacs-state-mode-list) nil) + ((derived-mode-p viper-insert-state-mode-list) nil) (t (and (eq (key-binding "a") 'self-insert-command) (eq (key-binding " ") 'self-insert-command)))))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e723d97cfc2..a8c60946121 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2240,7 +2240,7 @@ help-fns--list-local-commands (not (get sym 'byte-obsolete-info)) ;; Ignore everything bound. (not (where-is-internal sym nil t)) - (apply #'derived-mode-p (command-modes sym))) + (derived-mode-p (command-modes sym))) (push sym functions)))) (with-temp-buffer (when functions diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 3f6e1e68e5b..0afed5276f5 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -467,10 +467,10 @@ bug-reference-mode (defun bug-reference--try-setup-gnus-article () (when (and bug-reference-mode ;; Only if enabled in article buffers. (derived-mode-p - 'gnus-article-mode - ;; Apparently, gnus-article-prepare-hook is run in the - ;; summary buffer... - 'gnus-summary-mode) + '(gnus-article-mode + ;; Apparently, `gnus-article-prepare-hook' is run in the + ;; summary buffer... + gnus-summary-mode)) gnus-article-buffer gnus-original-article-buffer (buffer-live-p (get-buffer gnus-article-buffer)) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 70717a90caa..a56ce26fc79 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -135,7 +135,7 @@ c-ts-mode--indent-style-setter res) (let ((buffer (car buffers))) (with-current-buffer buffer - (if (derived-mode-p 'c-ts-mode 'c++-ts-mode) + (if (derived-mode-p '(c-ts-mode c++-ts-mode)) (loop (append res (list buffer)) (cdr buffers)) (loop res (cdr buffers)))))))) @@ -193,7 +193,7 @@ c-ts-mode-set-style To set the default indent style globally, use `c-ts-mode-set-global-style'." (interactive (list (c-ts-mode--prompt-for-style))) - (if (not (derived-mode-p 'c-ts-mode 'c++-ts-mode)) + (if (not (derived-mode-p '(c-ts-mode c++-ts-mode))) (user-error "The current buffer is not in `c-ts-mode' nor `c++-ts-mode'") (setq-local c-ts-mode-indent-style style) (setq treesit-simple-indent-rules diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 3afdc59a67e..7ae4bcea1e1 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1006,9 +1006,10 @@ gdb (gud-def gud-pp (gud-call (concat - "pp " (if (eq (buffer-local-value - 'major-mode (window-buffer)) 'speedbar-mode) - (gdb-find-watch-expression) "%e")) arg) + "pp " (if (eq (buffer-local-value 'major-mode (window-buffer)) + 'speedbar-mode) + (gdb-find-watch-expression) "%e")) + arg) nil "Print the Emacs s-expression.") (define-key gud-minor-mode-map [left-margin mouse-1] @@ -4586,7 +4587,8 @@ gdb-locals-mode-map (gdb-set-window-buffer (gdb-get-buffer-create 'gdb-registers-buffer - gdb-thread-number) t))) + gdb-thread-number) + t))) map)) (define-derived-mode gdb-locals-mode gdb-parent-mode "Locals" @@ -4706,7 +4708,8 @@ gdb-registers-mode-map (gdb-set-window-buffer (gdb-get-buffer-create 'gdb-locals-buffer - gdb-thread-number) t))) + gdb-thread-number) + t))) (define-key map "f" #'gdb-registers-toggle-filter) map)) @@ -5106,7 +5109,7 @@ gdb-function-buffer-p not including main command buffer (the one where you type GDB commands) or source buffers (that display program source code)." (with-current-buffer buffer - (derived-mode-p 'gdb-parent-mode 'gdb-inferior-io-mode))) + (derived-mode-p '(gdb-parent-mode gdb-inferior-io-mode)))) (defun gdb--buffer-type (buffer) "Return the type of BUFFER if it is a function buffer. diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index d9eccacc48b..f60cc9372eb 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -6892,7 +6892,7 @@ idlwave-one-key-select ;; Display prompt and wait for quick reply (message "%s[%s]" prompt (mapconcat (lambda(x) (char-to-string (car x))) - keys-alist "")) + keys-alist)) (if (sit-for delay) ;; No quick reply: Show help (save-window-excursion @@ -7958,7 +7958,7 @@ idlwave-fix-keywords ;; If this is the OBJ_NEW function, try to figure out the class and use ;; the keywords from the corresponding INIT method. (if (and (equal (upcase name) "OBJ_NEW") - (derived-mode-p 'idlwave-mode 'idlwave-shell-mode)) + (derived-mode-p '(idlwave-mode idlwave-shell-mode))) (let* ((bos (save-excursion (idlwave-beginning-of-statement) (point))) (string (buffer-substring bos (point))) (case-fold-search t) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index ba0cbc8b066..b983c671cd9 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1340,7 +1340,7 @@ tcl-current-word If FLAG is nil, just uses `current-word'. Otherwise scans backward for most likely Tcl command word." (if (and flag - (derived-mode-p 'tcl-mode 'inferior-tcl-mode)) + (derived-mode-p '(tcl-mode inferior-tcl-mode))) (condition-case nil (save-excursion ;; Look backward for first word actually in alist. @@ -1575,7 +1575,7 @@ tcl-quote (if (memq char '(?\[ ?\] ?{ ?} ?\\ ?\" ?$ ?\s ?\;)) (concat "\\" (char-to-string char)) (char-to-string char))) - string "")) + string)) diff --git a/lisp/simple.el b/lisp/simple.el index de6eed3fe8f..2e2d73e9bf4 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2427,9 +2427,7 @@ command-completion-with-modes-p "Say whether MODES are in action in BUFFER. This is the case if either the major mode is derived from one of MODES, or (if one of MODES is a minor mode), if it is switched on in BUFFER." - (or (apply #'provided-mode-derived-p - (buffer-local-value 'major-mode buffer) - modes) + (or (provided-mode-derived-p (buffer-local-value 'major-mode buffer) modes) ;; It's a minor mode. (seq-intersection modes (buffer-local-value 'local-minor-modes buffer) diff --git a/lisp/so-long.el b/lisp/so-long.el index e5f7b81e717..d91002e873a 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -1716,7 +1716,7 @@ so-long--set-auto-mode (not so-long--inhibited) (not so-long--calling) (or (eq so-long-target-modes t) - (apply #'derived-mode-p so-long-target-modes)) + (derived-mode-p so-long-target-modes)) (setq so-long-detected-p (funcall so-long-predicate)) ;; `so-long' should be called; but only if and when the buffer is ;; displayed in a window. Long lines in invisible buffers are generally diff --git a/lisp/transient.el b/lisp/transient.el index 52c21871548..dd2b4e0db0b 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1959,10 +1959,11 @@ transient--do-suffix-p (if-not-mode (not (if (atom if-not-mode) (eq major-mode if-not-mode) (memq major-mode if-not-mode)))) - (if-derived (if (atom if-derived) + (if-derived (if (or (atom if-derived) (>= emacs-major-version 30)) (derived-mode-p if-derived) (apply #'derived-mode-p if-derived))) - (if-not-derived (not (if (atom if-not-derived) + (if-not-derived (not (if (or (atom if-not-derived) + (>= emacs-major-version 30)) (derived-mode-p if-not-derived) (apply #'derived-mode-p if-not-derived)))) (t default))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d768af678c3..1bd9ecb2193 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1084,7 +1084,7 @@ vc-deduce-backend ((derived-mode-p 'log-edit-mode) log-edit-vc-backend) ((derived-mode-p 'diff-mode) diff-vc-backend) ((or (null vc-deduce-backend-nonvc-modes) - (apply #'derived-mode-p vc-deduce-backend-nonvc-modes)) + (derived-mode-p vc-deduce-backend-nonvc-modes)) (ignore-errors (vc-responsible-backend default-directory))) (vc-mode (vc-backend buffer-file-name)))) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 86fc179396e..f4095c99089 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1026,8 +1026,8 @@ whitespace-enable-predicate ((eq whitespace-global-modes t)) ((listp whitespace-global-modes) (if (eq (car-safe whitespace-global-modes) 'not) - (not (apply #'derived-mode-p (cdr whitespace-global-modes))) - (apply #'derived-mode-p whitespace-global-modes))) + (not (derived-mode-p (cdr whitespace-global-modes))) + (derived-mode-p whitespace-global-modes))) (t nil)) ;; ...we have a display (not running a batch job) (not noninteractive) diff --git a/lisp/window.el b/lisp/window.el index 06d5cfc0077..0c5ccf167dc 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8054,10 +8054,8 @@ display-buffer-reuse-mode-window (dolist (window windows) (let ((mode? (with-current-buffer (window-buffer window) - (cond ((memq major-mode allowed-modes) - 'same) - ((apply #'derived-mode-p allowed-modes) - 'derived))))) + (cond ((memq major-mode allowed-modes) 'same) + ((derived-mode-p allowed-modes) 'derived))))) (when (and mode? (not (and inhibit-same-window-p (eq window curwin)))) commit e6556db4200ccf28bd9bb033be0d5ce3cd2316a9 Author: Stefan Monnier Date: Thu Nov 16 17:21:18 2023 -0500 (derived-mode-p): Take MODES as a single argument Looking at uses of `derived-mode-p` and `provide-mode-derived-p`, I can't find a single use case where it wouldn't be preferable for it to take a single argument instead of `&rest`: all the calls are either passing a single argument anyway, or passing a fixed list of modes. The use of `&rest` just makes the code less efficient and sometimes more clunky (because of the need for `apply`). So let's change that (while preserving backward compatibility, of course). * doc/lispref/modes.texi (Derived Modes): Adjust accordingly. * lisp/subr.el (provided-mode-derived-p, derived-mode-p): Take the `modes` as a single argument. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 8670807cbdf..13090a13d71 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -932,9 +932,14 @@ Derived Modes @code{define-derived-mode} does that automatically. @end defmac -@defun derived-mode-p &rest 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 symbols @var{modes}. +derived from any of the major modes given by the list of symbols +in @var{modes}. +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. @end defun The graph of major modes is accessed with the following lower-level diff --git a/etc/NEWS b/etc/NEWS index 8794239c148..c0f76ed052b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1228,8 +1228,15 @@ values. Mostly used internally to do a kind of topological sort of inheritance hierarchies. -** New API to control the graph of major modes. -While 'define-derived-mode' still only support single inheritance, +** 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. +The same holds for `provided-mode-derived-p`. +The old calling convention where multiple modes are passed as +separate arguments is deprecated. + +*** New functions to access the graph of major modes. +While 'define-derived-mode' still only supports single inheritance, modes can declare additional parents (for tests like 'derived-mode-p') with `derived-mode-add-parents`. Accessing the 'derived-mode-parent' property directly is now diff --git a/lisp/subr.el b/lisp/subr.el index dcf49509177..304b71e6168 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2782,19 +2782,31 @@ derived-mode-all-parents (cons mode (remq mode all-parents)) (put mode 'derived-mode--all-parents (cons mode all-parents)))))))) -(defun provided-mode-derived-p (mode &rest modes) - "Non-nil if MODE is derived from one of MODES. -If you just want to check `major-mode', use `derived-mode-p'." - (declare (side-effect-free t)) +(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'. +We also still support the deprecated calling convention: +\(provided-mode-derived-p MODE &rest MODES)." + (declare (side-effect-free t) + (advertised-calling-convention (mode modes) "30.1")) + (cond + (old-modes (setq modes (cons modes old-modes))) + ((not (listp modes)) (setq modes (list modes)))) (let ((ps (derived-mode-all-parents mode))) (while (and modes (not (memq (car modes) ps))) (setq modes (cdr modes))) (car modes))) -(defun derived-mode-p (&rest modes) - "Non-nil if the current major mode is derived from one of MODES." - (declare (side-effect-free t)) - (apply #'provided-mode-derived-p major-mode modes)) +(defun derived-mode-p (&optional modes &rest old-modes) + "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. +We also still support the deprecated calling convention: +\(derived-mode-p &rest MODES)." + (declare (side-effect-free t) + (advertised-calling-convention (modes) "30.1")) + (provided-mode-derived-p major-mode (if old-modes (cons modes old-modes) + modes))) (defun derived-mode-set-parent (mode parent) "Declare PARENT to be the parent of MODE." commit 9bda21ad0dddc5d84b6fca269626adeaa608b7a1 Author: Alan Mackenzie Date: Thu Nov 23 16:31:52 2023 +0000 CC Mode: Handle noise clauses, template arglists in any order This fixes the first part of bug#66911. * lisp/progmodes/cc-engine.el (c-looking-at-decl-block): Skip back over template arglists and noise clauses in any order, no longer assuming the noise clauses are before the template arglist in the buffer. When scanning forward, take noise clauses into account. Refactor a collection of nested `if' forms as a cond form. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f5e0d21108f..1fc02d1ad07 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12617,31 +12617,27 @@ c-looking-at-decl-block (let ((open-brace (point)) kwd-start first-specifier-pos) (c-syntactic-skip-backward c-block-prefix-charset limit t) - (when (and c-recognize-<>-arglists - (eq (char-before) ?>)) - ;; Could be at the end of a template arglist. - (let ((c-parse-and-markup-<>-arglists t)) - (while (and - (c-backward-<>-arglist nil limit) - (progn - (c-syntactic-skip-backward c-block-prefix-charset limit t) - (eq (char-before) ?>)))))) - - ;; Skip back over noise clauses. - (while (and - c-opt-cpp-prefix - (eq (char-before) ?\)) - (let ((after-paren (point))) - (if (and (c-go-list-backward) - (progn (c-backward-syntactic-ws) - (c-simple-skip-symbol-backward)) - (or (looking-at c-paren-nontype-key) - (looking-at c-noise-macro-with-parens-name-re))) - (progn - (c-syntactic-skip-backward c-block-prefix-charset limit t) - t) - (goto-char after-paren) - nil)))) + (while + (or + ;; Could be after a template arglist.... + (and c-recognize-<>-arglists + (eq (char-before) ?>) + (let ((c-parse-and-markup-<>-arglists t)) + (c-backward-<>-arglist nil limit))) + ;; .... or after a noise clause with parens. + (and c-opt-cpp-prefix + (let ((after-paren (point))) + (if (eq (char-before) ?\)) + (and + (c-go-list-backward) + (eq (char-after) ?\() + (progn (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward)) + (or (looking-at c-paren-nontype-key) ; e.g. __attribute__ + (looking-at c-noise-macro-with-parens-name-re))) + (goto-char after-paren) + nil)))) + (c-syntactic-skip-backward c-block-prefix-charset limit t)) ;; Note: Can't get bogus hits inside template arglists below since they ;; have gotten paren syntax above. @@ -12651,10 +12647,18 @@ c-looking-at-decl-block ;; The `c-decl-block-key' search continues from there since ;; we know it can't match earlier. (if goto-start - (when (c-syntactic-re-search-forward c-symbol-start - open-brace t t) - (goto-char (setq first-specifier-pos (match-beginning 0))) - t) + (progn + (while + (and + (c-syntactic-re-search-forward c-symbol-start + open-brace t t) + (goto-char (match-beginning 0)) + (if (or (looking-at c-noise-macro-name-re) + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause) + (setq first-specifier-pos (match-beginning 0)) + nil))) + first-specifier-pos) t) (cond @@ -12723,34 +12727,39 @@ c-looking-at-decl-block (goto-char first-specifier-pos) (while (< (point) kwd-start) - (if (looking-at c-symbol-key) - ;; Accept any plain symbol token on the ground that - ;; it's a specifier masked through a macro (just - ;; like `c-forward-decl-or-cast-1' skip forward over - ;; such tokens). - ;; - ;; Could be more restrictive wrt invalid keywords, - ;; but that'd only occur in invalid code so there's - ;; no use spending effort on it. - (let ((end (match-end 0)) - (kwd-sym (c-keyword-sym (match-string 0)))) - (unless - (and kwd-sym - ;; Moving over a protection kwd and the following - ;; ":" (in C++ Mode) to the next token could take - ;; us all the way up to `kwd-start', leaving us - ;; no chance to update `first-specifier-pos'. - (not (c-keyword-member kwd-sym 'c-protection-kwds)) - (c-forward-keyword-clause 0)) - (goto-char end) - (c-forward-syntactic-ws))) - + (cond + ((or (looking-at c-noise-macro-name-re) + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause)) + ((looking-at c-symbol-key) + ;; Accept any plain symbol token on the ground that + ;; it's a specifier masked through a macro (just + ;; like `c-forward-decl-or-cast-1' skips forward over + ;; such tokens). + ;; + ;; Could be more restrictive wrt invalid keywords, + ;; but that'd only occur in invalid code so there's + ;; no use spending effort on it. + (let ((end (match-end 0)) + (kwd-sym (c-keyword-sym (match-string 0)))) + (unless + (and kwd-sym + ;; Moving over a protection kwd and the following + ;; ":" (in C++ Mode) to the next token could take + ;; us all the way up to `kwd-start', leaving us + ;; no chance to update `first-specifier-pos'. + (not (c-keyword-member kwd-sym 'c-protection-kwds)) + (c-forward-keyword-clause 0)) + (goto-char end) + (c-forward-syntactic-ws)))) + + ((c-syntactic-re-search-forward c-symbol-start + kwd-start 'move t) ;; Can't parse a declaration preamble and is still ;; before `kwd-start'. That means `first-specifier-pos' ;; was in some earlier construct. Search again. - (if (c-syntactic-re-search-forward c-symbol-start - kwd-start 'move t) - (goto-char (setq first-specifier-pos (match-beginning 0))) + (goto-char (setq first-specifier-pos (match-beginning 0)))) + (t ;; Got no preamble before the block declaration keyword. (setq first-specifier-pos kwd-start)))) commit 99658346d1edce5248a8d8db76de772b04381e7f Author: Eli Zaretskii Date: Thu Nov 23 17:56:50 2023 +0200 ; Improve documentation of desktop.el in user manual * doc/emacs/misc.texi (Saving Emacs Sessions): Mention saving minibuffer history via desktop.el. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 1f21a5be0b3..56cd95f82ba 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2838,8 +2838,11 @@ Saving Emacs Sessions @code{desktop-clear-preserve-buffers-regexp}, whose value is a regular expression matching the names of buffers not to kill. +@vindex desktop-globals-to-save If you want to save minibuffer history from one session to -another, use the @code{savehist} library. +another, use the @code{savehist} library. You can also save selected +minibuffer-history variables as part of @code{desktop-save-mode} if +you add those variables to the value of @code{desktop-globals-to-save}. @node Recursive Edit @section Recursive Editing Levels commit f7dc0202127a73f83de52b1999a7fe05dd64fff6 Author: George Kuzler Date: Wed Nov 22 19:45:55 2023 -0500 Fix "Text is read-only" on backspacing initial Calc input Immediately after `calc-mode' opens the minibuffer for input (because you typed a digit, "e", etc), pressing backspace should clear the minibuffer and return you to the *Calculator* buffer. Instead, it leaves the minibuffer as-is and prints the message "Text is read-only"; this is because the function used, `erase-buffer', tries to erase the read-only minibuffer prompt. Using `delete-minibuffer-contents' fixes this, since it doesn't attempt to delete the prompt. * lisp/calc/calc.el (calcDigit-backspace): Use `delete-minibuffer-contents' instead of `erase-buffer'. (Bug#67395) Copyright-paperwork-exempt: yes diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index f129552c9a4..06ccb0f0cfa 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2477,7 +2477,7 @@ calcDigit-key (defun calcDigit-backspace () (interactive) (cond ((eq last-command 'calcDigit-start) - (erase-buffer)) + (delete-minibuffer-contents)) (t (backward-delete-char 1))) (if (= (calc-minibuffer-size) 0) (progn commit 662d54775d53cceb39cc65f1275972b6272a8158 Author: Jeremy Bryant Date: Tue Nov 21 23:27:44 2023 +0000 Add a doc string to simple.el (bug#67355) * lisp/simple.el (kill-buffer--possibly-save): Add doc string. diff --git a/lisp/simple.el b/lisp/simple.el index b770d9d7d33..9ef348f74dc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10863,6 +10863,10 @@ scratch-buffer (pop-to-buffer-same-window (get-scratch-buffer-create))) (defun kill-buffer--possibly-save (buffer) + "Ask the user to confirm killing of a modified BUFFER. + +If the user confirms, optionally save BUFFER that is about to be +killed." (let ((response (cadr (read-multiple-choice commit 5a5e36d2aad77a4eb80249895d809187630eacc8 Author: Eli Zaretskii Date: Thu Nov 23 17:26:09 2023 +0200 ; Improve function documentation tips * doc/lispref/tips.texi (Documentation Tips): Clarify the good style of descriptions in doc strings. diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index db9f64aa8a0..f0d4753e41b 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -631,7 +631,12 @@ Documentation Tips For a function, the first line should briefly answer the question, ``What does this function do?'' For a variable, the first line should -briefly answer the question, ``What does this value mean?'' +briefly answer the question, ``What does this value mean?'' Prefer to +answer these questions in a way that will make sense to users and +callers of the function or the variable. In particular, do @emph{not} +tell what the function does by enumerating the actions of its code; +instead, describe the role of these actions and the function's +contract. Don't limit the documentation string to one line; use as many lines as you need to explain the details of how to use the function or commit 86016d8ecdb3db4a1a2c6f85a4239f2fdaacd69a Author: Eli Zaretskii Date: Thu Nov 23 16:56:10 2023 +0200 Mention "visual line" in user manual * doc/emacs/display.texi (Visual Line Mode): * doc/emacs/basic.texi (Continuation Lines, Moving Point): Mention "visual line". (Bug#67382) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index a271cb65bdc..d41e5f2f16c 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -360,15 +360,15 @@ Moving Point @vindex line-move-visual When a line of text in the buffer is longer than the width of the -window, Emacs usually displays it on two or more @dfn{screen lines}. -For convenience, @kbd{C-n} and @kbd{C-p} move point by screen lines, -as do the equivalent keys @kbd{@key{down}} and @kbd{@key{up}}. You -can force these commands to move according to @dfn{logical lines} -(i.e., according to the text lines in the buffer) by setting the -variable @code{line-move-visual} to @code{nil}; if a logical line -occupies multiple screen lines, the cursor then skips over the -additional screen lines. For details, see @ref{Continuation Lines}. -@xref{Variables}, for how to set variables such as +window, Emacs usually displays it on two or more @dfn{screen lines}, +a.k.a.@: @dfn{visual lines}. For convenience, @kbd{C-n} and @kbd{C-p} +move point by screen lines, as do the equivalent keys @kbd{@key{down}} +and @kbd{@key{up}}. You can force these commands to move according to +@dfn{logical lines} (i.e., according to the text lines in the buffer) +by setting the variable @code{line-move-visual} to @code{nil}; if a +logical line occupies multiple screen lines, the cursor then skips +over the additional screen lines. For details, see @ref{Continuation +Lines}. @xref{Variables}, for how to set variables such as @code{line-move-visual}. Unlike @kbd{C-n} and @kbd{C-p}, most of the Emacs commands that work @@ -596,10 +596,13 @@ Continuation Lines @cindex wrapping @cindex line wrapping @cindex fringes, and continuation lines +@cindex logical line +@cindex screen line +@cindex visual line Sometimes, a line of text in the buffer---a @dfn{logical line}---is too long to fit in the window, and Emacs displays it as two or more -@dfn{screen lines}. This is called @dfn{line wrapping} or -@dfn{continuation}, and the long logical line is called a +@dfn{screen lines}, or @dfn{visual lines}. This is called @dfn{line +wrapping} or @dfn{continuation}, and the long logical line is called a @dfn{continued line}. On a graphical display, Emacs indicates line wrapping with small bent arrows in the left and right window fringes. On a text terminal, Emacs indicates line wrapping by displaying a diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index cc178dbe99f..d9da4c1335c 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2010,9 +2010,10 @@ Visual Line Mode @section Visual Line Mode @cindex word wrap - Another alternative to ordinary line continuation is to use -@dfn{word wrap}. Here, each long logical line is divided into two or -more screen lines, like in ordinary line continuation. However, Emacs + Another alternative to ordinary line continuation +(@pxref{Continuation Lines}) is to use @dfn{word wrap}. Here, each +long logical line is divided into two or more screen lines, or +``visual lines'', like in ordinary line continuation. However, Emacs attempts to wrap the line at word boundaries near the right window edge. (If the line's direction is right-to-left, it is wrapped at the left window edge instead.) This makes the text easier to read, as commit 4bb65ed77a87c146d06f6c3803bd99dbfce213f1 Author: Eli Zaretskii Date: Thu Nov 23 16:43:17 2023 +0200 ; * doc/lispref/minibuf.texi (Programmed Completion): Improve indexing. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 620c58ec6e9..67af4d0ad67 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1977,6 +1977,7 @@ Programmed Completion boundaries. @xref{Basic Completion}, for the precise expected semantics of completion boundaries. +@cindex completion metadata @item metadata This specifies a request for information about the state of the current completion. The return value should have the form @@ -1993,6 +1994,8 @@ Programmed Completion may return in response to a @code{metadata} flag argument: @table @code +@cindex @code{category}, in completion +@cindex completion category @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 commit dfb3dcb404c75f19a3d22938c33390f362141fe2 Author: Eli Zaretskii Date: Thu Nov 23 16:07:31 2023 +0200 Allow listing Emoji from a read-only buffer * lisp/international/emoji.el (emoji-list): Don't barf here if the original buffer is read-inly... (emoji-list-select): ...barf here instead. (Bug#67400) (emoji-list): Doc fix. diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 8a34be91d10..4070553be55 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -103,11 +103,11 @@ emoji-search ;;;###autoload (defun emoji-list () - "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." - (interactive "*") + (interactive) (let ((buf (current-buffer))) (emoji--init) (switch-to-buffer (get-buffer-create "*Emoji*")) @@ -219,7 +219,9 @@ emoji-list-select (let ((buf emoji--insert-buffer)) (quit-window) (if (buffer-live-p buf) - (switch-to-buffer buf) + (progn + (switch-to-buffer buf) + (barf-if-buffer-read-only)) (error "Buffer disappeared")))))) (if (not derived) ;; Glyph without derivations. commit 102a848d991c1b7edcbf2f75f2a41ba0565c5f6b Author: Philipp Stephani Date: Thu Nov 23 13:34:47 2023 +0100 ; * src/module-env-30.h: Fix commentary diff --git a/src/module-env-30.h b/src/module-env-30.h index 6ca03773181..e75210c7f8e 100644 --- a/src/module-env-30.h +++ b/src/module-env-30.h @@ -1,3 +1,3 @@ - /* Add module environment functions newly added in Emacs 29 here. - Before Emacs 29 is released, remove this comment and start - module-env-30.h on the master branch. */ + /* Add module environment functions newly added in Emacs 30 here. + Before Emacs 30 is released, remove this comment and start + module-env-31.h on the master branch. */ commit 47755303576d56bda581637c3d474b249c8dac49 Author: Po Lu Date: Thu Nov 23 15:05:31 2023 +0800 Prevent tab bar from vanishing on Android * src/androidfns.c (android_change_tab_bar_height): Amend with code absent when the function was first transcribed. * src/haikufns.c (haiku_change_tab_bar_height): * src/nsfns.m (ns_change_tab_bar_height): * src/pgtkfns.c (pgtk_change_tab_bar_height): * src/w32fns.c (w32_change_tab_bar_height): * src/xfns.c (x_change_tab_bar_height): Revise commentary. diff --git a/src/androidfns.c b/src/androidfns.c index aeba9d897ad..31a4924e34d 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -367,8 +367,16 @@ android_change_tab_bar_height (struct frame *f, int height) the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed, leading to the tab bar height being incorrectly set upon the next call to android_set_font. (bug#59285) */ + lines = height / unit; + /* Even so, HEIGHT might be less than unit if the tab bar face is + not so tall as the frame's font height; which if true lines will + be set to 0 and the tab bar will thus vanish. */ + + if (lines == 0 && height != 0) + lines = 1; + /* Make sure we redisplay all windows in this frame. */ fset_redisplay (f); diff --git a/src/haikufns.c b/src/haikufns.c index 8028a73abd1..e6b1f618d5b 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -184,6 +184,11 @@ haiku_change_tab_bar_height (struct frame *f, int height) leading to the tab bar height being incorrectly set upon the next call to x_set_font. (bug#59285) */ int lines = height / unit; + + /* Even so, HEIGHT might be less than unit if the tab bar face is + not so tall as the frame's font height; which if true lines will + be set to 0 and the tab bar will thus vanish. */ + if (lines == 0 && height != 0) lines = 1; diff --git a/src/nsfns.m b/src/nsfns.m index 038a3fa23ad..33c6020ad51 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -641,6 +641,11 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. leading to the tab bar height being incorrectly set upon the next call to x_set_font. (bug#59285) */ int lines = height / unit; + + /* Even so, HEIGHT might be less than unit if the tab bar face is + not so tall as the frame's font height; which if true lines will + be set to 0 and the tab bar will thus vanish. */ + if (lines == 0 && height != 0) lines = 1; diff --git a/src/pgtkfns.c b/src/pgtkfns.c index c154d37f47f..13ac61de960 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -475,6 +475,11 @@ pgtk_change_tab_bar_height (struct frame *f, int height) leading to the tab bar height being incorrectly set upon the next call to x_set_font. (bug#59285) */ int lines = height / unit; + + /* Even so, HEIGHT might be less than unit if the tab bar face is + not so tall as the frame's font height; which if true lines will + be set to 0 and the tab bar will thus vanish. */ + if (lines == 0 && height != 0) lines = 1; diff --git a/src/w32fns.c b/src/w32fns.c index 07b389df84a..01644eff826 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1732,6 +1732,11 @@ w32_change_tab_bar_height (struct frame *f, int height) leading to the tab bar height being incorrectly set upon the next call to x_set_font. (bug#59285) */ int lines = height / unit; + + /* Even so, HEIGHT might be less than unit if the tab bar face is + not so tall as the frame's font height; which if true lines will + be set to 0 and the tab bar will thus vanish. */ + if (lines == 0 && height != 0) lines = 1; diff --git a/src/xfns.c b/src/xfns.c index 0b1e94af9f0..eadf46b44c4 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1792,6 +1792,11 @@ x_change_tab_bar_height (struct frame *f, int height) leading to the tab bar height being incorrectly set upon the next call to x_set_font. (bug#59285) */ int lines = height / unit; + + /* Even so, HEIGHT might be less than unit if the tab bar face is + not so tall as the frame's font height; which if true lines will + be set to 0 and the tab bar will thus vanish. */ + if (lines == 0 && height != 0) lines = 1; commit e1c0c5def3d1dc93e34180ccdf88a6aaaad59ea3 Author: Po Lu Date: Thu Nov 23 08:20:51 2023 +0800 ; * doc/emacs/input.texi (On-Screen Keyboards): Fix typos. diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index 788a321ce3e..7f9d37b52de 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -132,7 +132,7 @@ On-Screen Keyboards virtual keyboard, in anticipation that the user is about to enter text there. - The default value of @code{touch-point-set-point-commands} holds + The default value of @code{touch-screen-set-point-commands} holds only the command @code{mouse-set-point} (@pxref{Mouse Commands}), which is the default binding of @code{mouse-1}, and thus of touchscreen tap gestures as well. @@ -144,7 +144,7 @@ On-Screen Keyboards always display the keyboard in response to a tap on a window displaying the buffer it is set in. - There are moreover a set of functions to show or hide the on-screen + There are moreover several functions to show or hide the on-screen keyboard. For more details, @xref{On-Screen Keyboards,,, elisp, The Emacs Lisp Reference Manual}. commit 7f359d248874a6fc6a1472247d3982c85dc11544 Author: Andrea Corallo Date: Wed Nov 22 17:51:45 2023 -0500 (package-quickstart-refresh): Generate marginally more efficient code * lisp/emacs-lisp/package.el (package-quickstart-refresh): Include only one copy of the file names. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index e23a61c58a4..d4bb6710283 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4612,8 +4612,8 @@ package-quickstart-refresh (let ((load-suffixes '(".el" ".elc"))) (locate-library (package--autoloads-file-name pkg)))) (pfile (prin1-to-string file))) - (insert "(let ((load-true-file-name " pfile ")\ -\(load-file-name " pfile "))\n") + (insert "(let* ((load-file-name " pfile ")\ +\(load-true-file-name load-file-name))\n") (insert-file-contents file) ;; Fixup the special #$ reader form and throw away comments. (while (re-search-forward "#\\$\\|^;\\(.*\n\\)" nil 'move) commit 366c316a2f869f287f6c5d5e9b3819bac6625caf Author: Andrea Corallo Date: Wed Nov 22 16:37:16 2023 +0100 * Update 'native-comp-never-optimize-functions' version * lisp/emacs-lisp/comp-common.el (native-comp-never-optimize-functions): Update version. diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 1bdb7280399..6d94d1bd82e 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -60,7 +60,7 @@ native-comp-never-optimize-functions directly by the natively-compiled code, which makes trampolines for those primitives unnecessary in case of function redefinition/advice." :type '(repeat symbol) - :version "28.1") + :version "30.1") (defcustom native-comp-async-env-modifier-form nil "Form evaluated before compilation by each asynchronous compilation subprocess. commit cfd47e516fa36a130e0c02e3dd75eded86938445 Author: Andrea Corallo Date: Wed Nov 22 16:30:01 2023 +0100 * configure.ac: Fix non posix (bash only) eq operator diff --git a/configure.ac b/configure.ac index c3019564143..debc6d1078f 100644 --- a/configure.ac +++ b/configure.ac @@ -5149,7 +5149,7 @@ AC_DEFUN with_native_compilation=no]) -if test "${with_native_compilation}" == "default"; then +if test "${with_native_compilation}" = "default"; then # Check if libgccjit is available. AC_CHECK_LIB([gccjit], [gcc_jit_context_acquire], [], [libgccjit_not_found]) commit 025cd2a9c213ee6e6f6506f586713c2b476fc053 Author: Michael Albinus Date: Wed Nov 22 13:50:06 2023 +0100 Unify "."" and ".." handling in tramp-*-file-name-all-completions * 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.el (tramp-skeleton-file-name-all-completions): Handle "."" and "..". diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index acbf5ec01c6..e4d3ba8c74b 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -450,14 +450,10 @@ tramp-adb-handle-file-name-all-completions (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-fuse.el b/lisp/net/tramp-fuse.el index 4b04f75ce96..30516ce9ecc 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -106,17 +106,8 @@ tramp-fuse-handle-file-name-all-completions (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 573d89c0c51..35778aca6d4 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1469,7 +1469,7 @@ tramp-gvfs-handle-file-name-all-completions 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.el b/lisp/net/tramp.el index a21e6823424..e19b8c78f8c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2742,19 +2742,27 @@ tramp-completion-handle-file-exists-p (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)) `(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)))))) commit 04aa76bb9205a0d5f1feff091c6c561bd9db54a5 Author: Michael Albinus Date: Wed Nov 22 13:48:57 2023 +0100 Fix CRLF handling in Tramp * lisp/net/tramp-sh.el (tramp-send-command-and-read): Use 'space' instead of 'blank' in rx expression, in order to handle also CR and alike. Reported by Dominique Quatravaux . diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 186ef12775a..3b47dafcb46 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5540,7 +5540,7 @@ tramp-send-command-and-read (unless noerror signal-hook-function))) (read (current-buffer))) ;; Error handling. - (when (search-forward-regexp (rx (not blank)) (line-end-position) t) + (when (search-forward-regexp (rx (not space)) (line-end-position) t) (error nil))) (error (unless noerror (tramp-error commit 8256bf4cdfbdc12838c20b00edcaedddcdf08a32 Author: Michael Albinus Date: Wed Nov 22 13:29:19 2023 +0100 Fix CRLF handling in Tramp (don't merge) * lisp/net/tramp-sh.el (tramp-send-command-and-read): Use 'space' instead of 'blank' in rx expression, in order to handle also CR and alike. Reported by Dominique Quatravaux . diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7dc75cb337a..aa1d025bf19 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5509,7 +5509,7 @@ tramp-send-command-and-read (unless noerror signal-hook-function))) (read (current-buffer))) ;; Error handling. - (when (re-search-forward (rx (not blank)) (line-end-position) t) + (when (re-search-forward (rx (not space)) (line-end-position) t) (error nil))) (error (unless noerror (tramp-error commit f50e54c01e84323e2689d79864dd9d65974d4429 Author: Po Lu Date: Wed Nov 22 11:25:23 2023 +0800 ; * lisp/touch-screen.el (touch-screen-handle-touch): Correct typo. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 72e22cfd79c..f6a47e69d81 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1662,20 +1662,22 @@ touch-screen-handle-touch (when touch-screen-current-timer (cancel-timer touch-screen-current-timer) (setq touch-screen-current-timer nil)) - (unwind-protect - ;; Don't perform any actions associated with releasing the - ;; tool if the touch sequence was intercepted by another - ;; program. - (unless (caddr event) - (touch-screen-handle-point-up (cadr event) prefix)) - ;; If an ancillary tool is present the function call above - ;; will merely transfer information from it into the current - ;; tool list, thereby rendering it the new current tool, - ;; until such time as it too is released. - (if (or (caddr event) touch-screen-aux-tool) - ;; Make sure the tool list is cleared even if - ;; `touch-screen-handle-point-up' throws. - (setq touch-screen-current-tool nil)))) + (let ((old-aux-tool touch-screen-aux-tool)) + (unwind-protect + ;; Don't perform any actions associated with releasing the + ;; tool if the touch sequence was intercepted by another + ;; program. + (if (caddr event) + (setq touch-screen-current-tool nil) + (touch-screen-handle-point-up (cadr event) prefix)) + ;; If an ancillary tool is present the function call above + ;; will merely transfer information from it into the current + ;; tool list, thereby rendering it the new current tool, + ;; until such time as it too is released. + (when (not (and old-aux-tool (not touch-screen-aux-tool))) + ;; Make sure the tool list is cleared even if + ;; `touch-screen-handle-point-up' throws. + (setq touch-screen-current-tool nil))))) ;; If it is rather the ancillary tool, delete its vector. No ;; further action is required, for the next update received will ;; resume regular gesture recognition. commit 148250f0748cc48baf1e8068c52b2bffee6a0204 Author: Po Lu Date: Wed Nov 22 11:10:13 2023 +0800 Update touch-screen.el * lisp/touch-screen.el (touch-screen-handle-aux-point-update): Wrap exceptionally wide form. (touch-screen-handle-touch): Guarantee that only tools from the same frame as the current tool will be considered ancillary tools. Further guarantee that normal gesture translation can resume even if a touchscreen-end event is omitted or overlooked. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 1ce679cd41a..72e22cfd79c 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1210,31 +1210,32 @@ touch-screen-handle-aux-point-update (/ (frame-char-width) 2))) (aset touch-screen-aux-tool 5 centrum) (aset touch-screen-aux-tool 6 ratio) - (throw 'input-event (list 'touchscreen-pinch - (if (or (<= (car centrum) 0) - (<= (cdr centrum) 0)) - (list window nil centrum nil nil - nil nil nil nil nil) - (let ((posn (posn-at-x-y (car centrum) - (cdr centrum) - window))) - (if (eq (posn-window posn) - window) - posn - ;; Return a placeholder - ;; outside the window if - ;; the centrum has moved - ;; beyond the confines of - ;; the window where the - ;; gesture commenced. - (list window nil centrum nil nil - nil nil nil nil nil)))) - ratio - (- (car centrum) - (car initial-centrum)) - (- (cdr centrum) - (cdr initial-centrum)) - ratio-diff)))))))) + (throw 'input-event + (list 'touchscreen-pinch + (if (or (<= (car centrum) 0) + (<= (cdr centrum) 0)) + (list window nil centrum nil nil + nil nil nil nil nil) + (let ((posn (posn-at-x-y (car centrum) + (cdr centrum) + window))) + (if (eq (posn-window posn) + window) + posn + ;; Return a placeholder + ;; outside the window if + ;; the centrum has moved + ;; beyond the confines of + ;; the window where the + ;; gesture commenced. + (list window nil centrum nil nil + nil nil nil nil nil)))) + ratio + (- (car centrum) + (car initial-centrum)) + (- (cdr centrum) + (cdr initial-centrum)) + ratio-diff)))))))) (defun touch-screen-window-selection-changed (frame) "Notice that FRAME's selected window has changed. @@ -1491,7 +1492,12 @@ touch-screen-handle-touch ;; auxiliary tool was first pressed, then interpreted as a ;; scale by which to adjust text within the current tool's ;; window. - (progn + (when (eq (if (framep window) window (window-frame window)) + ;; Verify that the new tool was placed on the + ;; same frame the current tool has, so as not to + ;; consider events distributed across distinct + ;; frames components of a single gesture. + (window-frame (nth 1 touch-screen-current-tool))) ;; Set touch-screen-aux-tool as is proper. Mind that ;; the last field is always relative to the current ;; tool's window. @@ -1618,13 +1624,28 @@ touch-screen-handle-touch ;; The positions of tools currently pressed against the screen ;; have changed. If there is a tool being tracked as part of a ;; gesture, look it up in the list of tools. - (let ((new-point (assq (car touch-screen-current-tool) - (cadr event)))) - (when new-point + (if-let ((new-point (assq (car touch-screen-current-tool) + (cadr event)))) (if touch-screen-aux-tool (touch-screen-handle-aux-point-update (cdr new-point) (car new-point)) - (touch-screen-handle-point-update new-point)))) + (touch-screen-handle-point-update new-point)) + ;; If the current tool exists no longer, a touchscreen-end + ;; event is certain to have been disregarded. So that + ;; touchscreen gesture translation might continue as usual + ;; after this aberration to the normal flow of events, delete + ;; the current tool now. + (when touch-screen-current-timer + ;; Cancel the touch screen long-press timer, if it is still + ;; there by any chance. + (cancel-timer touch-screen-current-timer) + (setq touch-screen-current-timer nil)) + ;; Don't call `touch-screen-handle-point-up' when terminating + ;; translation abnormally. + (setq touch-screen-current-tool nil + ;; Delete the ancillary tool while at it. + touch-screen-aux-tool nil) + (message "Current touch screen tool vanished!")) ;; Check for updates to any ancillary point being monitored. (when touch-screen-aux-tool (let ((new-point (assq (aref touch-screen-aux-tool 0) @@ -1647,9 +1668,14 @@ touch-screen-handle-touch ;; program. (unless (caddr event) (touch-screen-handle-point-up (cadr event) prefix)) - ;; Make sure the tool list is cleared even if - ;; `touch-screen-handle-point-up' throws. - (setq touch-screen-current-tool nil))) + ;; If an ancillary tool is present the function call above + ;; will merely transfer information from it into the current + ;; tool list, thereby rendering it the new current tool, + ;; until such time as it too is released. + (if (or (caddr event) touch-screen-aux-tool) + ;; Make sure the tool list is cleared even if + ;; `touch-screen-handle-point-up' throws. + (setq touch-screen-current-tool nil)))) ;; If it is rather the ancillary tool, delete its vector. No ;; further action is required, for the next update received will ;; resume regular gesture recognition. commit 47e86445de82d6f45f55820926ef111bca7c71f1 Author: Po Lu Date: Wed Nov 22 11:07:13 2023 +0800 Insert NEWS entry for native compilation changes * etc/NEWS (Installation Changes in 30.1): Mention that native compilation has been enabled by default. diff --git a/etc/NEWS b/etc/NEWS index e14d15a7487..8794239c148 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -31,6 +31,14 @@ NDK, SDK, and a suitable Java compiler must also be installed. See the file 'java/INSTALL' for more details. +--- +** Native compilation is now enabled by default. +'configure' will enable the Emacs Lisp native compiler, so long as +libgccjit is present and functional on the system. To disable native +compilation, configure Emacs with the option: + + $ ./configure --with-native-compilation=no + --- ** Emacs now defaults to ossaudio library for sound on NetBSD and OpenBSD. Previously configure used ALSA libraries if installed on the commit 41b67c0318eecb87db88ef4df9a6f85178db17be Author: Po Lu Date: Wed Nov 22 11:00:04 2023 +0800 Disable native compilation in build machine Android binaries * configure.ac (XCONFIGURE): Set with_native_compilation to no. diff --git a/configure.ac b/configure.ac index 8768d69bbbb..c3019564143 100644 --- a/configure.ac +++ b/configure.ac @@ -1320,6 +1320,7 @@ AC_DEFUN with_mailutils=no with_pop=no with_harfbuzz=no + with_native_compilation=no fi with_rsvg=no commit 9af03e0e1897bce2fce71b79549d4461d7ea1dad Author: Noah Peart Date: Tue Nov 21 15:59:48 2023 +0200 typescript-ts-mode: Support indentation for conditionals without braces * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--indent-rules): Support indentation for conditionals without braces (bug#67031). * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts (Statement indentation without braces): New test. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index ec220ab8d03..4e039abd236 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -124,6 +124,11 @@ typescript-ts-mode--indent-rules ((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) + ((match "while" "do_statement") parent-bol 0) + ((match "else" "if_statement") parent-bol 0) + ((parent-is ,(rx (or (seq (or "if" "for" "for_in" "while" "do") "_statement") + "else_clause"))) + parent-bol typescript-ts-mode-indent-offset) ,@(when (eq language 'tsx) (append (tsx-ts-mode--indent-compatibility-b893426) diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts index 146ee76574e..20f423259b4 100644 --- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -23,6 +23,28 @@ const foo = () => { } =-=-= +Name: Statement indentation without braces + +=-= +const foo = () => { + if (true) + console.log("if_statement"); + else if (false) + console.log("if_statement"); + else + console.log("else_clause"); + for (let i = 0; i < 1; i++) + console.log("for_statement"); + for (let i of [true]) + console.log("for_in_statement"); + while (false) + console.log("while_statement"); + do + console.log("do_statement"); + while (false) +}; +=-=-= + Code: (lambda () (setq indent-tabs-mode nil) commit 61cdf42a48fab24b7ee4098ffedf7254080f808b Author: Theodor Thornhill Date: Mon Jan 16 14:33:27 2023 +0100 Backport: Add some basic tests for java-ts-mode and typescript-ts-mode * test/lisp/progmodes/java-ts-mode-resources/indent.erts: New file with tests for indentation. * test/lisp/progmodes/java-ts-mode-resources/movement.erts: New file with tests for movement. * test/lisp/progmodes/java-ts-mode-tests.el: New tests. * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: New file with tests for indentation. * test/lisp/progmodes/typescript-ts-mode-tests.el: New tests. (cherry picked from commit c8dd37b16c574beda900d4ee48ac7b4ab4a2ee56) diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..e59d5fed8e8 --- /dev/null +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -0,0 +1,44 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq java-ts-mode-indent-offset 2) + (java-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic + +=-= +public class Basic { + public void basic() { + return; + } +} +=-=-= + +Name: Empty Line + +=-= +public class EmptyLine { + public void emptyLine() { + | + } +} +=-=-= + +Name: Statements + +=-= +if (x) { + for (var foo : foos) { + | + } +} else if (y) { + for (int i = 0; x < foos.size(); i++) { + return; + } +} else { + return; +} +=-=-= diff --git a/test/lisp/progmodes/java-ts-mode-resources/movement.erts b/test/lisp/progmodes/java-ts-mode-resources/movement.erts new file mode 100644 index 00000000000..23639b1f5ff --- /dev/null +++ b/test/lisp/progmodes/java-ts-mode-resources/movement.erts @@ -0,0 +1,154 @@ +Code: + (lambda () + (java-ts-mode) + (forward-sentence 1)) + +Point-Char: | + +Name: forward-sentence moves over if + +=-= +public class Basic { + public void basic() { + |if (x) { + + } + log.info("some text: {}", text); + return; + } +} +=-= +public class Basic { + public void basic() { + if (x) { + + }| + log.info("some text: {}", text); + return; + } +} +=-=-= + +Name: forward-sentence moves over method invocation + +=-= +public class Basic { + public void basic() { + |log.info("some text: {}", text); + } +} +=-= +public class Basic { + public void basic() { + log.info("some text: {}", text);| + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (forward-sentence 2)) + +Name: forward-sentence moves over multiple statements + +=-= +public class Basic { + public void basic() { + |return; + return; + } +} +=-= +public class Basic { + public void basic() { + return; + return;| + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (backward-sentence 1)) + +Name: backward-sentence moves over one statement + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +public class Basic { + public void basic() { + |return; + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (beginning-of-defun)) + +Name: beginning-of-defun moves to defun start + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +public class Basic { +| public void basic() { + return; + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (beginning-of-defun) + (beginning-of-defun)) + +Name: beginning-of-defun moves to class + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +|public class Basic { + public void basic() { + return; + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (end-of-defun)) + +Name: end-of-defun moves to defun end + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +public class Basic { + public void basic() { + return; + } +|} +=-=-= diff --git a/test/lisp/progmodes/java-ts-mode-tests.el b/test/lisp/progmodes/java-ts-mode-tests.el new file mode 100644 index 00000000000..4fd8fc3019f --- /dev/null +++ b/test/lisp/progmodes/java-ts-mode-tests.el @@ -0,0 +1,35 @@ +;;; java-ts-mode-tests.el --- Tests for Tree-sitter-based Java mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 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 'treesit) + +(ert-deftest java-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'java)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(ert-deftest java-ts-mode-test-movement () + (skip-unless (treesit-ready-p 'java)) + (ert-test-erts-file (ert-resource-file "movement.erts"))) + +(provide 'java-ts-mode-tests) +;;; java-ts-mode-tests.el ends here diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..146ee76574e --- /dev/null +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -0,0 +1,73 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq typescript-ts-mode-indent-offset 2) + (typescript-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic indentation + +=-= +const foo = () => { + console.log("bar"); + if (x) { + return y; + } else if (y) { + return u; + } + return baz.x() + ? true + : false; +} +=-=-= + +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq tsx-ts-mode-indent-offset 2) + (tsx-ts-mode) + (indent-region (point-min) (point-max))) + +Name: JSX indentation + +=-= +const foo = (props) => { + return ( +
+
+
+
+ { + props.foo + ? Hello, foo! + : Hello, World!; + } +
+
+
+
+ ); +} +=-=-= + +Name: JSX indentation with attributes + +=-= +const foo = (props) => { + return ( +
{ + alert('???'); + return () => { + return 5+5; + }; + }} + > +

Some text

+
+ ); +} +=-=-= diff --git a/test/lisp/progmodes/typescript-ts-mode-tests.el b/test/lisp/progmodes/typescript-ts-mode-tests.el new file mode 100644 index 00000000000..126f5e3298f --- /dev/null +++ b/test/lisp/progmodes/typescript-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; typescript-ts-mode-tests.el --- Tests for Tree-sitter-based TypeScript mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 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 'treesit) + +(ert-deftest typescript-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'typescript)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'typescript-ts-mode-tests) +;;; typescript-ts-mode-tests.el ends here commit 81b63ec032fefcc2c98149d31b667b61691e700d Author: Dmitry Gutov Date: Tue Nov 21 16:08:09 2023 +0200 Annotate java-ts-mode-test-movement with expected result Do not merge to master. diff --git a/test/lisp/progmodes/java-ts-mode-tests.el b/test/lisp/progmodes/java-ts-mode-tests.el index 4fd8fc3019f..03c13b9700d 100644 --- a/test/lisp/progmodes/java-ts-mode-tests.el +++ b/test/lisp/progmodes/java-ts-mode-tests.el @@ -28,6 +28,8 @@ java-ts-mode-test-indentation (ert-test-erts-file (ert-resource-file "indent.erts"))) (ert-deftest java-ts-mode-test-movement () + :expected-result :failed ;in emacs-29 no sexp + ;navigation (skip-unless (treesit-ready-p 'java)) (ert-test-erts-file (ert-resource-file "movement.erts"))) commit 054202d48c31e718b48a2b601c0e6bd2fdbce1ef Author: Theodor Thornhill Date: Mon Feb 6 09:36:08 2023 +0100 Backport: Add more java indentation tests * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Use default indent offset, and tweak the indentation examples. (cherry picked from commit dbe7803aa1e8249bd70f67f25f19aedabeb9cc22) diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index c8e0ac71708..4fca74dd2e1 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -1,7 +1,7 @@ Code: (lambda () (setq indent-tabs-mode nil) - (setq java-ts-mode-indent-offset 2) + (setq java-ts-mode-indent-offset 4) (java-ts-mode) (indent-region (point-min) (point-max))) @@ -11,9 +11,9 @@ Name: Basic =-= public class Basic { - public void basic() { - return; - } + public void basic() { + return; + } } =-=-= @@ -21,9 +21,9 @@ Name: Empty Line =-= public class EmptyLine { - public void emptyLine() { - | - } + public void emptyLine() { + | + } } =-=-= @@ -31,15 +31,15 @@ Name: Statements =-= if (x) { - for (var foo : foos) { - | - } + for (var foo : foos) { + | + } } else if (y) { - for (int i = 0; x < foos.size(); i++) { - return; - } + for (int i = 0; x < foos.size(); i++) { + return; + } } else { - return; + return; } =-=-= @@ -47,7 +47,66 @@ Name: Field declaration without access modifier (bug#61115) =-= public class T { - @Autowired - String a; + @Autowired + String a; +} +=-=-= + +Name: Array initializer + +=-= +public class Java { + void foo() { + return new String[]{ + "foo", // These + "bar" + } + } +} +=-=-= + +Name: Advanced bracket matching indentation (bug#61142) + +=-= +public class Java { + + public Java( + String foo) { + this.foo = foo; + } + + void foo( + String foo) { + + for (var f : rs) + return new String[]{ + "foo", + "bar" + }; + if (a == 0 + && b == 1 + && foo) { + return 0; + } else if (a == 1) { + return 1; + } else if (true) + return 5; + else { + if (a == 0 + && b == 1 + && foo) + while (true) + for ( + ;;) + if (true) + return 5; + else if (false) { + return 6; + } else + if (true + && false) + return 6; + } + } } =-=-= commit d2776d8254fa4afc64a8828da7d30886c2d35ac2 Author: Theodor Thornhill Date: Fri Feb 3 09:09:49 2023 +0100 Backport: Add test for java indentation (bug#61115) * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Add new test case. (cherry picked from commit 229d0772e235f51812ed8020a31f9a8de366c7ba) diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index e59d5fed8e8..c8e0ac71708 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -42,3 +42,12 @@ if (x) { return; } =-=-= + +Name: Field declaration without access modifier (bug#61115) + +=-= +public class T { + @Autowired + String a; +} +=-=-= commit d72a4ed65ce23581ff8b3bf4340caecf31c18f43 Author: Eli Zaretskii Date: Tue Nov 21 15:36:22 2023 +0200 Fix 'with-sqlite-transaction' when BODY fails * lisp/sqlite.el (with-sqlite-transaction): Don't commit changes if BODY errors out. Roll back the transaction if committing fails. (Bug#67142) * etc/NEWS: * doc/lispref/text.texi (Database): Document the error handling in 'with-sqlite-transaction'. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 4f11caaf64e..8fa2100ba11 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5486,7 +5486,11 @@ Database @defmac with-sqlite-transaction db body@dots{} Like @code{progn} (@pxref{Sequencing}), but executes @var{body} with a -transaction held, and commits the transaction at the end. +transaction held, and commits the transaction at the end if @var{body} +completes normally. If @var{body} signals an error, or committing the +transaction fails, the changes in @var{db} performed by @var{body} are +rolled back. The macro returns the value of @var{body} if it +completes normally and commit succeeds. @end defmac @defun sqlite-pragma db pragma diff --git a/etc/NEWS b/etc/NEWS index 1b3532b5657..333699f1015 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -62,6 +62,11 @@ of showing the shortcuts. * Incompatible Lisp Changes in Emacs 29.2 ++++ +** 'with-sqlite-transaction' rolls back changes if its BODY fails. +If the BODY of the macro signals an error, or committing the results +of the transaction fails, the changes will now be rolled back. + * Lisp Changes in Emacs 29.2 diff --git a/lisp/sqlite.el b/lisp/sqlite.el index aad0aa40fa4..8a525739c9a 100644 --- a/lisp/sqlite.el +++ b/lisp/sqlite.el @@ -24,19 +24,28 @@ ;;; Code: (defmacro with-sqlite-transaction (db &rest body) - "Execute BODY while holding a transaction for DB." + "Execute BODY while holding a transaction for DB. +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." (declare (indent 1) (debug (form body))) (let ((db-var (gensym)) - (func-var (gensym))) + (func-var (gensym)) + (res-var (gensym)) + (commit-var (gensym))) `(let ((,db-var ,db) - (,func-var (lambda () ,@body))) + (,func-var (lambda () ,@body)) + ,res-var ,commit-var) (if (sqlite-available-p) (unwind-protect (progn (sqlite-transaction ,db-var) - (funcall ,func-var)) - (sqlite-commit ,db-var)) - (funcall ,func-var))))) + (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)))) (provide 'sqlite) commit a7b3c92373373f956234349fe6b792e1396e293e Author: Eli Zaretskii Date: Tue Nov 21 14:40:27 2023 +0200 ; * doc/emacs/cmdargs.texi (Initial Options): Fix last change. diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 49ae1288f73..38e683bd7f5 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -280,10 +280,7 @@ Initial Options @opindex --script @cindex script mode Run Emacs in batch mode, like @samp{--batch}, and then read and -execute the Lisp code in @var{file}. Note that when Emacs reads the -Lisp code in this case, it ignores any file-local variables -(@pxref{Specifying File Variables}), both in the first line and in a -local-variables section near the end of the file. +execute the Lisp code in @var{file}. The normal use of this option is in executable script files that run Emacs. They can start with this text on the first line @@ -312,8 +309,9 @@ Initial Options reaches the end of the script, it exits Emacs and uses the value of the final form as the exit value from the script (if the final value is numerical). Otherwise, it will always exit with a zero value. -Note that, like with @samp{--script}, Emacs ignores file-local -variables in the script. +Note that when Emacs reads the Lisp code in this case, it ignores any +file-local variables (@pxref{Specifying File Variables}), both in the +first line and in a local-variables section near the end of the file. @item --no-build-details @opindex --no-build-details commit fd76a80864d79bcf719e3e9efa7899d4217371d8 Author: Eli Zaretskii Date: Tue Nov 21 14:23:38 2023 +0200 ; Mention that -x and --script ignore file-locals * doc/emacs/cmdargs.texi (Initial Options): Document that --script and -x ignore file-local variables. (Bug#67321) diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 9514e3414e1..49ae1288f73 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -280,7 +280,10 @@ Initial Options @opindex --script @cindex script mode Run Emacs in batch mode, like @samp{--batch}, and then read and -execute the Lisp code in @var{file}. +execute the Lisp code in @var{file}. Note that when Emacs reads the +Lisp code in this case, it ignores any file-local variables +(@pxref{Specifying File Variables}), both in the first line and in a +local-variables section near the end of the file. The normal use of this option is in executable script files that run Emacs. They can start with this text on the first line @@ -309,6 +312,8 @@ Initial Options reaches the end of the script, it exits Emacs and uses the value of the final form as the exit value from the script (if the final value is numerical). Otherwise, it will always exit with a zero value. +Note that, like with @samp{--script}, Emacs ignores file-local +variables in the script. @item --no-build-details @opindex --no-build-details commit 3328c327254b5846782990f6171175bea216eba9 Author: Andrea Corallo Date: Tue Nov 21 11:14:15 2023 +0100 * Enable native compiler by default when libgccjit is available * configure.ac: Enable native compiler by default when libgccjit available. (with_native_compilation): Change default to 'default'. (libgccjit_not_found_err, libgccjit_dev_not_found_err) (libgccjit_broken_err): Renamed. (libgccjit_not_found, libgccjit_dev_not_found, libgccjit_broken): New functions. diff --git a/configure.ac b/configure.ac index 4456cd89b7a..8768d69bbbb 100644 --- a/configure.ac +++ b/configure.ac @@ -1693,7 +1693,7 @@ AC_DEFUN *) AC_MSG_ERROR([bad value $withval for native-compilation option]) ;; esac with_native_compilation=$withval], - [with_native_compilation=no] + [with_native_compilation=default] ) AC_SUBST([NATIVE_COMPILATION_AOT]) @@ -5077,20 +5077,20 @@ AC_DEFUN return 0; }]])]) -AC_DEFUN([libgccjit_not_found], [ +AC_DEFUN([libgccjit_not_found_err], [ AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit was not found. Please try installing libgccjit or a similar package. If you are sure you want Emacs be compiled without ELisp native compiler, pass the --without-native-compilation option to configure.])]) -AC_DEFUN([libgccjit_dev_not_found], [ +AC_DEFUN([libgccjit_dev_not_found_err], [ AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit header files were not found. Please try installing libgccjit-dev or a similar package. If you are sure you want Emacs be compiled without ELisp native compiler, pass the --without-native-compilation option to configure.])]) -AC_DEFUN([libgccjit_broken], [ +AC_DEFUN([libgccjit_broken_err], [ AC_MSG_ERROR([The installed libgccjit failed to compile and run a test program using the libgccjit library; see config.log for the details of the failure. The test program can be found here: @@ -5115,6 +5115,50 @@ AC_DEFUN fi fi +AC_DEFUN([libgccjit_not_found], [ + AC_MSG_WARN([Elisp native compiler can't be enabled as libgccjit was not +found. +Please try installing libgccjit or a similar package if you want to have it +enabled.]) + + with_native_compilation=no +]) + +AC_DEFUN([libgccjit_dev_not_found], [ + AC_MSG_WARN([Elisp native compiler can't be enabled as libgccjit header files +were not found. +Please try installing libgccjit-dev or a similar package if you want to have it +enabled.]) + + with_native_compilation=no +]) + +AC_DEFUN([libgccjit_broken], [ + AC_MSG_WARN([Elisp native compiler can't be enabled as the installed libgccjit +failed to compile and run a test program using the libgccjit library; see +config.log for the details of the failure. +The test program can be found here: +. +You can try compiling it yourself to investigate the issues. +Please report the issue to your distribution if libgccjit was installed +through that. +You can find the instructions on how to compile and install libgccjit from +source on this site: +.]) + + with_native_compilation=no]) + +if test "${with_native_compilation}" == "default"; then + # Check if libgccjit is available. + AC_CHECK_LIB([gccjit], [gcc_jit_context_acquire], + [], [libgccjit_not_found]) + AC_CHECK_HEADERS([libgccjit.h], [], [libgccjit_dev_not_found]) + if test "${with_native_compilation}" != "no"; then + # Check if libgccjit really works. + AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken]) + fi +fi + if test "${with_native_compilation}" != "no"; then if test "$with_unexec" = yes; then AC_MSG_ERROR(['--with-native-compilation' is not compatible with unexec]) @@ -5162,12 +5206,15 @@ AC_DEFUN fi fi - # Check if libgccjit is available. - AC_CHECK_LIB([gccjit], [gcc_jit_context_acquire], - [], [libgccjit_not_found]) - AC_CHECK_HEADERS([libgccjit.h], [], [libgccjit_dev_not_found]) - # Check if libgccjit really works. - AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken]) + # In the default case we already checked + if test "${with_native_compilation}" != "default"; then + # Check if libgccjit is available. + AC_CHECK_LIB([gccjit], [gcc_jit_context_acquire], + [], [libgccjit_not_found_err]) + AC_CHECK_HEADERS([libgccjit.h], [], [libgccjit_dev_not_found_err]) + # Check if libgccjit really works. + AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken_err]) + fi HAVE_NATIVE_COMP=yes case "${opsys}" in # mingw32 loads the library dynamically. commit 3027695ea8905621a4c0d0a2ba15b28f64937a41 Author: Po Lu Date: Tue Nov 21 14:18:04 2023 +0800 Save more information into Android font names * src/sfntfont.c (sfntfont_open): Besides just the font file name, also store the interpreter state, UPEM, charset and instance number in FONT_FULLNAME_INDEX. diff --git a/src/sfntfont.c b/src/sfntfont.c index 39b250ac11e..68e850779fc 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -3392,12 +3392,22 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, (Vvertical_centering_font_regexp, font->props[FONT_NAME_INDEX]) >= 0)); - /* And set a reasonable full name, namely the name of the font - file. */ - font->props[FONT_FULLNAME_INDEX] - = font->props[FONT_FILE_INDEX] + /* Set the name of the font file. */ + font->props[FONT_FILE_INDEX] = DECODE_FILE (build_unibyte_string (desc->path)); + /* Encapsulate some information on the font useful while debugging + (along with being informative in general) in the font name. */ + + AUTO_STRING (format, "%s %s interpreted: %s upem: %s charset: %s" + " instance: %s"); + font->props[FONT_FULLNAME_INDEX] + = CALLN (Fformat, format, desc->family, desc->style, + font_info->interpreter ? Qt : Qnil, + make_fixnum (font_info->head->units_per_em), + CHARSET_NAME (charset), + make_fixnum (instance)); + /* All done. */ unblock_input (); return font_object; commit e0469ddb9d4eb928cb23eb436cd670903f92e20a Author: Eli Zaretskii Date: Mon Nov 20 21:38:55 2023 +0200 ; * doc/emacs/search.texi (Special Isearch): More accurate text. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 66a55f09220..9d186edbe70 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -407,8 +407,11 @@ Special Isearch @cindex invisible text, searching for @kindex M-s i @r{(Incremental search)} @findex isearch-toggle-invisible - To toggle whether or not invisible text is searched, type -@kbd{M-s i} (@code{isearch-toggle-invisible}). @xref{Outline Search}. + To toggle whether or not the search will find text made invisible by +overlays, type @kbd{M-s i} (@code{isearch-toggle-invisible}). +@xref{Outline Search}. To make all incremental searches find matches +inside invisible text, whether due to text properties or overlay +properties, customize @code{search-invisible} to the value @code{t}. @kindex M-r @r{(Incremental Search)} @kindex M-s r @r{(Incremental Search)} commit 65600b97bd9890ac4884836bf02a394f89fc856f Author: Manuel Giraud Date: Tue Nov 14 14:49:37 2023 +0100 Add Gnus mode line logo in SVG format Bug#67174 * etc/images/gnus/gnus-pointer.svg: New Gnus mode line logo in SVG format. * lisp/gnus/gnus.el (gnus-mode-line-buffer-identification): Use it. diff --git a/etc/images/gnus/gnus-pointer.svg b/etc/images/gnus/gnus-pointer.svg new file mode 100644 index 00000000000..67a631cdcf5 --- /dev/null +++ b/etc/images/gnus/gnus-pointer.svg @@ -0,0 +1,94 @@ + + + + + + + + + + image/svg+xml + + + gnus + 2008/06/28 + + + Francesc Rocher + + + + + GPL + + + gnus icon image + + + + + + + + diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index fc8518512ee..ffe81e5c585 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -325,8 +325,10 @@ gnus-mode-line-buffer-identification 0 5 (list 'display (find-image - '((:type xpm :file "gnus-pointer.xpm" - :ascent center) + '((: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) commit 9d292262f55cd016a1a59f4d4ef31446bb2ba9c6 Author: Juri Linkov Date: Mon Nov 20 19:57:57 2023 +0200 Improve invisibility handling in isearch-lazy-highlight (bug#40808) * lisp/isearch.el (isearch-lazy-highlight-invisible): New variable. (isearch-lazy-highlight-new-loop, isearch-lazy-highlight-search) (isearch-lazy-highlight-match, isearch-lazy-highlight-buffer-update): Use it. * lisp/replace.el (replace-highlight): Let-bind isearch-invisible to search-invisible. * test/lisp/isearch-tests.el (isearch--test-invisible): New test. diff --git a/lisp/isearch.el b/lisp/isearch.el index 4d231fba469..4672440bdff 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -4054,6 +4054,7 @@ isearch-lazy-highlight-point-min (defvar isearch-lazy-highlight-point-max nil) (defvar isearch-lazy-highlight-buffer nil) (defvar isearch-lazy-highlight-case-fold-search nil) +(defvar isearch-lazy-highlight-invisible nil) (defvar isearch-lazy-highlight-regexp nil) (defvar isearch-lazy-highlight-lax-whitespace nil) (defvar isearch-lazy-highlight-regexp-lax-whitespace nil) @@ -4099,6 +4100,8 @@ isearch-lazy-highlight-new-loop isearch-lazy-highlight-window-group)) (not (eq isearch-lazy-highlight-case-fold-search isearch-case-fold-search)) + (not (eq isearch-lazy-highlight-invisible + isearch-invisible)) (not (eq isearch-lazy-highlight-regexp isearch-regexp)) (not (eq isearch-lazy-highlight-regexp-function @@ -4177,6 +4180,7 @@ isearch-lazy-highlight-new-loop isearch-lazy-highlight-wrapped nil isearch-lazy-highlight-last-string isearch-string isearch-lazy-highlight-case-fold-search isearch-case-fold-search + isearch-lazy-highlight-invisible isearch-invisible isearch-lazy-highlight-regexp isearch-regexp isearch-lazy-highlight-lax-whitespace isearch-lax-whitespace isearch-lazy-highlight-regexp-lax-whitespace isearch-regexp-lax-whitespace @@ -4226,8 +4230,10 @@ isearch-lazy-highlight-search (isearch-forward isearch-lazy-highlight-forward) ;; Count all invisible matches, but highlight only ;; matches that can be opened by visiting them later - (search-invisible (or (not (null isearch-lazy-count)) - 'can-be-opened)) + (search-invisible + (or (not (null isearch-lazy-count)) + (and (eq isearch-lazy-highlight-invisible 'open) + 'can-be-opened))) (retry t) (success nil)) ;; Use a loop like in `isearch-search'. @@ -4247,7 +4253,9 @@ isearch-lazy-highlight-match (when (or (not isearch-lazy-count) ;; Recheck the match that possibly was intended ;; for counting only, but not for highlighting - (let ((search-invisible 'can-be-opened)) + (let ((search-invisible + (and (eq isearch-lazy-highlight-invisible 'open) + 'can-be-opened))) (funcall isearch-filter-predicate mb me))) (let ((ov (make-overlay mb me))) (push ov isearch-lazy-highlight-overlays) @@ -4396,9 +4404,9 @@ isearch-lazy-highlight-buffer-update ;; value `open' since then lazy-highlight ;; will open all overlays with matches. (if (not (let ((search-invisible - (if (eq search-invisible 'open) + (if (eq isearch-lazy-highlight-invisible 'open) 'can-be-opened - search-invisible))) + isearch-lazy-highlight-invisible))) (funcall isearch-filter-predicate mb me))) (setq isearch-lazy-count-invisible (1+ (or isearch-lazy-count-invisible 0))) diff --git a/lisp/replace.el b/lisp/replace.el index ac677db2feb..ff7ca1145b8 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2755,6 +2755,7 @@ replace-highlight (isearch-regexp-lax-whitespace replace-regexp-lax-whitespace) (isearch-case-fold-search case-fold) + (isearch-invisible search-invisible) (isearch-forward (not backward)) (isearch-other-end match-beg) (isearch-error nil) diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el index e71f0a5785f..693f15336f2 100644 --- a/test/lisp/isearch-tests.el +++ b/test/lisp/isearch-tests.el @@ -38,6 +38,157 @@ isearch--test-done ;; Bug #21091: let `isearch-done' work without `isearch-update'. (isearch-done)) + +;; Search invisible. + +(declare-function outline-hide-sublevels "outline") + +(ert-deftest isearch--test-invisible () + (require 'outline) + (with-temp-buffer + (set-window-buffer nil (current-buffer)) + (insert "\n1\n" + (propertize "2" 'invisible t) + (propertize "3" 'inhibit-isearch t) + "\n* h\n4\n\n") + (outline-mode) + (outline-hide-sublevels 1) + (goto-char (point-min)) + + (let ((isearch-lazy-count nil) + (search-invisible t) + (inhibit-message t)) + + (isearch-forward-regexp nil 1) + (isearch-process-search-string "[0-9]" "[0-9]") + (should (eq (point) 3)) + + (isearch-lazy-highlight-start) + (should (equal (seq-uniq (mapcar #'overlay-start isearch-lazy-highlight-overlays)) + '(2))) + + (isearch-repeat-forward) + (should (eq (point) 5)) + (should (get-char-property 4 'invisible)) + (isearch-repeat-forward) + (should (eq (point) 12)) + (should (get-char-property 11 'invisible)) + + (goto-char isearch-opoint) + (isearch-done t) + + (isearch-forward-regexp nil 1) + (setq isearch-invisible nil) ;; isearch-toggle-invisible + (isearch-process-search-string "[0-9]" "[0-9]") + + (isearch-lazy-highlight-start) + (should (equal (seq-uniq (mapcar #'overlay-start isearch-lazy-highlight-overlays)) + '(2))) + + (goto-char isearch-opoint) + (isearch-done t) + + (isearch-forward-regexp nil 1) + (setq isearch-invisible 'open) ;; isearch-toggle-invisible + (isearch-process-search-string "[0-9]" "[0-9]") + (should (eq (point) 3)) + + (isearch-lazy-highlight-start) + (should (equal (seq-uniq (mapcar #'overlay-start isearch-lazy-highlight-overlays)) + '(2 11))) + + (let ((isearch-hide-immediately t)) + (isearch-repeat-forward) + (should (eq (point) 12)) + (should-not (get-char-property 11 'invisible)) + (isearch-delete-char) + (should (get-char-property 11 'invisible))) + + (let ((isearch-hide-immediately nil)) + (isearch-repeat-forward) + (should (eq (point) 12)) + (should-not (get-char-property 11 'invisible)) + (isearch-delete-char) + (should-not (get-char-property 11 'invisible))) + + (goto-char isearch-opoint) + (isearch-done t) + (isearch-clean-overlays) + (should (get-char-property 11 'invisible))) + + (let ((isearch-lazy-count t) + (search-invisible t) + (inhibit-message t)) + + (isearch-forward-regexp nil 1) + (isearch-process-search-string "[0-9]" "[0-9]") + (should (eq (point) 3)) + + (setq isearch-lazy-count-invisible nil isearch-lazy-count-total nil) + (isearch-lazy-highlight-start) + (isearch-lazy-highlight-buffer-update) + (should (eq isearch-lazy-count-invisible nil)) + (should (eq isearch-lazy-count-total 3)) + (should (equal (seq-uniq (mapcar #'overlay-start isearch-lazy-highlight-overlays)) + '(2))) + + (isearch-repeat-forward) + (should (eq (point) 5)) + (should (get-char-property 4 'invisible)) + (isearch-repeat-forward) + (should (eq (point) 12)) + (should (get-char-property 11 'invisible)) + + (goto-char isearch-opoint) + (isearch-done t) + + (isearch-forward-regexp nil 1) + (setq isearch-invisible nil) ;; isearch-toggle-invisible + (isearch-process-search-string "[0-9]" "[0-9]") + + (setq isearch-lazy-count-invisible nil isearch-lazy-count-total nil) + (isearch-lazy-highlight-start) + (isearch-lazy-highlight-buffer-update) + (should (eq isearch-lazy-count-invisible 2)) + (should (eq isearch-lazy-count-total 1)) + (should (equal (seq-uniq (mapcar #'overlay-start isearch-lazy-highlight-overlays)) + '(2))) + + (goto-char isearch-opoint) + (isearch-done t) + + (isearch-forward-regexp nil 1) + (setq isearch-invisible 'open) ;; isearch-toggle-invisible + (isearch-process-search-string "[0-9]" "[0-9]") + (should (eq (point) 3)) + + (setq isearch-lazy-count-invisible nil isearch-lazy-count-total nil) + (isearch-lazy-highlight-start) + (isearch-lazy-highlight-buffer-update) + (should (eq isearch-lazy-count-invisible 1)) + (should (eq isearch-lazy-count-total 2)) + (should (equal (seq-uniq (mapcar #'overlay-start isearch-lazy-highlight-overlays)) + '(2 11))) + + (let ((isearch-hide-immediately t)) + (isearch-repeat-forward) + (should (eq (point) 12)) + (should-not (get-char-property 11 'invisible)) + (isearch-delete-char) + (should (get-char-property 11 'invisible))) + + (let ((isearch-hide-immediately nil)) + (isearch-repeat-forward) + (should (eq (point) 12)) + (should-not (get-char-property 11 'invisible)) + (isearch-delete-char) + (should-not (get-char-property 11 'invisible))) + + (goto-char isearch-opoint) + (isearch-done t) + (isearch-clean-overlays) + (should (get-char-property 11 'invisible))))) + ;; Search functions. commit 5024ee1ad18904bc0a0e7a8f740164157649af5e Author: Eli Zaretskii Date: Mon Nov 20 14:45:30 2023 +0200 ; * etc/TODO: Fix punctuation. diff --git a/etc/TODO b/etc/TODO index 6b29c0a61ad..d2d124c9c8e 100644 --- a/etc/TODO +++ b/etc/TODO @@ -889,7 +889,7 @@ We could have a mechanism similar to what we use for optimizing calls to primitive functions. IE using a link table for each compilation unit (CU) such that calls from functions in a CU targeting functions in the same CU don't have to go through funcall. If one of these -functions is redefined a trampoline is compiled and installed to +functions is redefined, a trampoline is compiled and installed to restore the redirection through funcall. *** Features to be improved or missing commit 498daa8886c68973e0a35aaeb8282a918e51b5cd Author: Andrea Corallo Date: Mon Nov 20 10:37:04 2023 +0100 * etc/TODO (Native compiler improvements): Add 'Diagnostic' section. diff --git a/etc/TODO b/etc/TODO index a2c1638e0bd..6b29c0a61ad 100644 --- a/etc/TODO +++ b/etc/TODO @@ -894,6 +894,22 @@ restore the redirection through funcall. *** Features to be improved or missing +**** Diagnostic + +***** Filtering async warnings + +Add a new 'native-comp-async-report-warnings-errors' value such that +we filter out all the uninteresting warnings (that the programmer +already got during byte compilation) but we still report the important +ones ('the function ‘xxx’ is not known to be defined.'). + +This way even if the package developer doesn't use native compilation +it can get the bug report for the issue and +'*Async-native-compile-log*' is not too crowded. + +This new value for 'native-comp-async-report-warnings-errors' should +be default. + **** Fix portable dumping so that you can redump without using -batch ***** Redumps and native compiler "preloaded" sub-folder. commit c598a808be746e4527bf5a7ba6a9a89924609637 Author: Andrea Corallo Date: Mon Nov 20 10:19:38 2023 +0100 * etc/TODO (Native compiler improvements): Move old entry here. diff --git a/etc/TODO b/etc/TODO index 58af22405ff..a2c1638e0bd 100644 --- a/etc/TODO +++ b/etc/TODO @@ -463,15 +463,6 @@ One way of doing this is to start with fx's dynamic loading, and use it to implement things like auto-loaded buffer parsers and database access in cases which need more than Lisp. -** Fix portable dumping so that you can redump without using -batch - -*** Redumps and native compiler "preloaded" sub-folder. -In order to depose new .eln files being compiled into the "preloaded" -sub-folder the native compiler needs to know in advance if this file -will be preloaded or not. As .eln files are not moved afterwards -subsequent redumps might refer to .eln file out of the "preloaded" -sub-folder. - ** Imenu could be extended into a file-structure browsing mechanism This could use code like that of customize-groups. @@ -901,6 +892,17 @@ in the same CU don't have to go through funcall. If one of these functions is redefined a trampoline is compiled and installed to restore the redirection through funcall. +*** Features to be improved or missing + +**** Fix portable dumping so that you can redump without using -batch + +***** Redumps and native compiler "preloaded" sub-folder. +In order to depose new .eln files being compiled into the "preloaded" +sub-folder the native compiler needs to know in advance if this file +will be preloaded or not. As .eln files are not moved afterwards +subsequent redumps might refer to .eln file out of the "preloaded" +sub-folder. + ** NeXTstep port *** Missing features commit 94b3c7b9d28f0bf7808919fd316494e2d048acf3 Author: Andrea Corallo Date: Mon Nov 20 10:09:31 2023 +0100 * etc/TODO (Native compiler improvements): Add section. diff --git a/etc/TODO b/etc/TODO index 2292f100ac4..58af22405ff 100644 --- a/etc/TODO +++ b/etc/TODO @@ -888,6 +888,19 @@ It would make it easy to add (and remove) mappings like * Things to be done for specific packages or features +** Native compiler improvements + +*** Performance + +**** Intra compilation unit call optimization + +We could have a mechanism similar to what we use for optimizing calls +to primitive functions. IE using a link table for each compilation +unit (CU) such that calls from functions in a CU targeting functions +in the same CU don't have to go through funcall. If one of these +functions is redefined a trampoline is compiled and installed to +restore the redirection through funcall. + ** NeXTstep port *** Missing features commit ea7a52dbaed378b51cb0bab33afb34cc3a7c3e7e Author: Andrea Corallo Date: Mon Nov 20 09:45:33 2023 +0100 * Add 'eval' to 'native-comp-never-optimize-functions' (bug#67141) * lisp/emacs-lisp/comp-common.el (native-comp-never-optimize-functions): Add 'eval'. diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 6318f2a22e5..1bdb7280399 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -49,7 +49,8 @@ native-comp-verbose :version "28.1") (defcustom native-comp-never-optimize-functions - '(;; The following two are mandatory for Emacs to be working + '(eval + ;; The following two are mandatory for Emacs to be working ;; correctly (see comment in `advice--add-function'). DO NOT ;; REMOVE. macroexpand rename-buffer) commit 16ac377aab257d635918dd0188dcdf630e75757c Author: Jim Porter Date: Sat Nov 11 13:26:44 2023 -0800 Forward completion text properties in 'completion-table-with-quoting' This fixes an issue with 'pcomplete-here-using-help', which passes annotation strings along as text properties. Previously, those got clobbered when the completions got requoted (bug#67112). * lisp/minibuffer.el (completion--twq-all): Apply text properties from the first character of the unquoted completion to the quoted completion. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7af7a359674..5c12d9fc914 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -677,6 +677,13 @@ completion--twq-all 'completions-common-part) qprefix)))) (qcompletion (concat qprefix qnew))) + ;; Some completion tables (including this one) pass + ;; along necessary information as text properties + ;; on the first character of the completion. Make + ;; sure the quoted completion has these properties + ;; too. + (add-text-properties 0 1 (text-properties-at 0 completion) + qcompletion) ;; Attach unquoted completion string, which is needed ;; to score the completion in `completion--flex-score'. (put-text-property 0 1 'completion--unquoted commit 1c8b6a00cff15d568c93160c701f9147511830bd Author: Eli Zaretskii Date: Sun Nov 19 19:31:46 2023 +0200 ; * doc/emacs/emacs.texi: Add a missing menu to @detailmenu. diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index d2b54c779c6..e1c55c0719e 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -258,6 +258,10 @@ Top * Mode Line:: Interpreting the mode line. * Menu Bar:: How to use the menu bar. +Touchscreen Input and Virtual Keyboards +* Touchscreens:: Interacting with Emacs from touchscreens. +* On-Screen Keyboards:: Text input with virtual keyboards. + Basic Editing Commands * Inserting Text:: Inserting text by simply typing it. commit e521669fb3f5fea6f7b9ee88cbcbcf2750c00f9d Author: Richard M. Stallman Date: Sun Nov 19 12:14:36 2023 +0200 Fix wording in ELisp Intro manual * doc/lispintro/emacs-lisp-intro.texi (Lisp macro): Improve wording in description of 'unless'. (Bug#67185) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index c5b33ac5eaa..e4a0f585f69 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -8165,9 +8165,9 @@ Lisp macro text that exists. A @code{when} expression is simply a programmers' convenience. It is -an @code{if} without the possibility of an else clause. In your mind, -you can replace @code{when} with @code{if} and understand what goes -on. That is what the Lisp interpreter does. +like an @code{if} without the possibility of an else clause. In your +mind, you can replace @code{when} with @code{if} and understand what +goes on. That is what the Lisp interpreter does. Technically speaking, @code{when} is a Lisp macro. A Lisp macro enables you to define new control constructs and other language @@ -8176,8 +8176,9 @@ Lisp macro other expression is an @code{if} expression. The @code{kill-region} function definition also has an @code{unless} -macro; it is the converse of @code{when}. The @code{unless} macro is -an @code{if} without a then clause +macro; it is the opposite of @code{when}. The @code{unless} macro is +like an @code{if} except that it has no then-clause, and it supplies +an implicit @code{nil} for that. For more about Lisp macros, see @ref{Macros, , Macros, elisp, The GNU Emacs Lisp Reference Manual}. The C programming language also commit e32c57ed4d36c5c0302eeb409f96ce9155b545ea Author: Eli Zaretskii Date: Sun Nov 19 11:37:45 2023 +0200 ; Fix make-obsolete warnings in treesit.el * lisp/treesit.el (treesit-text-type-regexp) (treesit-sentence-type-regexp, treesit--things-around) (treesit-sexp-type-regexp): Fix obsolescence warnings. diff --git a/lisp/treesit.el b/lisp/treesit.el index 5ee00637ca6..da8226f7d8a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2034,7 +2034,8 @@ treesit-search-forward-goto (goto-char current-pos))) node)) -(make-obsolete 'treesit-sexp-type-regexp "`treesit-sexp-type-regexp' will be removed in a few months, use `treesit-thing-settings' instead." "30.0.5") +(make-obsolete 'treesit-sexp-type-regexp + "`treesit-sexp-type-regexp' will be removed soon, use `treesit-thing-settings' instead." "30.1") (defvar-local treesit-sexp-type-regexp nil "A regexp that matches the node type of sexp nodes. @@ -2304,7 +2305,8 @@ treesit-end-of-defun (throw 'done nil) (setq arg (if (> arg 0) (1+ arg) (1- arg)))))))) -(make-obsolete 'treesit-text-type-regexp "`treesit-text-type-regexp' will be removed in a few months, use `treesit-thing-settings' instead." "30.0.5") +(make-obsolete 'treesit-text-type-regexp + "`treesit-text-type-regexp' will be removed soon, use `treesit-thing-settings' instead." "30.1") (defvar-local treesit-text-type-regexp "\\`comment\\'" "A regexp that matches the node type of textual nodes. @@ -2315,7 +2317,8 @@ treesit-text-type-regexp \"text_block\" in the case of a string. This is used by `prog-fill-reindent-defun' and friends.") -(make-obsolete 'treesit-sentence-type-regexp "`treesit-sentence-type-regexp' will be removed in a few months, use `treesit-thing-settings' instead." "30.0.5") +(make-obsolete 'treesit-sentence-type-regexp + "`treesit-sentence-type-regexp' will be removed soon, use `treesit-thing-settings' instead." "30.1") (defvar-local treesit-sentence-type-regexp nil "A regexp that matches the node type of sentence nodes. @@ -2359,7 +2362,8 @@ treesit-default-defun-skipper (line-beginning-position)) (beginning-of-line)))) -(make-obsolete 'treesit--things-around "`treesit--things-around' will be removed in a few months, use `treesit--thing-prev', `treesit--thing-next', `treesit--thing-at' instead." "30.0.5") +(make-obsolete 'treesit--things-around + "`treesit--things-around' will be removed soon, use `treesit--thing-prev', `treesit--thing-next', `treesit--thing-at' instead." "30.1") (defun treesit--things-around (pos thing) "Return the previous, next, and parent thing around POS. commit 3a3202e4a60baafc2c99c692e7b8426e3f9d2d1b Author: Eli Zaretskii Date: Sun Nov 19 11:08:53 2023 +0200 ; * etc/NEWS: Fix last change. diff --git a/etc/NEWS b/etc/NEWS index b9ee3747040..e14d15a7487 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -234,10 +234,10 @@ It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. --- -*** Emacs now recognizes shebang lines that pass -S/--split-string to env. +*** Emacs now recognizes shebang lines that pass -S/--split-string to 'env'. When visiting a script that invokes 'env -S INTERPRETER ARGS...' in its shebang line, Emacs will now skip over 'env -S' and deduce the -major mode based on the interpreter. +major mode based on the interpreter after 'env -S'. ** Emacs Server and Client commit 53bd2d57f34af1efd88c6d189ab15e6f44866333 Author: Kévin Le Gouguec Date: Sun Nov 12 10:55:24 2023 +0100 Recognize shebang lines that pass '-S/--split-string' to 'env' * etc/NEWS: announce the change. * lisp/files.el (auto-mode-interpreter-regexp): Add optional '-S' switch to the ignored group capturing the env invocation. Allow multiple spaces between #!, interpreter and first argument: empirically, Linux's 'execve' accepts that. (Bug#66902) * test/lisp/files-tests.el (files-tests--check-shebang): New helper to generate a temporary file with a given interpreter line, and assert that the mode picked by 'set-auto-mode' is derived from an expected mode. Write the 'should' form so that failure reports include useful context; for example: (ert-test-failed ((should (equal (list shebang actual-mode) (list shebang expected-mode))) :form (equal ("#!/usr/bin/env -S make -f" fundamental-mode) ("#!/usr/bin/env -S make -f" makefile-mode)) :value nil :explanation (list-elt 1 (different-atoms fundamental-mode makefile-mode)))) * test/lisp/files-tests.el (files-tests-auto-mode-interpreter): New test; exercise some aspects of 'interpreter-mode-alist'. diff --git a/etc/NEWS b/etc/NEWS index 12ae8058cb1..b9ee3747040 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -233,6 +233,12 @@ to enter the file you want to modify. It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. +--- +*** Emacs now recognizes shebang lines that pass -S/--split-string to env. +When visiting a script that invokes 'env -S INTERPRETER ARGS...' in +its shebang line, Emacs will now skip over 'env -S' and deduce the +major mode based on the interpreter. + ** Emacs Server and Client --- diff --git a/lisp/files.el b/lisp/files.el index d729bdf8c25..1cdcec23b11 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3245,8 +3245,16 @@ inhibit-local-variables-p temp)) (defvar auto-mode-interpreter-regexp - (purecopy "#![ \t]?\\([^ \t\n]*\ -/bin/env[ \t]\\)?\\([^ \t\n]+\\)") + (purecopy + (concat + "#![ \t]*" + ;; Optional group 1: env(1) invocation. + "\\(" + "[^ \t\n]*/bin/env[ \t]*" + "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?" + "\\)?" + ;; Group 2: interpreter. + "\\([^ \t\n]+\\)")) "Regexp matching interpreters, for file mode determination. This regular expression is matched against the first line of a file to determine the file's mode in `set-auto-mode'. If it matches, the file diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 3492bd701b2..3e499fff468 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1656,6 +1656,31 @@ files-tests-file-name-base (should (equal (file-name-base "foo") "foo")) (should (equal (file-name-base "foo/bar") "bar"))) +(defun files-tests--check-shebang (shebang expected-mode) + "Assert that mode for SHEBANG derives from EXPECTED-MODE." + (let ((actual-mode + (ert-with-temp-file script-file + :text shebang + (find-file script-file) + (if (derived-mode-p expected-mode) + expected-mode + major-mode)))) + ;; Tuck all the information we need in the `should' form: input + ;; shebang, expected mode vs actual. + (should + (equal (list shebang actual-mode) + (list shebang expected-mode))))) + +(ert-deftest files-tests-auto-mode-interpreter () + "Test that `set-auto-mode' deduces correct modes from shebangs." + (files-tests--check-shebang "#!/bin/bash" 'sh-mode) + (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode) + (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) + (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) + (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) + (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) + (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode)) + (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" (find-file (ert-resource-file "whatever.quux")) commit 779e669bbccb87c9462ae06ad48c0b868ec6c22b Author: Po Lu Date: Sun Nov 19 12:46:21 2023 +0800 ; * doc/emacs/emacs.texi: Remove redundant menu. diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index f7d9033c5f4..d2b54c779c6 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -1274,11 +1274,6 @@ Top * Android Troubleshooting:: Dealing with problems. * Android Software:: Getting extra software. -Emacs and Unconventional Input Devices - -* Touchscreens:: Using Emacs on touchscreens. -* On-Screen Keyboards:: Using Emacs with virtual keyboards. - Emacs and Microsoft Windows/MS-DOS * Windows Startup:: How to start Emacs on Windows. commit 7751ef3a323a094c8abf129dcc49b52637127b70 Author: Po Lu Date: Sun Nov 19 11:38:02 2023 +0800 Properly avoid displaying the OSK for calls to read-key-sequence * lisp/touch-screen.el (touch-screen-handle-point-up): If prompt is set, throw the input event rather than execute its command. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 5a04425d343..1ce679cd41a 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1345,15 +1345,13 @@ touch-screen-handle-point-up (when command (if (memq command touch-screen-set-point-commands) (if touch-screen-translate-prompt - ;; When a `mouse-set-point' command is - ;; encountered and - ;; `touch-screen-handle-touch' is being - ;; called from the keyboard command loop, - ;; call it immediately so that point is set - ;; prior to the on screen keyboard being - ;; displayed. - (call-interactively command nil - (vector event)) + ;; Forgo displaying the virtual keyboard + ;; should touch-screen-translate-prompt be + ;; set, for then the key won't be delivered + ;; to the command loop, but rather to a + ;; caller of read-key-sequence such as + ;; describe-key. + (throw 'input-event event) (if (and (or (not buffer-read-only) touch-screen-display-keyboard) ;; Detect the splash screen and commit 2cb78a31ebbb2dbadf1565a216312f36ef8e8384 Author: Po Lu Date: Sun Nov 19 11:02:44 2023 +0800 ; Correct typo * doc/emacs/input.texi (Touchscreens): Use pxref where xref was inserted by mistake. diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index ae3dc05364e..788a321ce3e 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -97,7 +97,7 @@ Touchscreens @dfn{Pinching}, the placement of two tools apart on the screen followed by adjustments to their position such as to increase or decrease the distance between them will modify the text scale -(@xref{Text Scale}) in proportion to the change in that distance. +(@pxref{Text Scale}) in proportion to the change in that distance. @end itemize @vindex touch-screen-delay commit f2898e24fd125fce0db0ebdad26aa6355eee3ccf Author: Po Lu Date: Sun Nov 19 11:00:25 2023 +0800 Reorganize documentation relating to touch screens Chiefly, elevate it from an appendix to a node in the User Input chapter. I have been approached time and again with questions from people who have not searched the appendices for such documentation. * doc/emacs/emacs.texi: Move Other Input below Commands in the menu. * doc/emacs/input.texi (Other Input Devices): Rename to Other Input. All callers changed. (Touchscreens, On-Screen Keyboards): Revise and reword documentation. Homogenize nomenclature for on screen keyboards, preferring "virtual keyboards" after it has been mentioned once by the other name. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 161712493a6..915ba948b93 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -9,9 +9,9 @@ Android Alliance. This section describes the peculiarities of using Emacs on an Android device running Android 2.2 or later. - Android devices commonly rely on user input through a touch screen -or digitizer device and on-screen keyboard. For more information -about using such devices with Emacs, @pxref{Other Input Devices}. + Android devices commonly rely a touch screen or digitizer device and +virtual keyboard for user input. For more information about using +such devices with Emacs, @pxref{Other Input}. @menu * What is Android?:: Preamble. diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi index 98f0610ee44..cb924519175 100644 --- a/doc/emacs/commands.texi +++ b/doc/emacs/commands.texi @@ -227,6 +227,8 @@ Commands information on variables (@pxref{Variables}) and the information about specific variables will make sense. +@include input.texi + @ifnottex @lowersections @end ifnottex diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index da9696dfa4b..f7d9033c5f4 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -149,6 +149,7 @@ Top editing action. * Mouse Input:: Using the mouse and keypads. * Commands:: Named functions run by key sequences to do editing. +* Other Input:: Input besides the mouse, keyboard and keypads. * Entering Emacs:: Starting Emacs from the shell. * Exiting:: Stopping or killing Emacs. @@ -224,7 +225,6 @@ Top * Haiku:: Using Emacs on Haiku. * Android:: Using Emacs on Android. * Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS. -* Other Input Devices:: Using Emacs with other input devices. * Manifesto:: What's GNU? Gnu's Not Unix! * Glossary:: Terms used in this manual. @@ -1652,7 +1652,6 @@ GNU Free Documentation License @include android.texi @c Includes msdos-xtra. @include msdos.texi -@include input.texi @include gnu.texi @include glossary.texi @ifnottex diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index e2e30408a65..1862ed2d5d4 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1586,14 +1586,13 @@ Tab Bars wheel scrolling switches to the next or previous tab. Holding down the @key{SHIFT} key during scrolling moves the tab to the left or right. - Touch screen input (@pxref{Other Input Devices}) can also be used to -operate on tabs. Long-pressing (@pxref{Touchscreens}) a tab will -display a context menu with items that operate on the tab that was -pressed, and long-pressing the tab bar itself will display a context -menu which lets you create and remove tabs; tapping a tab itself will -result in that tab's window configuration being selected, and tapping -a button on the tab bar will behave as if it was clicked with -@kbd{mouse-1}. + Touch screen input (@pxref{Other Input}) can also be used to operate +on tabs. Long-pressing (@pxref{Touchscreens}) a tab will display a +context menu with items that operate on the tab that was pressed, and +long-pressing the tab bar itself will display a context menu which +lets you create and remove tabs; tapping a tab itself will result in +that tab's window configuration being selected, and tapping a button +on the tab bar will behave as if it was clicked with @kbd{mouse-1}. @findex tab-bar-history-mode You can enable @code{tab-bar-history-mode} to remember window diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index e4d595caf84..ae3dc05364e 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -1,26 +1,27 @@ @c This is part of the Emacs manual. @c Copyright (C) 2023 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. -@node Other Input Devices -@appendix Emacs and Unconventional Input Devices +@node Other Input +@section Touchscreen Input and Virtual Keyboards @cindex other input devices - Emacs was originally developed with the assumption that its users -have access to a desktop computer or computer terminal, with a -keyboard and perhaps a suitable pointing device such as a mouse. + Emacs was first written assuming that its users were to use it from +a desktop computer or computer terminal, equipped with a keyboard and +perhaps a suitable pointing device such as a mouse (@pxref{Mouse +Input}). - However, recent developments in the X Window System and operating -systems such as Android mean that this assumption no longer holds -true. Emacs supports input from various other kinds of input devices, -which is detailed here. + Emacs is also capable of receiving input from alternative sources of +input, enabling users to interact with it even if it is installed on a +computer that substitutes such input sources for the customary +combination of keyboard and mouse. @menu -* Touchscreens:: Using Emacs on touchscreens. -* On-Screen Keyboards:: Using Emacs with virtual keyboards. +* Touchscreens:: Interacting with Emacs from touchscreens. +* On-Screen Keyboards:: Text input with virtual keyboards. @end menu @node Touchscreens -@section Using Emacs on Touchscreens +@subsection Using Emacs on Touchscreens @cindex touchscreen input Touchscreen input is the manipulation of a frame's contents by the @@ -28,9 +29,11 @@ Touchscreens devices as styluses) on a monitor or computer terminal where it is displayed. - Under the X Window System or Android, Emacs detects and translates -the following sequences of movements (@dfn{gestures}) to common -actions: + Two factors, the order and position on which such tools are placed, +are compared against predefined patterns dubbed @dfn{gestures}, after +which any gesture those factors align with designates a series of +actions to be taken on the text beneath the tools; the gestures +presently recognized are: @itemize @bullet @item @@ -62,13 +65,6 @@ Touchscreens if @code{mouse-1} were to be held down and a mouse moved analogously. @xref{Mouse Commands}. -@item -@cindex pinching, touchscreens - @dfn{Pinching}, which is placing two tools apart on the screen and -adjusting their position such as to increase or decrease the distance -between them will modify the text scale (@xref{Text Scale}) in -proportion to the change in that distance. - @vindex touch-screen-word-select @cindex word selection mode, touchscreens To the detriment of text selection, it can prove challenging to @@ -95,6 +91,13 @@ Touchscreens surrounding point is displayed in the echo area (@pxref{Echo Area}) during the motion of the tool, below which is another line indicating the position of point relative to the first. + +@item +@cindex pinching, touchscreens + @dfn{Pinching}, the placement of two tools apart on the screen +followed by adjustments to their position such as to increase or +decrease the distance between them will modify the text scale +(@xref{Text Scale}) in proportion to the change in that distance. @end itemize @vindex touch-screen-delay @@ -103,84 +106,87 @@ Touchscreens through customizing the variable @code{touch-screen-delay}. @node On-Screen Keyboards -@section Using Emacs with Virtual Keyboards +@subsection Using Emacs with Virtual Keyboards @cindex virtual keyboards @cindex on-screen keyboards - When there is no physical keyboard attached to a system, the -windowing system typically provides an on-screen keyboard, more often -known as a ``virtual keyboard'', containing rows of clickable buttons -that send keyboard input to the application, much like a real keyboard -would. This virtual keyboard is hidden by default, as it uses up -valuable on-screen real estate, and must be opened once the program -being used is ready to accept keyboard input. - - Under the X Window System, the client that provides the on-screen -keyboard typically detects when the application is ready to accept -keyboard input through a set of complex heuristics, and automatically -displays the keyboard when necessary. + When there is no physical keyboard attached to a system, its +windowing system might provide an on-screen keyboard, widely known as +a ``virtual keyboard'', containing rows of clickable buttons that send +keyboard input to the application, much as a real keyboard would. - On other systems such as Android, Emacs must tell the system when it -is ready to accept keyboard input. Typically, this is done in -response to a touchscreen ``tap'' gesture (@pxref{Touchscreens}), or -once to the minibuffer becomes in use (@pxref{Minibuffer}.) + This virtual keyboard is hidden when the focused program is not +requesting text input as it occupies scarce space on display, and +programs are therefore enjoined to display it once they are ready to +accept keyboard input. Systems running X detect when the presence of +the virtual keyboard is warranted, but on others such as Android Emacs +is responsible for displaying it when need be, generally in reaction +to a touch screen ``tap'' gesture (@pxref{Touchscreens}) or the +minibuffer being brought into use (@pxref{Minibuffer}). @vindex touch-screen-set-point-commands When a ``tap'' gesture results in a command being executed, Emacs -checks to see whether or not the command is supposed to set the point -by looking for it in the list @code{touch-screen-set-point-commands}. -If it is, then Emacs looks up whether or not the text under the point -is read-only; if not, it activates the on-screen keyboard, assuming -that the user is about to enter text in to the current buffer. +checks whether the command is meant to set the point by searching for +it in the list @code{touch-screen-set-point-commands}. If it is and +the text beneath the new point is not read-only, it activates the +virtual keyboard, in anticipation that the user is about to enter text +there. -@vindex touch-screen-display-keyboard - The user option @code{touch-screen-display-keyboard} forces Emacs to -always display the on screen keyboard; it may also be set buffer -locally, which means that Emacs should always display the keyboard -when the buffer is selected. + The default value of @code{touch-point-set-point-commands} holds +only the command @code{mouse-set-point} (@pxref{Mouse Commands}), +which is the default binding of @code{mouse-1}, and thus of +touchscreen tap gestures as well. - Emacs also provides a set of functions to show or hide the on-screen -keyboard. For more details, @pxref{On-Screen Keyboards,,, elisp, The +@vindex touch-screen-display-keyboard + The user option @code{touch-screen-display-keyboard} compels Emacs +to display the virtual keyboard on such taps even if the text is read +only; it may also be set buffer locally, in which case Emacs will +always display the keyboard in response to a tap on a window +displaying the buffer it is set in. + + There are moreover a set of functions to show or hide the on-screen +keyboard. For more details, @xref{On-Screen Keyboards,,, elisp, The Emacs Lisp Reference Manual}. @cindex quitting, without a keyboard - Since it may not be possible for Emacs to display the on screen + Since it may not be possible for Emacs to display the virtual keyboard while it is executing a command, Emacs implements a feature -on devices with only an on-screen keyboard, by which two rapid clicks -of a hardware button that is always present on the device results in -Emacs quitting. @xref{Quitting}. +on window systems frequently equipped with no physical keyboard, by +which two rapid clicks of a hardware button that is always present on +the device induces a quit. @xref{Quitting}. @vindex x-quit-keysym - The button afforded such special treatment varies; under X, no such -button exists by default, but one can be configured through the -variable @code{x-quit-keysym}, whereas under Android it is always the -volume down buttons. + No such button is enabled on X, but one can be configured through +the variable @code{x-quit-keysym}. On Android this button is always +the volume down button. @cindex text conversion, keyboards - Most input methods designed to work with on-screen keyboards perform -buffer edits differently from desktop input methods. + Most input methods designed to work with virtual keyboards edit text +differently from desktop input methods. On a conventional desktop windowing system, an input method will -simply display the contents of any on going character compositions on -screen, and send the appropriate key events to Emacs after completion. +simply display the contents of any ongoing character composition on +screen, and send key events reflecting its contents to Emacs after it +is confirmed by the user. - However, on screen keyboard input methods directly perform edits to -the selected window of each frame; this is known as ``text + By contrast, virtual keyboard input methods directly perform edits +to the selected window of each frame; this is known as ``text conversion'', or ``string conversion'' under the X Window System. -Emacs enables these input methods whenever the buffer local value of -@code{text-conversion-style} is non-@code{nil}, normally inside -derivatives of @code{text-mode} and @code{prog-mode}. + + Emacs enables these input methods whenever the buffer local value of +@code{text-conversion-style} is non-@code{nil}, that is to say, +generally inside derivatives of @code{text-mode} and @code{prog-mode}. Text conversion is performed asynchronously whenever Emacs receives a request to perform the conversion from the input method, and Emacs is not currently reading a key sequence for which one prefix key has -already been read (@pxref{Keys}.) After the conversion completes, a +already been read (@pxref{Keys}). After the conversion completes, a @code{text-conversion} event is sent. @xref{Misc Events,,, elisp, the Emacs Reference Manual}. @vindex text-conversion-face If the input method needs to work on a region of the buffer, then -the region becomes known as the ``composing region'' (or -``preconversion region''.) The variable @code{text-conversion-face} -describes whether or not to display the composing region in a specific -face. +the region is designated the ``composing region'' (or ``preconversion +region''). The variable @code{text-conversion-face} controls whether +to display the composing region in a distinctive face, and if so, +which face to employ. diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index ca5e424d939..a2946bcada9 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -664,7 +664,7 @@ Tab Line icon of a tab deletes it. The mouse wheel on the tab line scrolls the tabs horizontally. - Touch screen input (@pxref{Other Input Devices}) can also be used to + Touch screen input (@pxref{Other Input}) can also be used to interact with the ``tab line''. Long-pressing (@pxref{Touchscreens}) a tab will display a context menu with items that operate on the tab that was pressed; tapping a tab itself will result in switching to commit 47b497b4dac91e5ea56102018223bdeb5e21a93b Author: Stefan Monnier Date: Sat Nov 18 16:34:38 2023 -0500 (update_search_regs): Install better fix for bug#67124 The recent fix for the bug in `replace-match-maybe-edit` was basically a refinement of a previously installed workaround, whereas the bug was really in `update_search_regs`. * src/search.c (update_search_regs): Improve handling of `start` positions. * lisp/replace.el (replace-match-maybe-edit): Remove workaround. * test/src/search-tests.el (search-test--replace-match-update-data): New test. diff --git a/lisp/replace.el b/lisp/replace.el index 7fec54ecb27..ac677db2feb 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2642,13 +2642,6 @@ replace-match-maybe-edit noedit nil))) (set-match-data match-data) (replace-match newtext fixedcase literal) - ;; `query-replace' undo feature needs the beginning of the match position, - ;; but `replace-match' may change it, for instance, with a regexp like "^". - ;; Ensure that this function preserves the beginning of the match position - ;; (bug#31492). But we need to avoid clobbering the end of the match with - ;; the original match-end position, since `replace-match' could have made - ;; that incorrect or even invalid (bug#67124). - (set-match-data (list (car match-data) (nth 1 (match-data)))) ;; `replace-match' leaves point at the end of the replacement text, ;; so move point to the beginning when replacing backward. (when backward (goto-char (nth 0 match-data))) diff --git a/src/search.c b/src/search.c index 692d8488049..2996d32fca1 100644 --- a/src/search.c +++ b/src/search.c @@ -3140,11 +3140,25 @@ update_search_regs (ptrdiff_t oldstart, ptrdiff_t oldend, ptrdiff_t newend) ptrdiff_t change = newend - oldend; ptrdiff_t i; + /* When replacing subgroup 3 in a match for regexp '\(\)\(\(\)\)\(\)' + start[i] should ideally stay unchanged for all but i=4 and end[i] + should move for all but i=1. + We don't have enough info here to distinguish those different subgroups + (except for subgroup 0), so instead we lean towards leaving the start[i]s + unchanged and towards moving the end[i]s. */ + for (i = 0; i < search_regs.num_regs; i++) { - if (search_regs.start[i] >= oldend) + if (search_regs.start[i] <= oldstart) + /* If the subgroup that 'replace-match' is modifying encloses the + subgroup 'i', then its 'start' position should stay unchanged. + That's always true for subgroup 0. + For other subgroups it depends on details we don't have, so + we optimistically assume that it also holds for them. */ + ; + else if (search_regs.start[i] >= oldend) search_regs.start[i] += change; - else if (search_regs.start[i] > oldstart) + else search_regs.start[i] = oldstart; if (search_regs.end[i] >= oldend) search_regs.end[i] += change; diff --git a/test/src/search-tests.el b/test/src/search-tests.el index 293a715f5dc..32dc8a72a86 100644 --- a/test/src/search-tests.el +++ b/test/src/search-tests.el @@ -39,4 +39,42 @@ test-replace-match-modification-hooks (replace-match "bcd")) (should (= (point) 10))))) +(ert-deftest search-test--replace-match-update-data () + (with-temp-buffer + (pcase-dolist (`(,pre ,post) '(("" "") + ("a" "") + ("" "b") + ("a" "b"))) + (erase-buffer) + (insert "hello ") + (save-excursion (insert pre post " world")) + (should (looking-at + (concat "\\(\\)" pre "\\(\\)\\(\\(\\)\\)\\(\\)" post "\\(\\)"))) + (let* ((beg0 (match-beginning 0)) + (beg4 (+ beg0 (length pre))) + (end4 (+ beg4 (length "BOO"))) + (end0 (+ end4 (length post)))) + (replace-match "BOO" t t nil 4) + (should (equal (match-beginning 0) beg0)) + (should (equal (match-beginning 1) beg0)) + (should (equal (match-beginning 2) beg4)) + (should (equal (match-beginning 3) beg4)) + (should (equal (match-beginning 4) beg4)) + (should (equal (match-end 6) end0)) + (should (equal (match-end 5) end4)) + (should (equal (match-end 4) end4)) + (should (equal (match-end 3) end4)) + (should (equal (match-end 0) end0)) + ;; `update_search_regs' doesn't have enough information to get + ;; the ones below correctly in all cases. + (when (> (length post) 0) + (should (equal (match-beginning 6) end0))) + (when (> (length pre) 0) + (should (equal (match-end 1) beg0))) + ;; `update_search_regs' doesn't have enough information to get + ;; the ones below correctly at all. + ;;(should (equal (match-beginning 5) end4)) + ;;(should (equal (match-end 2) beg4)) + )))) + ;;; search-tests.el ends here commit cca7956c82d612e0249db6065f16bcefc20e84f7 Author: F. Jason Park Date: Tue Nov 14 21:10:39 2023 -0800 Favor ISUPPORT params for MODE processing in ERC * etc/ERC-NEWS: Mention shift toward CHANMODES ISUPPORT parameter for dictating MODE parsing behavior. * lisp/erc/erc-backend.el (erc--init-channel-modes, erc--update-modes, erc-set-modes, erc-update-modes): Forward declarations, the last two being removals. (erc-server-MODE, erc-server-221): Use `erc--update-modes' instead of `erc-update-modes'. (erc-server-324): Use `erc--init-channel-modes' instead of `erc-set-modes'. * lisp/erc/erc-common.el (erc--channel-mode-types): New struct for stashing processed \"CHANMODES\" data for the current server. * lisp/erc/erc.el (erc-channel-modes): Fix doc string. (erc-set-initial-user-mode): Display a local notice when requesting redundant user MODE operations. (erc-set-modes, erc-parse-modes, erc-update-modes): Deprecate for reasons explained in associated ERC-NEWS entry. (erc--update-membership-prefix): New function, a helper for specifying arguments to the rather unruly `erc-update-current-channel-member'. (erc--channel-modes): New variable to record channel-mode state in a hash table. (erc--channel-mode-types): New variable and getter to stash and retrieve server-local instance of the struct of the same name. (erc--process-channel-modes): New function to parse channel-mode changes, dispatch handlers for unary modes, and update the local variables `erc-channel-modes' and `erc--channel-modes'. (erc--user-modes): New local variable for remembering user modes per server. New function of the same name, a "getter" for the variable. (erc--parse-user-modes): New function to parse user modes only. (erc--update-user-modes): New function to update and sort `erc--user-modes'. (erc--update-channel-modes): New function to replace much of `erc-update-modes', currently a thin wrapper around `erc--process-channel-modes' to ensure it updates status prefixes. (erc--update-modes): New function to call appropriate mode-updating function for the current buffer. (erc--init-channel-modes): New function to update channel mode letters without status prefixes. (erc--handle-channel-mode): New generic function, a placeholder for an eventual API to handle specific "unary" mode letters, meaning those that specify a single parameter for setting or unsetting. (erc-update-channel-limit): Update doc string and answer question posed by ancient comment. (erc-message-english-user-mode-redundant-add, erc-message-english-user-mode-redundant-drop): New English catalog messages. * test/lisp/erc/erc-scenarios-base-chan-modes.el: New file. * test/lisp/erc/erc-tests.el (erc-parse-modes, erc--update-channel-modes, erc--update-user-modes, erc--user-modes, erc--parse-user-modes): New tests. * test/lisp/erc/resources/base/modes/chan-changed.eld: New test data file. (Bug#67220) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 04b11fc19f0..3bb9a30cfb2 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -480,6 +480,17 @@ release lacks a similar solution for detecting "joinedness" directly, but users can turn to 'xor'-ing 'erc-default-target' and 'erc-target' as a makeshift kludge. +*** Channel-mode handling has become stricter and more predictable. +ERC has always processed channel modes using "standardized" letters +and popular status prefixes. Starting with this release, ERC will +begin preferring advertised "CHANMODES" when interpreting letters and +their arguments. To facilitate this transition, the functions +'erc-set-modes', 'erc-parse-modes', and 'erc-update-modes', have all +been provisionally deprecated. Expect a new, replacement API for +handling specific "MODE" types and letters in coming releases. If +you'd like a say in shaping how this transpires, please share your +ideas and use cases on the tracker. + *** 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'. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 8ebc10501c2..371b4591915 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -132,8 +132,10 @@ erc-reuse-buffers (defvar erc-verbose-server-ping) (defvar erc-whowas-on-nosuchnick) +(declare-function erc--init-channel-modes "erc" (channel raw-args)) (declare-function erc--open-target "erc" (target)) (declare-function erc--target-from-string "erc" (string)) +(declare-function erc--update-modes "erc" (raw-args)) (declare-function erc-active-buffer "erc" nil) (declare-function erc-add-default-channel "erc" (channel)) (declare-function erc-banlist-update "erc" (proc parsed)) @@ -179,7 +181,6 @@ erc-whowas-on-nosuchnick (declare-function erc-server-buffer "erc" nil) (declare-function erc-set-active-buffer "erc" (buffer)) (declare-function erc-set-current-nick "erc" (nick)) -(declare-function erc-set-modes "erc" (tgt mode-string)) (declare-function erc-time-diff "erc" (t1 t2)) (declare-function erc-trim-string "erc" (s)) (declare-function erc-update-mode-line "erc" (&optional buffer)) @@ -194,8 +195,6 @@ erc-whowas-on-nosuchnick (proc parsed nick login host msg)) (declare-function erc-update-channel-topic "erc" (channel topic &optional modify)) -(declare-function erc-update-modes "erc" - (tgt mode-string &optional _nick _host _login)) (declare-function erc-update-user-nick "erc" (nick &optional new-nick host login full-name info)) (declare-function erc-open "erc" @@ -1804,7 +1803,7 @@ erc--server-determine-join-display-context (t (erc-get-buffer tgt))))) (with-current-buffer (or buf (current-buffer)) - (erc-update-modes tgt mode nick host login)) + (erc--update-modes (cdr (erc-response.command-args parsed)))) (if (or (string= login "") (string= host "")) (erc-display-message parsed 'notice buf 'MODE-nick ?n nick @@ -2165,7 +2164,7 @@ erc--with-isupport-data (let* ((nick (car (erc-response.command-args parsed))) (modes (mapconcat #'identity (cdr (erc-response.command-args parsed)) " "))) - (erc-set-modes nick modes) + (erc--update-modes (cdr (erc-response.command-args parsed))) (erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes))) (define-erc-response-handler (252) @@ -2331,7 +2330,7 @@ erc-server-322-message (let ((channel (cadr (erc-response.command-args parsed))) (modes (mapconcat #'identity (cddr (erc-response.command-args parsed)) " "))) - (erc-set-modes channel modes) + (erc--init-channel-modes channel (cddr (erc-response.command-args parsed))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's324 ?c channel ?m modes))) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 0beae4f9f23..e876afe2644 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -113,6 +113,11 @@ erc--isupport-data (statuses "~&@%+" :type string) (alist nil :type (list-of cons))) +(cl-defstruct (erc--channel-mode-types (:include erc--isupport-data)) + "Server-local \"CHANMODES\" data." + (fallbackp nil :type boolean) + (table (make-char-table 'erc--channel-mode-types) :type char-table)) + ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) "Return preferred SYMBOL for `erc--modules'." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7977bcb69e3..f4c3f77593c 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -732,9 +732,9 @@ erc-channel-topic "A topic string for the channel. Should only be used in channel-buffers.") (defvar-local erc-channel-modes nil - "List of strings representing channel modes. -E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\") -\(not sure the ban list will be here, but why not)") + "List of letters, as strings, representing channel modes. +For example, (\"i\" \"m\" \"s\"). Modes that take accompanying +parameters are not included.") (defvar-local erc-insert-marker nil "The place where insertion of new text in erc buffers should happen.") @@ -4552,6 +4552,10 @@ erc--send-message-nested (erc--send-input-lines (erc--run-send-hooks lines-obj))) t) +;; FIXME if the user types /MODE, LINE becomes "\n", which +;; matches the pattern, so "\n" is sent to the server. Perhaps +;; instead of `do-not-parse-args', this should just join &rest +;; arguments. (defun erc-cmd-MODE (line) "Change or display the mode value of a channel or user. The first word specifies the target. The rest is the mode string @@ -5915,9 +5919,19 @@ erc-set-initial-user-mode The server buffer is given by BUFFER." (with-current-buffer buffer (when erc-user-mode - (let ((mode (if (functionp erc-user-mode) - (funcall erc-user-mode) - erc-user-mode))) + (let* ((mode (if (functionp erc-user-mode) + (funcall erc-user-mode) + erc-user-mode)) + (groups (erc--parse-user-modes mode (erc--user-modes) t)) + (superfluous (last groups 2)) + (redundant-want (car superfluous)) + (redundant-drop (cadr superfluous))) + (when redundant-want + (erc-display-message nil 'notice buffer 'user-mode-redundant-add + ?m (apply #'string redundant-want))) + (when redundant-drop + (erc-display-message nil 'notice buffer 'user-mode-redundant-drop + ?m (apply #'string redundant-drop))) (when (stringp mode) (erc-log (format "changing mode for %s to %s" nick mode)) (erc-server-send (format "MODE %s %s" nick mode))))))) @@ -6474,7 +6488,9 @@ erc-update-channel-topic (defun erc-set-modes (tgt mode-string) "Set the modes for the TGT provided as MODE-STRING." - (let* ((modes (erc-parse-modes mode-string)) + (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) + (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes)) + (erc-parse-modes mode-string))) (add-modes (nth 0 modes)) ;; list of triples: (mode-char 'on/'off argument) (arg-modes (nth 2 modes))) @@ -6520,6 +6536,7 @@ erc-parse-modes arg-modes is a list of triples of the form: (MODE-CHAR ON/OFF ARGUMENT)." + (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) (if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string) (let ((chars (mapcar #'char-to-string (match-string 1 mode-string))) ;; arguments in channel modes @@ -6564,8 +6581,10 @@ erc-update-modes "Update the mode information for TGT, provided as MODE-STRING. Optional arguments: NICK, HOST and LOGIN - the attributes of the person who changed the modes." + (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) ;; FIXME: neither of nick, host, and login are used! - (let* ((modes (erc-parse-modes mode-string)) + (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes)) + (erc-parse-modes mode-string))) (add-modes (nth 0 modes)) (remove-modes (nth 1 modes)) ;; list of triples: (mode-char 'on/'off argument) @@ -6614,9 +6633,202 @@ erc-update-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, +or t, for type D.") + +(defvar-local erc--channel-mode-types nil + "Possibly stale `erc--channel-mode-types' instance for the server. +Use the getter of the same name to retrieve the current value.") + +(defun erc--channel-mode-types () + "Return variable `erc--channel-mode-types', possibly initializing it." + (erc--with-isupport-data CHANMODES erc--channel-mode-types + (let ((types (or key '(nil "Kk" "Ll" nil))) + (ct (make-char-table 'erc--channel-mode-types)) + (type ?a)) + (dolist (cs types) + (dolist (c (append cs nil)) + (aset ct c type)) + (cl-incf type)) + (make-erc--channel-mode-types :key key + :fallbackp (null key) + :table ct)))) + +(defun erc--process-channel-modes (string args &optional status-letters) + "Parse channel \"MODE\" changes and call unary letter handlers. +Update `erc-channel-modes' and `erc--channel-modes'. With +STATUS-LETTERS, also update channel membership prefixes. Expect +STRING to be the second argument from an incoming \"MODE\" +command and ARGS to be the remaining arguments, which should +complement relevant letters in STRING." + (cl-assert (erc--target-channel-p erc--target)) + (let* ((obj (erc--channel-mode-types)) + (table (erc--channel-mode-types-table obj)) + (fallbackp (erc--channel-mode-types-fallbackp obj)) + (+p t)) + (dolist (c (append string nil)) + (let ((letter (char-to-string c))) + (cond ((= ?+ c) (setq +p t)) + ((= ?- c) (setq +p nil)) + ((and status-letters (string-search letter status-letters)) + (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) + ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) + (erc--handle-channel-mode group c +p + (and (or (/= group ?c) +p) + (pop args))) + t)) + ((not fallbackp) + (erc-display-message nil '(notice error) (erc-server-buffer) + (format "Unknown channel mode: %S" c)))))) + (setq erc-channel-modes (sort erc-channel-modes #'string<)) + (erc-update-mode-line (current-buffer)))) + +(defvar-local erc--user-modes nil + "Sorted list of current user \"MODE\" letters. +Analogous to `erc-channel-modes' but chars rather than strings.") + +(defun erc--user-modes (&optional as-type) + "Return user \"MODE\" letters in a form described by AS-TYPE. +When AS-TYPE is the symbol `strings' (plural), return a list of +strings. When it's `string' (singular), return the same list +concatenated into a single string. When it's a single char, like +?+, return the same value as `string' but with AS-TYPE prepended. +When AS-TYPE is nil, return a list of chars." + (let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes)))) + (pcase as-type + ('strings (mapcar #'char-to-string modes)) + ('string (apply #'string modes)) + ((and (pred characterp) c) (apply #'string (cons c modes))) + (_ modes)))) + +(defun erc--parse-user-modes (string &optional current extrap) + "Return lists of chars from STRING to add to and drop from CURRENT. +Expect STRING to be a so-called \"modestring\", the second +parameter of a \"MODE\" command, here containing only valid +user-mode letters. Expect CURRENT to be a list of chars +resembling those found in `erc--user-modes'. With EXTRAP, return +two additional lists of chars: those that would be added were +they not already present in CURRENT and those that would be +dropped were they not already absent." + (let ((addp t) + ;; + redundant-add redundant-drop adding dropping) + ;; For short strings, `append' appears to be no slower than + ;; iteration var + `aref' or `mapc' + closure. + (dolist (c (append string nil)) + (pcase c + (?+ (setq addp t)) + (?- (setq addp nil)) + (_ (push c (let ((hasp (and current (memq c current)))) + (if addp + (if hasp redundant-add adding) + (if hasp dropping redundant-drop))))))) + (if extrap + (list (nreverse adding) (nreverse dropping) + (nreverse redundant-add) (nreverse redundant-drop)) + (list (nreverse adding) (nreverse dropping))))) + +(defun erc--update-user-modes (string) + "Update `erc--user-modes' from \"MODE\" STRING. +Return its value, a list of characters sorted by character code." + (setq erc--user-modes + (pcase-let ((`(,adding ,dropping) + (erc--parse-user-modes string erc--user-modes))) + (sort (seq-difference (nconc erc--user-modes adding) dropping) + #'<)))) + +(defun erc--update-channel-modes (string &rest args) + "Update `erc-channel-modes' and call individual mode handlers. +Also update membership prefixes, as needed. Expect STRING to be +a \"modestring\" and ARGS to match mode-specific parameters." + (let ((status-letters (or (erc-with-server-buffer + (erc--parsed-prefix-letters + (erc--parsed-prefix))) + "qaovhbQAOVHB"))) + (erc--process-channel-modes string args status-letters))) + +;; XXX this comment is referenced elsewhere (grep before deleting). +;; +;; The function `erc-update-modes' was deprecated in ERC 5.6 with no +;; immediate public replacement. Third parties needing such a thing +;; are encouraged to write to emacs-erc@gnu.org with ideas for a +;; mode-handler API, possibly one incorporating letter-specific +;; handlers, like `erc--handle-channel-mode' (below), which only +;; handles mode types A-C. +(defun erc--update-modes (raw-args) + "Handle user or channel \"MODE\" update from server. +Expect RAW-ARGS be a list consisting of a \"modestring\" followed +by mode-specific arguments." + (if (and erc--target (erc--target-channel-p erc--target)) + (apply #'erc--update-channel-modes raw-args) + (erc--update-user-modes (car raw-args)))) + +(defun erc--init-channel-modes (channel raw-args) + "Set CHANNEL modes from RAW-ARGS. +Expect RAW-ARGS to be a \"modestring\" without any status-prefix +chars, followed by applicable arguments." + (erc-with-buffer (channel) + (erc--process-channel-modes (car raw-args) (cdr raw-args)))) + +(cl-defgeneric erc--handle-channel-mode (type letter state arg) + "Handle a STATE change for mode LETTER of TYPE with ARG. +Expect to be called in the affected target buffer. Expect TYPE +to be a character, like ?a, representing an advertised +\"CHANMODES\" group. Expect LETTER to also be a character, and +expect STATE to be a boolean and ARGUMENT either a string or nil." + (erc-log (format "Channel-mode %c (type %s, arg %S) %s" + letter type arg (if state 'enabled 'disabled)))) + +(cl-defmethod erc--handle-channel-mode :before (_ c state arg) + "Record STATE change and ARG, if enabling, for mode letter C." + (unless erc--channel-modes + (cl-assert (erc--target-channel-p erc--target)) + (setq erc--channel-modes (make-hash-table))) + (if state + (puthash c (or arg t) erc--channel-modes) + (remhash c erc--channel-modes))) + +(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _) + "Update `erc-channel-modes' for any character C of nullary type D. +Remember when STATE is non-nil and forget otherwise." + (setq erc-channel-modes + (if state + (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal) + (delete (char-to-string c) erc-channel-modes)))) + +;; We could specialize on type C, but that may be too brittle. +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg) + "Update channel user limit, remembering ARG when STATE is non-nil." + (erc-update-channel-limit (erc--target-string erc--target) + (if state 'on 'off) + arg)) + +;; We could specialize on type B, but that may be too brittle. +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg) + "Update channel key, remembering ARG when state is non-nil." + ;; Mimic old parsing behavior in which an ARG of "*" was discarded + ;; even though `erc-update-channel-limit' checks STATE first. + (erc-update-channel-key (erc--target-string erc--target) + (if state 'on 'off) + (if (equal arg "*") nil arg))) + (defun erc-update-channel-limit (channel onoff n) - ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08 - "Update CHANNEL's user limit to N." + "Update CHANNEL's user limit to N. +Expect ONOFF to be `on' when the mode is being enabled and `off' +otherwise. And because this mode is of \"type C\", expect N to +be non-nil only when enabling." (if (or (not (eq onoff 'on)) (and (stringp n) (string-match "^[0-9]+$" n))) (erc-with-buffer @@ -8292,6 +8504,10 @@ erc-define-catalog (ops . "%i operator%s: %o") (ops-none . "No operators in this channel.") (undefined-ctcp . "Undefined CTCP query received. Silently ignored") + (user-mode-redundant-add + . "Already have user mode(s): %m. Requesting again anyway.") + (user-mode-redundant-drop + . "Already without user mode(s): %m. Requesting removal anyway.") (variable-not-bound . "Variable not bound!") (ACTION . "* %n %a") (CTCP-CLIENTINFO . "Client info for %n: %m") diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el new file mode 100644 index 00000000000..9c63d8aff8e --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el @@ -0,0 +1,84 @@ +;;; erc-scenarios-base-chan-modes.el --- Channel mode scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 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-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +;; This asserts that a bug present in ERC 5.4+ is now absent. +;; Previously, ERC would attempt to parse a nullary channel mode as if +;; it were a status prefix update, which led to a wrong-type error. +;; This test does not address similar collisions with unary modes, +;; such as "MODE +q foo!*@*", but it should. +(ert-deftest erc-scenarios-base-chan-modes--plus-q () + :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 'chan-changed)) + (erc-modules (cons 'fill-wrap erc-modules)) + (erc-autojoin-channels-alist '((Libera.Chat "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to Libera.Chat") + (with-current-buffer (erc :server "127.0.0.1" + :port (process-contact dumb-server :service) + :nick "tester" + :full-name "tester") + (funcall expect 5 "changed mode"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (should-not erc-channel-key) + (should-not erc-channel-user-limit) + + (ert-info ("Receive notice that mode has changed") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))) + (erc-scenarios-common-say "ready before") + (funcall expect 10 " before") + (funcall expect 10 " has changed mode for #chan to +Qu") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u")))) + + (ert-info ("Key stored locally") + (erc-scenarios-common-say "ready key") + (funcall expect 10 " doing key") + (funcall expect 10 " has changed mode for #chan to +k hunter2") + (should (equal erc-channel-key "hunter2"))) + + (ert-info ("Limit stored locally") + (erc-scenarios-common-say "ready limit") + (funcall expect 10 " doing limit") + (funcall expect 10 " has changed mode for #chan to +l 3") + (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3)) + (should (equal erc-channel-modes '("Q" "n" "t" "u")))) + + (ert-info ("Modes removed and local state deletion succeeds") + (erc-scenarios-common-say "ready drop") + (funcall expect 10 " dropping") + (funcall expect 10 " has changed mode for #chan to -lu") + (funcall expect 10 " has changed mode for #chan to -Qk *") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))) + + (should-not erc-channel-key) + (should-not erc-channel-user-limit) + (funcall expect 10 " after")))) + +;;; 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 b4a3c89b27c..8dbe44ce5ed 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -701,6 +701,152 @@ erc--parsed-prefix (erc-with-server-buffer erc--parsed-prefix)) expected))))) +;; 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 () + (with-suppressed-warnings ((obsolete erc-parse-modes)) + (should (equal (erc-parse-modes "+u") '(("u") nil nil))) + (should (equal (erc-parse-modes "-u") '(nil ("u") nil))) + (should (equal (erc-parse-modes "+o bob") '(nil nil (("o" on "bob"))))) + (should (equal (erc-parse-modes "-o bob") '(nil nil (("o" off "bob"))))) + (should (equal (erc-parse-modes "+uo bob") '(("u") nil (("o" on "bob"))))) + (should (equal (erc-parse-modes "+o-u bob") '(nil ("u") (("o" on "bob"))))) + (should (equal (erc-parse-modes "+uo-tv bob alice") + '(("u") ("t") (("o" on "bob") ("v" off "alice"))))) + + (ert-info ("Modes of type B are always grouped as unary") + (should (equal (erc-parse-modes "+k h2") '(nil nil (("k" on "h2"))))) + ;; Channel key args are thrown away. + (should (equal (erc-parse-modes "-k *") '(nil nil (("k" off nil)))))) + + (ert-info ("Modes of type C are grouped as unary even when disabling") + (should (equal (erc-parse-modes "+l 3") '(nil nil (("l" on "3"))))) + (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil)))))))) + +(ert-deftest erc--update-channel-modes () + (erc-mode) + (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--set-fake-server-process "sleep" "1") + + (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) + calls) + (cl-letf (((symbol-function 'erc--handle-channel-mode) + (lambda (&rest r) (push r calls) (apply orig-handle-fn r))) + ((symbol-function 'erc-update-mode-line) #'ignore)) + + (ert-info ("Unknown user not created") + (erc--update-channel-modes "+o" "bob") + (should-not (erc-get-channel-user "bob"))) + + (ert-info ("Status updated when user known") + (puthash "bob" (cons (erc-add-server-user + "bob" (make-erc-server-user :nickname "bob")) + (make-erc-channel-user)) + erc-channel-users) + ;; Also asserts fallback behavior for traditional prefixes. + (should-not (erc-channel-user-op-p "bob")) + (erc--update-channel-modes "+o" "bob") + (should (erc-channel-user-op-p "bob")) + (erc--update-channel-modes "-o" "bob") ; status revoked + (should-not (erc-channel-user-op-p "bob"))) + + (ert-info ("Unknown nullary added and removed") + (should-not erc--channel-modes) + (should-not erc-channel-modes) + (erc--update-channel-modes "+u") + (should (equal erc-channel-modes '("u"))) + (should (eq t (gethash ?u erc--channel-modes))) + (should (equal (pop calls) '(?d ?u t nil))) + (erc--update-channel-modes "-u") + (should (equal (pop calls) '(?d ?u nil nil))) + (should-not (gethash ?u erc--channel-modes)) + (should-not erc-channel-modes) + (should-not calls)) + + (ert-info ("Fallback for Type B includes mode letter k") + (erc--update-channel-modes "+k" "h2") + (should (equal (pop calls) '(?b ?k t "h2"))) + (should-not erc-channel-modes) + (should (equal "h2" (gethash ?k erc--channel-modes))) + (erc--update-channel-modes "-k" "*") + (should (equal (pop calls) '(?b ?k nil "*"))) + (should-not calls) + (should-not (gethash ?k erc--channel-modes)) + (should-not erc-channel-modes)) + + (ert-info ("Fallback for Type C includes mode letter l") + (erc--update-channel-modes "+l" "3") + (should (equal (pop calls) '(?c ?l t "3"))) + (should-not erc-channel-modes) + (should (equal "3" (gethash ?l erc--channel-modes))) + (erc--update-channel-modes "-l" nil) + (should (equal (pop calls) '(?c ?l nil nil))) + (should-not (gethash ?l erc--channel-modes)) + (should-not erc-channel-modes)) + + (ert-info ("Advertised supersedes heuristics") + (setq erc-server-parameters + '(("PREFIX" . "(ov)@+") + ;; Add phony 5th type for this CHANMODES value for + ;; robustness in case some server gets creative. + ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE"))) + (erc--update-channel-modes "+qu" "fool!*@*") + (should (equal (pop calls) '(?d ?u t nil))) + (should (equal (pop calls) '(?a ?q t "fool!*@*"))) + (should (equal "fool!*@*" (gethash ?q erc--channel-modes))) + (should (eq t (gethash ?u erc--channel-modes))) + (should (equal erc-channel-modes '("u"))) + (should-not (erc-channel-user-owner-p "bob"))) + + (should-not calls)))) + +(ert-deftest erc--update-user-modes () + (let ((erc--user-modes (list ?a))) + (should (equal (erc--update-user-modes "+a") '(?a))) + (should (equal (erc--update-user-modes "-b") '(?a))) + (should (equal erc--user-modes '(?a)))) + + (let ((erc--user-modes (list ?b))) + (should (equal (erc--update-user-modes "+ac") '(?a ?b ?c))) + (should (equal (erc--update-user-modes "+a-bc") '(?a))) + (should (equal erc--user-modes '(?a))))) + +(ert-deftest erc--user-modes () + (let ((erc--user-modes '(?a ?b))) + (should (equal (erc--user-modes) '(?a ?b))) + (should (equal (erc--user-modes 'string) "ab")) + (should (equal (erc--user-modes 'strings) '("a" "b"))) + (should (equal (erc--user-modes '?+) "+ab")))) + +(ert-deftest erc--parse-user-modes () + (should (equal (erc--parse-user-modes "a" '(?a)) '(() ()))) + (should (equal (erc--parse-user-modes "+a" '(?a)) '(() ()))) + (should (equal (erc--parse-user-modes "a" '()) '((?a) ()))) + (should (equal (erc--parse-user-modes "+a" '()) '((?a) ()))) + (should (equal (erc--parse-user-modes "-a" '()) '(() ()))) + (should (equal (erc--parse-user-modes "-a" '(?a)) '(() (?a)))) + + (should (equal (erc--parse-user-modes "+a-b" '(?a)) '(() ()))) + (should (equal (erc--parse-user-modes "+a-b" '(?b)) '((?a) (?b)))) + (should (equal (erc--parse-user-modes "+ab-c" '(?b)) '((?a) ()))) + (should (equal (erc--parse-user-modes "+ab-c" '(?b ?c)) '((?a) (?c)))) + (should (equal (erc--parse-user-modes "+a-c+b" '(?b ?c)) '((?a) (?c)))) + (should (equal (erc--parse-user-modes "-c+ab" '(?b ?c)) '((?a) (?c)))) + + ;; Param `extrap' returns groups of redundant chars. + (should (equal (erc--parse-user-modes "+a" '() t) '((?a) () () ()))) + (should (equal (erc--parse-user-modes "+a" '(?a) t) '(() () (?a) ()))) + (should (equal (erc--parse-user-modes "-a" '() t) '(() () () (?a)))) + (should (equal (erc--parse-user-modes "-a" '(?a) t) '(() (?a) () ()))) + + (should (equal (erc--parse-user-modes "+a-b" '(?a) t) '(() () (?a) (?b)))) + (should (equal (erc--parse-user-modes "-b+a" '(?a) t) '(() () (?a) (?b)))) + (should (equal (erc--parse-user-modes "+a-b" '(?b) t) '((?a) (?b) () ()))) + (should (equal (erc--parse-user-modes "-b+a" '(?b) t) '((?a) (?b) () ())))) + (ert-deftest erc--parse-isupport-value () (should (equal (erc--parse-isupport-value "a,b") '("a" "b"))) (should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c"))) diff --git a/test/lisp/erc/resources/base/modes/chan-changed.eld b/test/lisp/erc/resources/base/modes/chan-changed.eld new file mode 100644 index 00000000000..6cf6596b0b2 --- /dev/null +++ b/test/lisp/erc/resources/base/modes/chan-changed.eld @@ -0,0 +1,55 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester") + (0.02 ":cadmium.libera.chat 002 tester :Your host is cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev") + (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25 2023 at 10:22:45 UTC") + (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI") + (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server") + (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server") + (0.01 ":cadmium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server") + (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996 invisible on 28 servers") + (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online") + (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)") + (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed") + (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers") + (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499, max 4187") + (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users 43066, max 51827") + (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187 clients) (319420 connections received)") + (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the Day - ") + (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach Dilemma (www.m-d.net)") + (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for") + (0.00 ":cadmium.libera.chat 372 tester :- Email: support@libera.chat") + (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.") + (0.00 ":tester MODE tester :+Ziw")) + +((mode-tester 10 "MODE tester +i")) + +((join-chan 10 "JOIN #chan") + (0.09 ":tester!~tester@127.0.0.1 JOIN #chan")) + +((mode-chan 10 "MODE #chan") + (0.03 ":cadmium.libera.chat 353 tester = #chan :tester @Chad dummy") + (0.02 ":cadmium.libera.chat 366 tester #chan :End of /NAMES list.") + (0.00 ":cadmium.libera.chat 324 tester #chan +nt") + (0.01 ":cadmium.libera.chat 329 tester #chan 1621432263")) + +((privmsg-before 10 "PRIVMSG #chan :ready before") + (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan before") + (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +Qu")) + +((privmsg-key 10 "PRIVMSG #chan :ready key") + (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing key") + (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +k hunter2")) + +((privmsg-limit 10 "PRIVMSG #chan :ready limit") + (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing limit") + (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +l 3")) + +((privmsg-drop 10 "PRIVMSG #chan :ready drop") + (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan dropping") + (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -lu") + (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -Qk *") + (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan after")) + +((drop 0 DROP)) commit e7fa460e1da3847456f03b9f508c6f6e5c09e450 Author: F. Jason Park Date: Mon Nov 13 18:24:59 2023 -0800 Use caching variant of erc-parse-prefix internally * lisp/erc/erc-common.el (erc--parsed-prefix): New struct to help with tasks that depends on the advertised "PREFIX" parameter. * lisp/erc/erc.el (erc-parse-prefix): Rework slightly for readability. (erc--parsed-prefix): New variable and function of the same name for caching the reversed result of `erc-parse-prefix' locally per server. (erc-channel-receive-names): Use value stored in `erc--parsed-prefix'. * test/lisp/erc/erc-tests.el (erc-with-server-buffer): Only activate spy around actual test case forms. (erc--parse-prefix): New test. (Bug#67220) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index b020c612b7d..0beae4f9f23 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -106,6 +106,13 @@ erc--isupport-data For use with the macro `erc--with-isupport-data'." (key nil :type (or null cons))) +(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))) + ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) "Return preferred SYMBOL for `erc--modules'." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2abbbaa3578..7977bcb69e3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6193,22 +6193,38 @@ erc-channel-end-receiving-names (defun erc-parse-prefix () "Return an alist of valid prefix character types and their representations. -Example: (operator) o => @, (voiced) v => +." - (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t)) - ;; provide a sane default - "(qaohv)~&@%+")) - types chars) - (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str) - (setq types (match-string 1 str) - chars (match-string 2 str)) - (let ((len (min (length types) (length chars))) - (i 0) - (alist nil)) - (while (< i len) - (setq alist (cons (cons (elt types i) (elt chars i)) - alist)) - (setq i (1+ i))) - alist)))) +For example, if the current ISUPPORT \"PREFIX\" is \"(ov)@+\", +return an alist `equal' to ((?v . ?+) (?o . ?@)). For historical +reasons, ensure the ordering of the returned alist is opposite +that of the advertised parameter." + (let* ((str (or (erc--get-isupport-entry 'PREFIX t) "(qaohv)~&@%+")) + (i 0) + (j (string-search ")" str)) + collected) + (when j + (while-let ((u (aref str (cl-incf i))) + ((not (= ?\) u)))) + (push (cons u (aref str (cl-incf j))) collected))) + collected)) + +(defvar-local erc--parsed-prefix nil + "Possibly stale `erc--parsed-prefix' struct instance for the server. +Use the \"getter\" function of the same name to obtain the current +value.") + +(defun erc--parsed-prefix () + "Return possibly cached `erc--parsed-prefix' object for the server. +Ensure the returned value describes the most recent \"PREFIX\" +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)))) + (make-erc--parsed-prefix + :key key + :letters (apply #'string (map-keys alist)) + :statuses (apply #'string (map-values alist)) + :alist alist)))) (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. @@ -6222,7 +6238,7 @@ erc-channel-receive-names Update `erc-channel-users' according to NAMES-STRING. NAMES-STRING is a string listing some of the names on the channel." - (let* ((prefix (erc-parse-prefix)) + (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))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index e7422d330c0..b4a3c89b27c 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -115,14 +115,20 @@ erc-with-server-buffer (setq erc-away 1) (erc-tests--set-fake-server-process "sleep" "1") - (let (calls) - (advice-add 'buffer-local-value :after (lambda (&rest r) (push r calls)) + (let (mockingp calls) + (advice-add 'buffer-local-value :after + (lambda (&rest r) (when mockingp (push r calls))) '((name . erc-with-server-buffer))) - (should (= 1 (erc-with-server-buffer erc-away))) + (should (= 1 (prog2 (setq mockingp t) + (erc-with-server-buffer erc-away) + (setq mockingp nil)))) + (should (equal (pop calls) (list 'erc-away (current-buffer)))) - (should (= 1 (erc-with-server-buffer (ignore 'me) erc-away))) + (should (= 1 (prog2 (setq mockingp t) + (erc-with-server-buffer (ignore 'me) erc-away) + (setq mockingp nil)))) (should-not calls) (advice-remove 'buffer-local-value 'erc-with-server-buffer))) @@ -643,6 +649,58 @@ erc-parse-user (should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy")))))) +(ert-deftest erc--parsed-prefix () + (erc-mode) + (erc-tests--set-fake-server-process "sleep" "1") + (setq erc--isupport-params (make-hash-table)) + + ;; Uses fallback values when no PREFIX parameter yet received, thus + ;; ensuring caller can use slot accessors immediately intead of + ;; checking if null beforehand. + (should-not erc--parsed-prefix) + (should (equal (erc--parsed-prefix) + #s(erc--parsed-prefix nil "qaohv" "~&@%+" + ((?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+))))) + (let ((cached (should erc--parsed-prefix))) + (should (eq (erc--parsed-prefix) cached))) + + ;; Cache broken. (Notice not setting `erc--parsed-prefix' to nil). + (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) + + (let ((proc erc-server-process) + (expected '((?Y . ?!) (?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+))) + cached) + + (with-temp-buffer + (erc-mode) + (setq erc-server-process proc) + (should (equal expected + (erc--parsed-prefix-alist (erc--parsed-prefix))))) + + (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix))) + (setq cached erc--parsed-prefix) + (should (equal cached + #s(erc--parsed-prefix ("(Yqaohv)!~&@%+") "Yqaohv" "!~&@%+" + ((?Y . ?!) (?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+))))) + ;; Second target buffer reuses cached value. + (with-temp-buffer + (erc-mode) + (setq erc-server-process proc) + (should (eq cached (erc--parsed-prefix)))) + + ;; New value computed when cache broken. + (puthash 'PREFIX (list "(Yqaohv)!~&@%+") erc--isupport-params) + (with-temp-buffer + (erc-mode) + (setq erc-server-process proc) + (should-not (eq cached (erc--parsed-prefix))) + (should (equal (erc--parsed-prefix-alist + (erc-with-server-buffer erc--parsed-prefix)) + expected))))) + (ert-deftest erc--parse-isupport-value () (should (equal (erc--parse-isupport-value "a,b") '("a" "b"))) (should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c"))) commit b088222ec9f0cff720ca366bdef448d392731f94 Author: F. Jason Park Date: Mon Nov 13 18:24:59 2023 -0800 Simplify ISUPPORT-derived data wrangling in ERC * lisp/erc/erc-backend.el (erc--get-isupport-entry): Check server buffer for `erc-server-parameters' when (re)initializing value. This function was previously unreliable from a target buffer on cache misses. (erc--with-isupport-data): New macro for accessing and caching data derived from an ISUPPORT parameter. Late-arriving params break the cache. (erc-server-005): Rewrite pattern as `rx' form, factoring out bol/eol. * lisp/erc/erc-common.el (erc--isupport-data): New struct to be subclassed for storing cached ISUPPORT-derived data. * test/lisp/erc/erc-scenarios-display-message.el: Remove stray `require'. (Bug#67220) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 66ac9057d75..8ebc10501c2 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2098,7 +2098,9 @@ erc--get-isupport-entry (erc-with-server-buffer erc--isupport-params))) (value (with-memoization (gethash key table) (when-let ((v (assoc (symbol-name key) - erc-server-parameters))) + (or erc-server-parameters + (erc-with-server-buffer + erc-server-parameters))))) (if (cdr v) (erc--parse-isupport-value (cdr v)) '--empty--))))) @@ -2108,6 +2110,22 @@ erc--get-isupport-entry (when table (remhash key table)))) +;; 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. +(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 +VAR is uninitialized or stale, evaluate BODY and assign the +result to VAR." + (declare (indent defun)) + `(erc-with-server-buffer + (pcase-let (((,@(list '\` (list param '\, 'key))) + (erc--get-isupport-entry ',param))) + (or (and ,var (eq key (erc--isupport-data-key ,var)) ,var) + (setq ,var (progn ,@body)))))) + (define-erc-response-handler (005) "Set the variable `erc-server-parameters' and display the received message. @@ -2128,8 +2146,11 @@ erc--get-isupport-entry key value negated) - (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\(-\\)?\\([A-Z]+\\)$" - section) + (when (string-match + (rx bot (| (: (group (+ (any "A-Z"))) "=" (group (* nonl))) + (: (? (group "-")) (group (+ (any "A-Z"))))) + eot) + section) (setq key (or (match-string 1 section) (match-string 4 section)) value (match-string 2 section) negated (and (match-string 3 section) '-)) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 930e8032f6d..b020c612b7d 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -101,6 +101,11 @@ erc--target (contents "" :type string) (tags '() :type list)) +(cl-defstruct erc--isupport-data + "Abstract \"class\" for parsed ISUPPORT data. +For use with the macro `erc--with-isupport-data'." + (key nil :type (or null cons))) + ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) "Return preferred SYMBOL for `erc--modules'." diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el index 51bdf305ad5..5751a32212d 100644 --- a/test/lisp/erc/erc-scenarios-display-message.el +++ b/test/lisp/erc/erc-scenarios-display-message.el @@ -59,6 +59,4 @@ erc-scenarios-display-message--multibuf (erc-cmd-QUIT ""))) -(eval-when-compile (require 'erc-join)) - ;;; erc-scenarios-display-message.el ends here commit cc7e008dce1df9d2472338b1fc3cc766166e9e55 Author: F. Jason Park Date: Fri Nov 17 13:26:00 2023 -0800 Add test for erc-cmd-SQUERY * lisp/erc/erc-backend.el (erc-message): Revise doc string. * test/lisp/erc/erc-scenarios-base-misc-regressions.el (erc-cmd-MOTD): Move test to another file specifically for slash commands. * test/lisp/erc/erc-scenarios-misc-commands.el: New file. * test/lisp/erc/resources/base/commands/motd.eld: Move file elsewhere. * test/lisp/erc/resources/commands/motd.eld: "New" file, moved here reusing the same Git blob from now deleted subdir base/commands. * test/lisp/erc/resources/commands/squery.eld: New file. (Bug#67209) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9281c107d06..66ac9057d75 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1284,8 +1284,10 @@ erc-server-send-queue nil #'erc-server-send-queue buffer))))))) (defun erc-message (message-command line &optional force) - "Send LINE to the server as a privmsg or a notice. -MESSAGE-COMMAND should be either \"PRIVMSG\" or \"NOTICE\". + "Send LINE, possibly expanding a target specifier beforehand. +Expect MESSAGE-COMMAND to be an IRC command with a single +positional target parameter followed by a trailing parameter. + If the target is \",\", the last person you've got a message from will be used. If the target is \".\", the last person you've sent a message to will be used." diff --git a/test/lisp/erc/erc-scenarios-base-misc-regressions.el b/test/lisp/erc/erc-scenarios-base-misc-regressions.el index 42d7653d3ec..85b2c03b6a4 100644 --- a/test/lisp/erc/erc-scenarios-base-misc-regressions.el +++ b/test/lisp/erc/erc-scenarios-base-misc-regressions.el @@ -124,48 +124,4 @@ erc-scenarios-base-channel-buffer-revival (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) (erc-d-t-search-for 10 "and be prosperous"))))) -;; This defends against a partial regression in which an /MOTD caused -;; 376 and 422 handlers in erc-networks to run. - -(ert-deftest erc-cmd-MOTD () - :tags '(:expensive-test) - (erc-scenarios-common-with-cleanup - ((erc-scenarios-common-dialog "base/commands") - (erc-server-flood-penalty 0.1) - (dumb-server (erc-d-run "localhost" t 'motd)) - (port (process-contact dumb-server :service)) - (expect (erc-d-t-make-expecter))) - - (ert-info ("Connect to server") - (with-current-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :full-name "tester") - (funcall expect 10 "This is the default Ergo MOTD") - (funcall expect 10 "debug mode"))) - - (ert-info ("Send plain MOTD") - (with-current-buffer "foonet" - (erc-cmd-MOTD) - (funcall expect -0.2 "Unexpected state detected") - (funcall expect 10 "This is the default Ergo MOTD"))) - - (ert-info ("Send MOTD with known target") - (with-current-buffer "foonet" - (erc-scenarios-common-say "/MOTD irc1.foonet.org") - (funcall expect -0.2 "Unexpected state detected") - (funcall expect 10 "This is the default Ergo MOTD"))) - - (ert-info ("Send MOTD with erroneous target") - (with-current-buffer "foonet" - (erc-scenarios-common-say "/MOTD fake.foonet.org") - (funcall expect -0.2 "Unexpected state detected") - (funcall expect 10 "No such server") - ;; Message may show up before the handler runs. - (erc-d-t-wait-for 10 - (not (local-variable-p 'erc-server-402-functions))) - (should-not (local-variable-p 'erc-server-376-functions)) - (should-not (local-variable-p 'erc-server-422-functions)) - (erc-cmd-QUIT ""))))) - ;;; erc-scenarios-base-misc-regressions.el ends here diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el b/test/lisp/erc/erc-scenarios-misc-commands.el new file mode 100644 index 00000000000..2a36d52b835 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-misc-commands.el @@ -0,0 +1,94 @@ +;;; erc-scenarios-misc-commands.el --- Misc commands for ERC -*- lexical-binding: t -*- + +;; Copyright (C) 2023 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-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +;; This defends against a partial regression in which an /MOTD caused +;; 376 and 422 handlers in erc-networks to run. + +(ert-deftest erc-scenarios-misc-commands--MOTD () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "commands") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'motd)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "This is the default Ergo MOTD") + (funcall expect 10 "debug mode"))) + + (ert-info ("Send plain MOTD") + (with-current-buffer "foonet" + (erc-cmd-MOTD) + (funcall expect -0.2 "Unexpected state detected") + (funcall expect 10 "This is the default Ergo MOTD"))) + + (ert-info ("Send MOTD with known target") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/MOTD irc1.foonet.org") + (funcall expect -0.2 "Unexpected state detected") + (funcall expect 10 "This is the default Ergo MOTD"))) + + (ert-info ("Send MOTD with erroneous target") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/MOTD fake.foonet.org") + (funcall expect -0.2 "Unexpected state detected") + (funcall expect 10 "No such server") + ;; Message may show up before the handler runs. + (erc-d-t-wait-for 10 + (not (local-variable-p 'erc-server-402-functions))) + (should-not (local-variable-p 'erc-server-376-functions)) + (should-not (local-variable-p 'erc-server-422-functions)) + (erc-cmd-QUIT ""))))) + + +(ert-deftest erc-scenarios-misc-commands--SQUERY () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "commands") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'squery)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "Your connection is secure"))) + + (ert-info ("Send SQUERY") + (with-current-buffer "IRCnet" + (erc-scenarios-common-say "/SQUERY alis help list") + (funcall expect -0.1 "Incorrect arguments") + (funcall expect 10 "See also: HELP EXAMPLES"))))) + +;;; erc-scenarios-misc-commands.el ends here diff --git a/test/lisp/erc/resources/base/commands/motd.eld b/test/lisp/erc/resources/commands/motd.eld similarity index 100% rename from test/lisp/erc/resources/base/commands/motd.eld rename to test/lisp/erc/resources/commands/motd.eld diff --git a/test/lisp/erc/resources/commands/squery.eld b/test/lisp/erc/resources/commands/squery.eld new file mode 100644 index 00000000000..bcd176e515b --- /dev/null +++ b/test/lisp/erc/resources/commands/squery.eld @@ -0,0 +1,31 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.07 ":ircnet.hostsailor.com 020 * :Please wait while we process your connection.") + (0.03 ":ircnet.hostsailor.com 001 tester :Welcome to the Internet Relay Network tester!~user@93.184.216.34") + (0.02 ":ircnet.hostsailor.com 002 tester :Your host is ircnet.hostsailor.com, running version 2.11.2p3+0PNv1.06") + (0.03 ":ircnet.hostsailor.com 003 tester :This server was created Thu May 20 2021 at 17:13:24 EDT") + (0.01 ":ircnet.hostsailor.com 004 tester ircnet.hostsailor.com 2.11.2p3+0PNv1.06 aoOirw abeiIklmnoOpqrRstv") + (0.00 ":ircnet.hostsailor.com 005 tester RFC2812 PREFIX=(ov)@+ CHANTYPES=#&!+ MODES=3 CHANLIMIT=#&!+:42 NICKLEN=15 TOPICLEN=255 KICKLEN=255 MAXLIST=beIR:64 CHANNELLEN=50 IDCHAN=!:5 CHANMODES=beIR,k,l,imnpstaqrzZ :are supported by this server") + (0.01 ":ircnet.hostsailor.com 005 tester PENALTY FNC EXCEPTS=e INVEX=I CASEMAPPING=ascii NETWORK=IRCnet :are supported by this server") + (0.01 ":ircnet.hostsailor.com 042 tester 0PNHANAWX :your unique ID") + (0.01 ":ircnet.hostsailor.com 251 tester :There are 18711 users and 2 services on 26 servers") + (0.01 ":ircnet.hostsailor.com 252 tester 63 :operators online") + (0.01 ":ircnet.hostsailor.com 253 tester 4 :unknown connections") + (0.01 ":ircnet.hostsailor.com 254 tester 10493 :channels formed") + (0.01 ":ircnet.hostsailor.com 255 tester :I have 933 users, 0 services and 1 servers") + (0.01 ":ircnet.hostsailor.com 265 tester 933 1328 :Current local users 933, max 1328") + (0.01 ":ircnet.hostsailor.com 266 tester 18711 25625 :Current global users 18711, max 25625") + (0.02 ":ircnet.hostsailor.com 375 tester :- ircnet.hostsailor.com Message of the Day - ") + (0.01 ":ircnet.hostsailor.com 372 tester :- 17/11/2023 3:08") + (0.02 ":ircnet.hostsailor.com 376 tester :End of MOTD command.")) + +((mode 10 "MODE tester +i") + (0.00 ":ircnet.hostsailor.com NOTICE tester :Your connection is secure (SSL/TLS).") + (0.01 ":tester MODE tester :+i")) + +((squery 10 "SQUERY alis :help list") + (0.08 ":Alis@hub.uk NOTICE tester :Searches for a channel") + (0.01 ":Alis@hub.uk NOTICE tester :/SQUERY Alis LIST mask [-options]") + (0.04 ":Alis@hub.uk NOTICE tester :[...]") + (0.01 ":Alis@hub.uk NOTICE tester :See also: HELP EXAMPLES")) commit 64174ae148d0d81f232d41ecaaa4de17692cf315 Author: Osmo Karppinen Date: Fri Nov 17 12:31:50 2023 +0200 Fix command-line parsing for erc-cmd-SQUERY * lisp/erc/erc.el (erc-cmd-SQUERY): Set symbol property `do-not-parse-args' to t so additional command-line arguments aren't parsed but rather included as part of the function's lone (raw) LINE parameter. (Bug#67209) Copyright-paperwork-exempt: yes diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index edcfcf085e6..2abbbaa3578 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4591,6 +4591,7 @@ erc-cmd-SQUERY The rest of LINE is the message to send." (erc-message "SQUERY" line)) +(put 'erc-cmd-SQUERY 'do-not-parse-args t) (defun erc-cmd-NICK (nick) "Change current nickname to NICK." commit da946ca6924b5ba1a1c785284406cf894aef12b5 Author: Yuan Fu Date: Sat Nov 18 11:01:08 2023 -0800 Add missing python-ts-mode keyword (bug#67015) * lisp/progmodes/python.el (python--treesit-keywords): Add "not in". diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d9ca37145e1..e17651d9275 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -969,7 +969,7 @@ python--treesit-keywords "raise" "return" "try" "while" "with" "yield" ;; These are technically operators, but we fontify them as ;; keywords. - "and" "in" "is" "not" "or")) + "and" "in" "is" "not" "or" "not in")) (defvar python--treesit-builtins '("abs" "all" "any" "ascii" "bin" "bool" "breakpoint" "bytearray" commit 0128495afded0f1bd153925f99c19290760c7d65 Author: Dmitry Gutov Date: Sat Nov 18 18:35:18 2023 +0200 Fix string-pixel-width with global setting of display-line-numbers * lisp/emacs-lisp/subr-x.el (string-pixel-width): Instead of checking for display-line-numbers-mode, set the display-line-numbers variable to nil (bug#67248). diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index b164071763b..88ac59fd168 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -322,10 +322,9 @@ string-pixel-width ;; Keeping a work buffer around is more efficient than creating a ;; new temporary buffer. (with-current-buffer (get-buffer-create " *string-pixel-width*") - ;; If `display-line-numbers-mode' is enabled in internal - ;; buffers, it breaks width calculation, so disable it (bug#59311) - (when (bound-and-true-p display-line-numbers-mode) - (display-line-numbers-mode -1)) + ;; If `display-line-numbers' is enabled in internal buffers + ;; (e.g. globally), it breaks width calculation (bug#59311) + (setq-local display-line-numbers nil) (delete-region (point-min) (point-max)) ;; Disable line-prefix and wrap-prefix, for the same reason. (setq line-prefix nil commit 80d0ff46127d797c081b54be24e167531ddcec07 Author: Michael Albinus Date: Sat Nov 18 14:39:16 2023 +0100 Minor Tramp optimization * lisp/net/tramp.el (tramp-skeleton-file-truename) (tramp-skeleton-write-region, tramp-handle-file-truename): * lisp/net/tramp-integration.el (tramp-eshell-directory-change) (tramp-recentf-exclude-predicate): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): Use `tramp-tramp-file-p' instead of `file-remote-p'. diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index c73c86a9110..f67d8a0ec2f 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -136,7 +136,7 @@ tramp-eshell-directory-change ;; Remove last element of `(exec-path)', which is `exec-directory'. ;; Use `path-separator' as it does eshell. (setq eshell-path-env - (if (file-remote-p default-directory) + (if (tramp-tramp-file-p default-directory) (string-join (butlast (exec-path)) path-separator) (getenv "PATH")))) @@ -158,7 +158,7 @@ tramp-eshell-directory-change (defun tramp-recentf-exclude-predicate (name) "Predicate to exclude a remote file name from recentf. NAME must be equal to `tramp-current-connection'." - (when (file-remote-p name) + (when (tramp-tramp-file-p name) (tramp-file-name-equal-p (tramp-dissect-file-name name) (car tramp-current-connection)))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index e0622a26eeb..87fbb93e810 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -618,7 +618,7 @@ tramp-smb-handle-copy-file ;; with `jka-compr-handler', so we cannot trust its result as ;; indication for a remote file name. (if-let ((tmpfile - (and (file-remote-p filename) (file-local-copy filename)))) + (and (tramp-tramp-file-p filename) (file-local-copy filename)))) ;; Remote filename. (condition-case err (rename-file tmpfile newname ok-if-already-exists) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 87685c06c1f..742b8128199 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -274,8 +274,8 @@ tramp-sudoedit-do-copy-or-rename-file (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) - (if (or (and (file-remote-p filename) (not t1)) - (and (file-remote-p newname) (not t2))) + (if (or (and (tramp-tramp-file-p filename) (not t1)) + (and (tramp-tramp-file-p newname) (not t2))) ;; We cannot copy or rename directly. (let ((tmpfile (tramp-compat-make-temp-file filename))) (if (eq op 'copy) @@ -296,7 +296,7 @@ tramp-sudoedit-do-copy-or-rename-file ;; When `newname' is local, we must change the ownership to ;; the local user. - (unless (file-remote-p newname) + (unless (tramp-tramp-file-p newname) (tramp-set-file-uid-gid (concat (file-remote-p filename) newname) (tramp-get-local-uid 'integer) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 54f92cae98d..a21e6823424 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3447,7 +3447,7 @@ tramp-skeleton-file-truename "Apparent cycle of symbolic links for %s" ,filename)) ;; If the resulting localname looks remote, we must quote ;; it for security reasons. - (when (file-remote-p result) + (when (tramp-tramp-file-p result) (setq result (file-name-quote result 'top))) result))))))) @@ -3587,7 +3587,7 @@ tramp-skeleton-write-region ;; Lock file. (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) + (tramp-tramp-file-p lockname) (not file-locked)) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. @@ -4117,7 +4117,7 @@ tramp-handle-file-truename (< numchase numchase-limit)) (setq numchase (1+ numchase) result - (if (file-remote-p symlink-target) + (if (tramp-tramp-file-p symlink-target) (file-name-quote symlink-target 'top) (tramp-drop-volume-letter (expand-file-name commit 1d0e3030ff228948477ee3ba6bd289476269a020 Merge: e5e35a2be6c d9e43f2197f Author: Eli Zaretskii Date: Sat Nov 18 06:07:48 2023 -0500 Merge from origin/emacs-29 d9e43f2197f Document changes in 'edmacro-parse-keys' 3327f36ad95 Add 2 SQLite extensions to allow-list. 8d2012024de * test/lisp/net/tramp-tests.el (tramp--test-timeout-handl... commit e5e35a2be6c96aac5bb292de46016ff457fae88a Merge: 6c367f0ad4b 7b0e07c41ae Author: Eli Zaretskii Date: Sat Nov 18 06:07:48 2023 -0500 ; Merge from origin/emacs-29 The following commit was skipped: 7b0e07c41ae Make Tramp aware of completion-regexp-list (don't merge) commit 6c367f0ad4bc77152b50644933b1169f0f62bd03 Merge: 703b9c8d24e 232a57a3e32 Author: Eli Zaretskii Date: Sat Nov 18 06:07:47 2023 -0500 Merge from origin/emacs-29 232a57a3e32 ; * doc/lispref/debugging.texi (Debugging): Add cross-ref... c65ddf26a33 ; doc/lispref/debugging.texi: Add reference to Profiler d... 6f884d3aed9 Add 5 docstrings to abbrev.el (bug#67153) b4d990bd637 ; Clarify wording about arguments in doc strings c20ae7a30fb ; Improve cross-references in description of 'pcase' 42181b65df1 ; * src/editfns.c (Fline_beginning_position): Doc fix. 5f3309f6b0f ; Improve indexing in ELisp manual 4e406bb4208 Fix CBZ file detection in doc-view-mode commit 703b9c8d24edd5dea3b997b068c45fcfb1adb99c Merge: 7ce68f0435e c1251ae1f93 Author: Eli Zaretskii Date: Sat Nov 18 06:07:47 2023 -0500 ; Merge from origin/emacs-29 The following commit was skipped: c1251ae1f93 * lisp/progmodes/eglot.el (eglot-server-programs): Fix pr... commit 7ce68f0435e530d5008c0c70a60fbdbddeb9429c Merge: 1eec562e118 5a1808da5f3 Author: Eli Zaretskii Date: Sat Nov 18 06:07:47 2023 -0500 Merge from origin/emacs-29 5a1808da5f3 ; * doc/misc/eglot.texi (Eglot Commands): Fix typos (bug#... commit 1eec562e118f562952df7ec6b4e99748d37441ea Merge: f99de40efc0 260ba357bbe Author: Eli Zaretskii Date: Sat Nov 18 06:07:47 2023 -0500 ; Merge from origin/emacs-29 The following commit was skipped: 260ba357bbe Eglot: Send standard :language-id for typescript-language... commit f99de40efc022da46bac3faf168ca2d23e41e286 Merge: 457b5e23fa1 32a32853ce9 Author: Eli Zaretskii Date: Sat Nov 18 06:07:47 2023 -0500 Merge from origin/emacs-29 32a32853ce9 Typofix in the doc/lispref/modes.texi f98637b51b5 ; Fix 'add-face-text-property' shortdoc 3fff22eb20c Fix spell-checking email message with citations commit 457b5e23fa1ec68b8c30a4a81e59a41ddc4d62d9 Merge: fe553611835 5bebd292c63 Author: Eli Zaretskii Date: Sat Nov 18 06:07:47 2023 -0500 ; Merge from origin/emacs-29 The following commit was skipped: 5bebd292c63 Pass only the local parts of Eshell's $PATH to 'tramp-rem... commit fe5536118351d7b53b75d69f09f8a6c3a64eeafb Merge: 9b0cb2185d7 5612fd21a05 Author: Eli Zaretskii Date: Sat Nov 18 06:07:46 2023 -0500 Merge from origin/emacs-29 5612fd21a05 Add two doc strings to cl-extra.el commit 9b0cb2185d73ed320d51dfbf0857d799b9d760e6 Author: Eli Zaretskii Date: Sat Nov 18 12:11:56 2023 +0200 ; * etc/NEWS: Fix last change (bug#67225). diff --git a/etc/NEWS b/etc/NEWS index 9f65d6fd4c0..12ae8058cb1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -233,12 +233,6 @@ to enter the file you want to modify. It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. -*** Additional 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 -"C-x 8 / E". - ** Emacs Server and Client --- @@ -340,6 +334,11 @@ functions in CJK locales. *** New input methods for the Urdu, Pashto, and Sindhi languages. These languages are spoken in Pakistan and Afganistan. +*** 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 +'C-x 8 / E'. + * Changes in Specialized Modes and Packages in Emacs 30.1 commit 41b837b41377754ef0ebddd5fcbbaaad7590a3c8 Author: Rudi Schlatte Date: Thu Nov 16 10:44:44 2023 +0100 Add key translations 'C-x 8 a e' and 'C-x 8 A E'. * lisp/international/iso-transl.el (iso-transl-char-map): Add new entries for ae and AE. (Bug#67225) diff --git a/etc/NEWS b/etc/NEWS index ba9c85ebc3c..9f65d6fd4c0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -233,6 +233,12 @@ to enter the file you want to modify. It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. +*** Additional 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 +"C-x 8 / E". + ** Emacs Server and Client --- diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index 459d1ff7f97..cd83d723ece 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -293,6 +293,8 @@ iso-transl-char-map ("a<" . [?←]) ("a>" . [?→]) ("a=" . [?↔]) + ("ae" . [?æ]) + ("AE" . [?Æ]) ("_-" . [?−]) ("~=" . [?≈]) ("/=" . [?≠]) commit d5799ce6667a2c6dc77b4c2e0456263a79970bb5 Author: Eli Zaretskii Date: Sat Nov 18 12:02:25 2023 +0200 ; Add commentary for exposing a mode hook to Custom * lisp/progmodes/elixir-ts-mode.el (elixir-ts-mode-hook): Add commentary about the reasons for exposing the hook to Custom, per the discussion in bug#67207. diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index ad7c599edb1..c687ed9d06b 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -74,6 +74,11 @@ elixir-ts-indent-offset :safe 'integerp :group 'elixir-ts) +;; 'define-derived-mode' doesn't expose the generated mode hook +;; variable to Custom, because we are not smart enough to provide the +;; ':options' for hook variables. Also, some packages modify hook +;; variables. The below is done because users of this mode explicitly +;; requested the hook to be customizable via Custom. (defcustom elixir-ts-mode-hook nil "Hook run after entering `elixir-ts-mode'." :type 'hook commit 09de967f6c3ca7cf1304acd9465496da3a6b435f Author: Wilhelm H Kirschbaum Date: Wed Nov 15 20:13:02 2023 +0200 Add elixir-ts-mode-hook to elixir-ts-mode * lisp/progmodes/elixir-ts-mode.el (elixir-ts-mode-hook): Make hook available to customize. (Bug#67207) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 05edb4159a1..ad7c599edb1 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -74,6 +74,13 @@ elixir-ts-indent-offset :safe 'integerp :group 'elixir-ts) +(defcustom elixir-ts-mode-hook nil + "Hook run after entering `elixir-ts-mode'." + :type 'hook + :options '(eglot-ensure) + :group 'elixir-ts + :version "30.1") + (defface elixir-ts-font-comment-doc-identifier-face '((t (:inherit font-lock-doc-face))) "Face used for @comment.doc tags in Elixir files.") commit d9e43f2197fa1d5ade1d483b15cc50c6d705b969 Author: Eli Zaretskii Date: Sat Nov 18 11:52:48 2023 +0200 Document changes in 'edmacro-parse-keys' * lisp/edmacro.el (edmacro-parse-keys): Add a comment for forcing output to be a vector. (read-kbd-macro): Adjust the doc string to changes in 'edmacro-parse-keys'. (Bug#67182) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 0b62bf262bc..535c50cee84 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -228,14 +228,14 @@ edit-named-kbd-macro ;;;###autoload (defun read-kbd-macro (start &optional end) "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." (interactive "r") (if (stringp start) @@ -672,6 +672,13 @@ edmacro-fix-menu-commands (defun edmacro-parse-keys (string &optional _need-vector) (let ((result (kbd string))) + ;; Always return a vector. Stefan Monnier + ;; writes: "I want to eliminate the use of strings that stand for a + ;; sequence of events because it does nothing more than leave latent + ;; bugs and create confusion (between the strings used as input to + ;; `read-kbd-macro' and the strings that used to be output by + ;; `read-kbd-macro'), while increasing the complexity of the rest of + ;; the code which has to handle both vectors and strings." (if (stringp result) (seq-into result 'vector) result))) commit 6aa70c236f8e0ca3ba18d94b706791b16ff6587b Author: Po Lu Date: Sat Nov 18 17:41:51 2023 +0800 Document Battery Optimization challenges on Android * etc/PROBLEMS (Runtime problems specific to Android): Mention battery optimization, the way it impacts background execution, and how it might be disabled. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index ebecf50d26b..72a6639c978 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3567,6 +3567,27 @@ port is a large undertaking that we are looking for volunteers to perform. If you are interested in taking responsibility for this task, please contact . +** Emacs can only execute spasmodically in the background. + +Recent Android releases impose "battery optimization" on programs for +which it is not expressly disabled; such optimization inhibits the +execution of background services outside brief windows of time +distributed at intervals of several dozens of minutes. Such programs +as ERC which must send "keep-alive" packets at a rate beyond that at +which these windows arrive consequently lose, yielding connection +timeouts after Emacs has been in the background long enough that +battery optimization enters into effect. + +This optimization can be disabled through the Settings app: navigate +to "Apps & notifications", "Emacs", "Battery", "Battery Optimization", +before clicking the drop-down menu labeled "Not Optimized", selecting +the option "All Apps", scrolling to "Emacs", clicking on its entry and +selecting "Don't Optimize" in the dialog box thus displayed. + +The organization of the Settings app might disagree with that +illustrated above, which if true you should consult the documentation +or any search mechanism for it. + * Build-time problems ** Configuration commit 7b7a37ec7bbfc64f88b261dd170330b4860cdf64 Author: Eli Zaretskii Date: Sat Nov 18 11:35:15 2023 +0200 ; * etc/NEWS: Add entry about new input methods. (Bug#66470) diff --git a/etc/NEWS b/etc/NEWS index eebada2db49..ba9c85ebc3c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -330,6 +330,10 @@ or narrow (if the variable is customized to the nil value). This setting affects the results of 'string-width' and similar functions in CJK locales. +--- +*** New input methods for the Urdu, Pashto, and Sindhi languages. +These languages are spoken in Pakistan and Afganistan. + * Changes in Specialized Modes and Packages in Emacs 30.1 commit 84e4bc6219af2c08097027d4b75043b23c1fcce6 Author: Rahguzar Date: Sun Oct 29 17:14:02 2023 +0100 Add input methods for Urdu, Pashto and Sindhi (bug#66470) * lisp/leim/quail/pakistan.el ("urdu-keyboard") ("urdu-phonetic-keyboard", "urdu-custom", "sindhi-keyboard") ("pashto-keyboard"): New input methods. (pakistan--define-quail-rules, pakistan--make-setter) (pakistan--regenerate-translations, pakistan--set-prefixes) (pakistan--define-numeral-translations) (pakistan--set-numeral-translations): Internal helper functions. (pakistan-urdu-input): New customization group. (pakistan-urdu-prefixes, pakistan-urdu-translations) (pakistan-urdu-diacritics-and-other-symbols) (pakistan-urdu-poetic-symbols, pakistan-urdu-religious-symbols) (pakistan-extra-balochi-brahui-translations) (pakistan-extra-pashto-translations) (pakistan-extra-sindhi-translations) (pakistan-extra-saraiki-hindko-translations) (pakistan-urdu-use-roman-digits): New custom variables. (pakistan): New package. diff --git a/lisp/leim/quail/pakistan.el b/lisp/leim/quail/pakistan.el new file mode 100644 index 00000000000..ff9257722e0 --- /dev/null +++ b/lisp/leim/quail/pakistan.el @@ -0,0 +1,726 @@ +;;; pakistan.el --- Input methods for some languages from Pakistan -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Rahguzar +;; Keywords: convenience, multilingual, input method, Urdu, Balochi, Pashto, Sindhi, Hindko, Brahui +;; +;; 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: +;; Provides a semi-phonetic input method for Urdu +;; +;;; Code: +(require 'quail) + +;;;; Urdu Input Methods +;;;;; Keyboard +;; Layout taken from https://www.branah.com/urdu +(quail-define-package + "urdu-keyboard" "Urdu" "ات" t + "Input method for Urdu. +Uses keyboard layout from https://www.branah.com/urdu" + nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("q" ?ط) + ("w" ?ص) + ("e" ?ھ) + ("r" ?د) + ("t" ?ٹ) + ("y" ?پ) + ("u" ?ت) + ("i" ?ب) + ("o" ?ج) + ("p" ?ح) + ("a" ?م) + ("s" ?و) + ("d" ?ر) + ("f" ?ن) + ("g" ?ل) + ("h" ?ہ) + ("j" ?ا) + ("k" ?ک) + ("l" ?ی) + ("z" ?ق) + ("x" ?ف) + ("c" ?ے) + ("v" ?س) + ("b" ?ش) + ("n" ?غ) + ("m" ?ع) + ("Q" ?ظ) + ("W" ?ض) + ("E" ?ذ) + ("R" ?ڈ) + ("T" ?ث) + ("Y" ?ّ) + ("U" ?ۃ) + ("I" ?ـ) + ("O" ?چ) + ("P" ?خ) + ("A" ?ژ) + ("S" ?ز) + ("D" ?ڑ) + ("F" ?ں) + ("G" ?ۂ) + ("H" ?ء) + ("J" ?آ) + ("K" ?گ) + ("L" ?ي) + ("C" ?ۓ) + ("B" ?ؤ) + ("N" ?ئ) + ("[" ?\]) + ("]" ?\[) + ("{" ?}) + ("}" ?{) + (";" ?؛) + ("." ?۔) + ("," ?،) + ("?" ?؟)) + +;;;;; Phonetic Keyboard +(quail-define-package + "urdu-phonetic-keyboard" "Urdu" "اص" t + "Input method for Urdu. +Uses phonetic keyboard layout from https://www.branah.com/urdu" + nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("q" ?ق) + ("w" ?و) + ("e" ?ع) + ("r" ?ر) + ("t" ?ت) + ("y" ?ے) + ("u" ?ء) + ("i" ?ی) + ("o" ?ہ) + ("p" ?پ) + ("a" ?ا) + ("s" ?س) + ("d" ?د) + ("f" ?ف) + ("g" ?گ) + ("h" ?ح) + ("j" ?ج) + ("k" ?ک) + ("l" ?ل) + ("z" ?ز) + ("x" ?ش) + ("c" ?چ) + ("v" ?ط) + ("b" ?ب) + ("n" ?ن) + ("m" ?م) + ("Q" ?ْ) + ("W" ?ٔ) + ("E" ?ٰ) + ("R" ?ڑ) + ("T" ?ٹ) + ("Y" ?َ) + ("U" ?ئ) + ("I" ?ِ) + ("O" ?ۃ) + ("P" ?ُ) + ("A" ?آ) + ("S" ?ص) + ("D" ?ڈ) + ("F" ?أ) + ("G" ?غ) + ("H" ?ھ) + ("J" ?ض) + ("K" ?خ) + ("L" ?ٖ) + ("Z" ?ذ) + ("X" ?ژ) + ("C" ?ث) + ("V" ?ظ) + ("B" ?ً) + ("N" ?ں) + ("M" ?ّ) + ("1" ?۱) + ("2" ?۲) + ("3" ?۳) + ("4" ?۴) + ("5" ?۵) + ("6" ?٦) + ("7" ?۷) + ("8" ?۸) + ("9" ?۹) + ("0" ?۰) + ("`" ?؏) + ("#" ?ؔ) + ("$" ?ؒ) + ("%" ?٪) + ("^" ?ؓ) + ("&" ?ؑ) + ("*" ?ؐ) + ("(" ?\)) + (")" ?\() + ("=" ?+) + (";" ?؛) + ("\\" ?÷) + ("|" ?x) + ("," ?،) + ("." ?۔) + ("<" ?ٗ) + (">" ?.) + ("?" ?؟) + ("[" ?﷽) + ("]" ?ﷲ) + ("{" ?ﷺ)) + +;;;;; Customizable Input Method +;;;;;; Variable declarations +;; We define these variables now so that byte-compiler does not complain. +;; Later they will be changed to custom variables. Their value must be void +;; here as otherwise cutsom will not initialize them to their standard value. +(defvar pakistan-urdu-prefixes) +(defvar pakistan-urdu-translations) +(defvar pakistan-urdu-diacritics-and-other-symbols) +(defvar pakistan-urdu-poetic-symbols) +(defvar pakistan-urdu-religious-symbols) +(defvar pakistan-urdu-use-roman-digits) +(defvar pakistan-extra-balochi-brahui-translations) +(defvar pakistan-extra-pashto-translations) +(defvar pakistan-extra-saraiki-hindko-translations) +(defvar pakistan-extra-sindhi-translations) + +;;;;;; Helper functions +(defun pakistan--define-quail-rules (rules &optional prefix package) + "Define translations for `urdu-custom' input method as determined by RULES. +PACKAGE determines the input method and defaults to `urdu-custom'. RULES is +the list of rules to define, see `quail-defrule' for details. If non-nil +PREFIX is a string that is prefixed to each string in RULES. PREFIX can be a +symbol in which case it is looked up in `pakistan-urdu-prefixes' to obtain the +string." + (setq package (or package "urdu-custom")) + (when (and prefix (symbolp prefix)) + (setq prefix (car (alist-get prefix pakistan-urdu-prefixes)))) + (dolist (rule rules) + (quail-defrule (concat prefix (car rule)) (cadr rule) package))) + +(defun pakistan--define-numeral-translations (&optional package) + "Define translations to translate digits to arabic digits. +Translations are for PACKAGE which defaults to `urdu-custom'." + (pakistan--define-quail-rules + '(("0" ?۰) + ("1" ?۱) + ("2" ?۲) + ("3" ?۳) + ("4" ?۴) + ("5" ?۵) + ("6" ?۶) + ("7" ?۷) + ("8" ?۸) + ("9" ?۹) + ("%" ?٪)) + nil package)) + +(defun pakistan--set-numeral-translations (var val) + "VAR should be `pakistan-urdu-use-roman-digits' and VAL its value. +This is a setter function for the custom-variable." + (set-default-toplevel-value var val) + (if val + (pakistan--regenerate-translations) + (pakistan--define-numeral-translations))) + +(defun pakistan--regenerate-translations () + "Regenerate the translations for urdu-custom input method." + (quail-select-package "urdu-custom") + (quail-install-map (list nil)) + (pakistan--define-quail-rules pakistan-urdu-translations) + (unless pakistan-urdu-use-roman-digits + (pakistan--define-numeral-translations)) + (pakistan--define-quail-rules + pakistan-urdu-diacritics-and-other-symbols 'diacritics) + (pakistan--define-quail-rules pakistan-urdu-poetic-symbols 'poetic) + (pakistan--define-quail-rules pakistan-urdu-religious-symbols 'religious) + (pakistan--define-quail-rules + pakistan-extra-balochi-brahui-translations 'balochi-brahui) + (pakistan--define-quail-rules pakistan-extra-pashto-translations 'pashto) + (pakistan--define-quail-rules + pakistan-extra-saraiki-hindko-translations 'saraiki-hindko) + (pakistan--define-quail-rules pakistan-extra-sindhi-translations 'sindhi)) + +(defun pakistan--set-prefixes (var val) + "VAR should be `pakistan-urdu-prefixes' and VAL is the value to be set. +Setter function for `pakistan-urdu-prefixes'." + (set-default-toplevel-value var val) + (when (boundp 'pakistan-urdu-use-roman-digits) + (pakistan--regenerate-translations))) + +(defun pakistan--make-setter (&optional prefix) + "Return the setter function. +The function adds rules to `urdu-custom' with PREFIX." + (lambda (var val) + (set-default-toplevel-value var val) + (if (boundp 'pakistan-urdu-use-roman-digits) + (pakistan--regenerate-translations) + (pakistan--define-quail-rules val prefix)))) + +;;;;;; Package definition +(quail-define-package + "urdu-custom" "Urdu" "اا" t + "Intuitive and customizable transl input method for Urdu. +By default this input method doesn't try to follow the common romanization of +Urdu very closely. The reason for this is allow to for input efficiency. It +works as follows: + +1) All lower case letters on QWERTY keyboard are translated to an urdu +character. When more than one Urdu letter corresponds to the same Roman +letter, the most common Urdu letter has been chosen. The frequency analysis +was done on the basis of Urdu word list at +https://github.com/urduhack/urdu-words/blob/master/words.txt As a result some +of the translations are: +h → ہ +s → س , c → ص +z → ز + +2) For the next common letter the uppercase English letter is used, e.g. +r → ر , R → ڑ +n → ن , N → ں + +3) The letter x is used for postfix completions. There are two subcases: +3a) When more than two urdu letter map to the same roman letter, +e.g. +t → ت, T → ٹ , tx → ط , Tx → ۃ +h → ہ , H → ھ , hx → ح , Hx → ۂ +s → س , c → ص , sx → ش , S → ث , cx → چ +z → ز , Z → ض, zx → ذ , Zx → ظ +3b) The urdu letters that are commonly romanized by a English letter + h +can be obtained by the same English letter + x i.e. +gx → غ , cx → چ, kx → خ , sx → ش + +4) Y → ژ is somewhat of an abberation. All four of z, Z, zx and Zx are +used by more common letters. Y is used for ژ because it is sometimes +pronounced close to Y for some European languages. + +These translations can be changed by customizing `pakistan-urdu-translations'. + +5) o is used for prefix completion of diacrtics or اعر۱ب as well as some +poetic and religious symbols. The most common three diacritics are mapped to +oa → zabr (a for above) +ob → zer (b for below) +oo → pesh (o for the circle in pesh) + +6) The poetic symbols are also available under G (for غزل), while religious +symbols are also available under M (for مزہب). + +7) Characters from Balochi, Brahui Pashto, Saraiki and Sindhi which are not +part of Urdu alphabet can also be input. Each set of these sets correspond to +a different prefixes. See `pakistan-urdu-prefixes' for the prefixes. + +The translations and the prefixes described above can be customized. Various +customization options can be found under the customization group +`pakistan-urdu-input'." + nil t t t t nil nil nil nil nil t) + +;;;;;; Customizations +(defgroup pakistan-urdu-input nil + "Customization group for Urdu input methods." + :group 'quail) + +(defcustom pakistan-urdu-prefixes + '((diacritics "o") + (poetic "G") + (religious "M") + (balochi-brahui "B") + (pashto "P") + (sindhi "C") + (saraiki-hindko "X")) + "Prefixes for `urdu-custom' input method." + :set #'pakistan--set-prefixes + :type '(repeat (list symbol string)) + :version "30.1") + +(defcustom pakistan-urdu-translations + '(("a" ?ا) + ("y" ?ی) + ("r" ?ر) + ("n" ?ن) + ("v" ?و) + ("m" ?م) + ("t" ?ت) + ("l" ?ل) + ("k" ?ک) + ("b" ?ب) + ("d" ?د) + ("h" ?ہ) + ("s" ?س) + ("H" ?ھ) + ("p" ?پ) + ("N" ?ں) + ("g" ?گ) + ("sx" ?ش) + ("j" ?ج) + ("T" ?ٹ) + ("f" ?ف) + ("cx" ?چ) + ("z" ?ز) + ("u" ?ع) + ("q" ?ق) + ("kx" ?خ) + ("e" ?ے) + ("E" ?ۓ) + ("hx" ?ح) + ("i" ?ئ) + ("R" ?ڑ) + ("tx" ?ط) + ("c" ?ص) + ("D" ?ڈ) + ("gx" ?غ) + ("A" ?آ) + ("Z" ?ض) + ("V" ?ؤ) + ("zx" ?ذ) + ("S" ?ث) + ("Zx" ?ظ) + ("Hx" ?ۂ) + ("ix" ?ء) + ("Tx" ?ۃ) + ("Y" ?ژ) + ("ax" ?أ) + ("." ?۔) + ("," ?،) + (";" ?؛) + ("?" ?؟)) + "Translations for Urdu characters and common punctuations." + :set (pakistan--make-setter) + :type '(repeat (list string character)) + :version "30.1") + +(defcustom pakistan-urdu-diacritics-and-other-symbols + '(("a" ?َ) ;; zabar زبر + ("b" ?ِ) ;; zer زير + ("o" ?ُ) ;; pesh پيش + ("j" ?ْ) ;; jazam جزم + ("S" ?ّ) ;; tashdid تشدید + ("k" ?ٰ) ;; khari zabar کھڑی زبر + ("u" ?٘) ;; ulti jazm الٹی جزم + ("s" ?؎) + ("m" ?؏) + ("t" ?ؔ) + ("c" ?ؐ) + ("r" ?ؒ) + ("R" ?ؓ) + ("A" ?ؑ)) + "Translations to input Urdu diacrtics. +These are available under the prefix specified in `pakistan-urdu-prefixes'." + :set (pakistan--make-setter 'diacritics) + :type '(repeat (list string character)) + :version "30.1") + +(defcustom pakistan-urdu-poetic-symbols + '(("s" ?؎) + ("m" ?؏) + ("t" ?ؔ)) + "Translation to input Urdu peotic symbols. +These are available under the prefix specified in `pakistan-urdu-prefixes'." + :set (pakistan--make-setter 'poetic) + :type '(repeat (list string character)) + :version "30.1") + +(defcustom pakistan-urdu-religious-symbols + '(("s" ?ؐ) + ("r" ?ؒ) + ("R" ?ؓ) + ("a" ?ؑ) + ("A" ?ﷲ) + ("S" ?ﷺ)) + "Translation to input Urdu peotic symbols. +These are available under the prefix specified in `pakistan-urdu-prefixes'." + :set (pakistan--make-setter 'religious) + :type '(repeat (list string character)) + :version "30.1") + +;; I don't understand how many of these letters are pronounced. +;; So better translations are welcome. +(defcustom pakistan-extra-balochi-brahui-translations + '(("v" ?ۏ) + ("y" ?ݔ) +;; Brahui + ("l" ?ڷ)) + "Translations to input Balochi and Brahui letters not found in Urdu. +These are available under the prefix specified in `pakistan-urdu-prefixes'." + :set (pakistan--make-setter 'balochi-brahui) + :type '(repeat (list string character)) + :version "30.1") + +(defcustom pakistan-extra-pashto-translations + '(("t" ?ټ) + ("d" ?ډ) + ("r" ?ړ) + ("n" ?ڼ) + ("s" ?ښ) + ("R" ?ږ) + ("h" ?څ) + ("H" ?ځ)) + "Translations to input Pashto letters not found in Urdu. +These are available under the prefix specified in `pakistan-urdu-prefixes'." + :set (pakistan--make-setter 'pashto) + :type '(repeat (list string character)) + :version "30.1") + +(defcustom pakistan-extra-sindhi-translations + '(("k" ?ڪ) + ("j" ?ڄ) + ("t" ?ٺ) + ("T" ?ٽ) + ("tx" ?ٿ) + ("b" ?ٻ) + ("B" ?ڀ) + ("r" ?ڙ) + ("d" ?ڌ) + ("D" ?ڏ) + ("dx" ?ڊ) + ("Dx" ?ڍ) + ("h" ?ڃ) + ("c" ?ڇ) + ("p" ?ڦ) + ("n" ?ڻ) + ("g" ?ڳ) + ("G" ?ڱ)) + "Translations to input Sindhi letters not found in Urdu. +These are available under the prefix specified in `pakistan-urdu-prefixes'." + :set (pakistan--make-setter 'sindhi) + :type '(repeat (list string character)) + :version "30.1") + +(defcustom pakistan-extra-saraiki-hindko-translations + '(("b" ?ٻ) + ("h" ?ڄ) + ("g" ?ڳ) + ("d" ?ݙ) + ("n" ?ݨ) +;; Hindko + ("r" ?ݬ) + ("v" ?ڨ) + ("N" ?ݩ) + ("V" ?ٷ)) +"Translations to input Saraiki letters not found in Urdu. +These are available under the prefix specified in `pakistan-urdu-prefixes'." + :set (pakistan--make-setter 'saraiki-hindko) + :type '(repeat (list string character)) + :version "30.1") + +(defcustom pakistan-urdu-use-roman-digits + nil + "Whether urdu-custom input method should use roman digits." + :set #'pakistan--set-numeral-translations + :type 'boolean + :version "30.1") + +;;;; Sindhi Input Methods +;;;;; Keyboard +;; Layout taken from https://www.branah.com/sindhi +(quail-define-package + "sindhi-keyboard" "Sindhi" "سِ" t + "Input method for Sindhi. +Uses keyboard layout from https://www.branah.com/sindhi ." + nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("q" ?ق) + ("w" ?ص) + ("e" ?ي) + ("r" ?ر) + ("t" ?ت) + ("y" ?ٿ) + ("u" ?ع) + ("i" ?ڳ) + ("o" ?و) + ("p" ?پ) + ("a" ?ا) + ("s" ?س) + ("d" ?د) + ("f" ?ف) + ("g" ?گ) + ("h" ?ه) + ("j" ?ج) + ("k" ?ڪ) + ("l" ?ل) + ("z" ?ز) + ("x" ?خ) + ("c" ?ط) + ("v" ?ڀ) + ("b" ?ب) + ("n" ?ن) + ("m" ?م) + ("Q" ?َ) + ("W" ?ض) + ("E" ?ِ) + ("R" ?ڙ) + ("T" ?ٽ) + ("Y" ?ث) + ("U" ?غ) + ("I" ?ھ) + ("O" ?ُ) + ("P" ?ڦ) + ("A" ?آ) + ("S" ?ش) + ("D" ?ڊ) + ("F" ?ڦ) + ("G" ?ً) + ("H" ?ح) + ("J" ?ٍ) + ("K" ?ۡ) + ("L" ?:) + ("Z" ?ذ) + ("X" ?ّ) + ("C" ?ظ) + ("V" ?ء) + ("B" ?ٻ) + ("N" ?ڻ) + ("M" ?۾) + ("1" ?۱) + ("2" ?۲) + ("3" ?۳) + ("4" ?۴) + ("5" ?۵) + ("6" ?٦) + ("7" ?۷) + ("8" ?۸) + ("9" ?۹) + ("0" ?۰) + ("`" ?’) + ("-" ?ڏ) + ("=" ?ڌ) + ("~" ?‘) + ("@" ?ى) + ("#" ?ؔ) + ("$" ?ؒ) + ("%" ?٪) + ("^" ?ؓ) + ("&" ?۽) + ("*" ?ؤ) + ("(" ?\)) + (")" ?\() + ("[" ?ڇ) + ("]" ?چ) + ("{" ?ڃ) + ("}" ?ڄ) + (";" ?ک) + ("'" ?ڱ) + ("\\" ?ڍ) + (":" ?؛) + ("|" ?ٺ) + ("," ?،) + ("/" ?ئ) + ("<" ?“) + (">" ?”) + ("?" ?؟)) + + +;;;; Pashto Input Methods +;;;;; Keyboard +(quail-define-package + "pashto-keyboard" "Pashto" "پ" t + "Input method for Pashto. +Uses keyboard layout from https://www.branah.com/pashto ." + nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("q" ?ض) + ("w" ?ص) + ("e" ?ث) + ("r" ?ق) + ("t" ?ف) + ("y" ?غ) + ("u" ?ع) + ("i" ?ه) + ("o" ?خ) + ("p" ?ح) + ("a" ?ش) + ("s" ?س) + ("d" ?ی) + ("f" ?ب) + ("g" ?ل) + ("h" ?ا) + ("j" ?ت) + ("k" ?ن) + ("l" ?م) + ("z" ?ۍ) + ("x" ?ې) + ("c" ?ز) + ("v" ?ر) + ("b" ?ذ) + ("n" ?د) + ("m" ?ړ) + ("Q" ?ْ) + ("W" ?ٌ) + ("E" ?ٍ) + ("R" ?ً) + ("T" ?ُ) + ("Y" ?ِ) + ("U" ?َ) + ("I" ?ّ) + ("O" ?څ) + ("P" ?ځ) + ("A" ?ښ) + ("S" ?ﺉ) + ("D" ?ي) + ("F" ?پ) + ("G" ?أ) + ("H" ?آ) + ("J" ?ټ) + ("K" ?ڼ) + ("L" ?ة) + ("Z" ?ظ) + ("X" ?ط) + ("C" ?ژ) + ("V" ?ء) + ("B" ?‌) + ("N" ?ډ) + ("M" ?ؤ) + ("1" ?۱) + ("2" ?۲) + ("3" ?۳) + ("4" ?۴) + ("5" ?۵) + ("6" ?۶) + ("7" ?۷) + ("8" ?۸) + ("9" ?۹) + ("0" ?۰) + ("`" ?‍) + ("~" ?÷) + ("@" ?٬) + ("#" ?٫) + ("%" ?٪) + ("^" ?×) + ("&" ?«) + ("*" ?») + ("_" ?ـ) + ("[" ?ج) + ("]" ?چ) + ("{" ?\[) + ("}" ?\]) + (";" ?ک) + ("'" ?ګ) + ("\"" ?؛) + ("|" ?٭) + ("," ?و) + ("." ?ږ) + ("<" ?،) + (">" ?.) + ("?" ?؟)) + +;;; End Matter +(provide 'pakistan) +;;; pakistan.el ends here commit 3327f36ad95fdfc6b8639dd77b42f4bf8cf81e65 Author: Eli Zaretskii Date: Sat Nov 18 11:11:04 2023 +0200 Add 2 SQLite extensions to allow-list. * src/sqlite.c (Fsqlite_load_extension): Add 2 Free Software extensions to the allow-list. For the details, see https://lists.gnu.org/archive/html/emacs-devel/2023-11/msg00234.html. diff --git a/src/sqlite.c b/src/sqlite.c index fd528f2b0d5..7135cc672bc 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -716,7 +716,9 @@ DEFUN ("sqlite-load-extension", Fsqlite_load_extension, "rtree", "sha1", "uuid", + "vector0", "vfslog", + "vss0", "zipfile", NULL }; commit 1c70458519b324c9403e8a9f57bd695fe39e8d2c Author: Visuwesh Date: Sun Oct 29 20:21:57 2023 +0530 Do interactive tagging for dired commands * lisp/dired-aux.el (dired-diff, dired-backup-diff) (dired-compare-directories, dired-do-chmod, dired-do-chgrp) (dired-do-chown, dired-do-touch, dired-do-print, dired-clean-directory) (dired-do-async-shell-command, dired-do-shell-command, dired-kill-line) (dired-do-kill-lines, dired-do-compress-to, dired-do-compress) (dired-do-byte-compile, dired-do-load, dired-do-redisplay) (dired-reset-subdir-switches, dired-create-directory) (dired-create-empty-file, dired-do-copy, dired-do-symlink) (dired-do-relsymlink, dired-do-hardlink, dired-do-rename) (dired-do-rename-regexp, dired-do-copy-regexp, dired-do-hardlink-regexp) (dired-do-symlink-regexp, dired-do-relsymlink-regexp, dired-upcase) (dired-downcase, dired-maybe-insert-subdir, dired-insert-subdir) (dired-kill-tree, dired-prev-subdir, dired-mark-subdir-files) (dired-kill-subdir, dired-tree-up, dired-tree-down, dired-hide-subdir) (dired-hide-all, dired-isearch-filenames, dired-isearch-filenames-regexp) (dired-do-isearch, dired-do-isearch-regexp, dired-do-search) (dired-do-query-replace-regexp, dired-do-find-regexp) (dired-do-find-regexp-and-replace, dired-show-file-type) (dired-vc-next-action): * lisp/dired-x.el (dired-mark-extension, dired-mark-suffix) (dired-flag-extension, dired-clean-patch, dired-clean-tex) (dired-very-clean-tex, dired-mark-omitted, dired-omit-expunge) (dired-mark-unmarked-files, dired-do-find-marked-files, dired-vm) (dired-rmail, dired-do-run-mail, dired-mark-sexp, dired-x-bind-find-file): * lisp/dired.el (dired-mouse-drag, dired-undo, dired-toggle-read-only) (dired-next-line, dired-previous-line, dired-next-dirline) (dired-prev-dirline, dired-up-directory, dired-get-file-for-visit) (dired-find-file, dired-find-alternate-file, dired-mouse-find-file) (dired-mouse-find-file-other-window, dired-mouse-find-file-other-frame) (dired-view-file, dired-find-file-other-window, dired-display-file) (dired-copy-filename-as-kill, dired-next-subdir) (dired-build-subdir-alist, dired-goto-file, dired-do-flagged-delete) (dired-do-delete, dired-next-marked-file, dired-prev-marked-file) (dired-mark, dired-unmark, dired-flag-file-deletion) (dired-unmark-backward, dired-toggle-marks, dired-mark-files-regexp) (dired-number-of-marked-files, dired-mark-files-containing-regexp) (dired-flag-files-regexp, dired-mark-symlinks, dired-mark-directories) (dired-mark-executables, dired-flag-auto-save-files) (dired-flag-garbage-files, dired-flag-backup-files, dired-change-marks) (dired-unmark-all-marks, dired-unmark-all-files) (dired-sort-toggle-or-edit, dired-mark-for-click) (dired-enable-click-to-select-mode): Tag commands as applicable only for dired-mode. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index e0bcae6b005..02194e6ff45 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -264,7 +264,8 @@ dired-diff (read-string "Options for diff: " (if (stringp diff-switches) diff-switches - (mapconcat #'identity diff-switches " "))))))) + (mapconcat #'identity diff-switches " ")))))) + dired-mode) (let ((current (dired-get-filename t))) (when (or (equal (expand-file-name file) (expand-file-name current)) @@ -290,7 +291,8 @@ dired-backup-diff (if (stringp diff-switches) diff-switches (mapconcat #'identity diff-switches " ")))) - nil)) + nil) + dired-mode) (diff-backup (dired-get-filename) switches)) ;;;###autoload @@ -336,7 +338,8 @@ dired-compare-directories (read-directory-name (format "Compare %s with: " (dired-current-directory)) target-dir target-dir t))) - (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil"))) + (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil")) + dired-mode) (let* ((dir1 (dired-current-directory)) (file-alist1 (dired-files-attributes dir1)) (file-alist2 (dired-files-attributes dir2)) @@ -497,7 +500,7 @@ dired-do-chmod Note that on MS-Windows only the `w' (write) bit is meaningful: resetting it makes the file read-only. Changing any other bit has no effect on MS-Windows." - (interactive "P") + (interactive "P" dired-mode) (let* ((files (dired-get-marked-files t arg nil nil t)) ;; The source of default file attributes is the file at point. (default-file (dired-get-filename t t)) @@ -541,7 +544,7 @@ dired-do-chgrp Type \\\\[next-history-element] \ to pull the file attributes of the file at point into the minibuffer." - (interactive "P") + (interactive "P" dired-mode) (if (and (memq system-type '(ms-dos windows-nt)) (not (file-remote-p default-directory))) (error "chgrp not supported on this system")) @@ -553,7 +556,7 @@ dired-do-chown Type \\\\[next-history-element] \ to pull the file attributes of the file at point into the minibuffer." - (interactive "P") + (interactive "P" dired-mode) (if (and (memq system-type '(ms-dos windows-nt)) (not (file-remote-p default-directory))) (error "chown not supported on this system")) @@ -566,7 +569,7 @@ dired-do-touch Type Type \\\\[next-history-element] \ to pull the file attributes of the file at point into the minibuffer." - (interactive "P") + (interactive "P" dired-mode) (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg)) ;; Process all the files in FILES in batches of a convenient size, @@ -618,7 +621,7 @@ dired-do-print "Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default." - (interactive "P") + (interactive "P" dired-mode) (require 'lpr) (let* ((file-list (dired-get-marked-files t arg nil nil t)) (lpr-switches @@ -674,7 +677,7 @@ dired-clean-directory To clear the flags on these files, you can use \\[dired-flag-backup-files] with a prefix argument." - (interactive "P") + (interactive "P" dired-mode) (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions)) (let ((early-retention (if (< keep 0) (- keep) kept-old-versions)) (late-retention (if (<= keep 0) dired-kept-versions keep)) @@ -828,7 +831,8 @@ dired-do-async-shell-command ;; Want to give feedback whether this file or marked files are used: (dired-read-shell-command "& on %s: " current-prefix-arg files) current-prefix-arg - files))) + files)) + dired-mode) (unless (string-match-p "&[ \t]*\\'" command) (setq command (concat command " &"))) (dired-do-shell-command command arg file-list)) @@ -895,7 +899,8 @@ dired-do-shell-command ;; Want to give feedback whether this file or marked files are used: (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg - files))) + files)) + dired-mode) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) (confirmations nil) @@ -1342,7 +1347,7 @@ dired-kill-line "Kill the current line (not the files). With a prefix argument, kill that many lines starting with the current line. (A negative argument kills backward.)" - (interactive "P") + (interactive "P" dired-mode) (setq arg (prefix-numeric-value arg)) (let (buffer-read-only file) (while (/= 0 arg) @@ -1383,7 +1388,7 @@ dired-do-kill-lines A FMT of \"\" will suppress the messaging." ;; Returns count of killed lines. - (interactive "P") + (interactive "P" dired-mode) (if arg (if (dired-get-subdir) (dired-kill-subdir) @@ -1520,7 +1525,7 @@ dired-do-compress-to Prompt for the archive file name. Choose the archiving command based on the archive file-name extension and `dired-compress-files-alist'." - (interactive) + (interactive nil dired-mode) (let* ((in-files (dired-get-marked-files nil nil nil nil t)) (out-file (expand-file-name (read-file-name "Compress to: "))) (rule (cl-find-if @@ -1758,7 +1763,7 @@ dired-do-compress into a .tar.gz archive. If invoked on a .tar.gz or a .tgz or a .zip or a .7z archive, uncompress and unpack all the files in the archive." - (interactive "P") + (interactive "P" dired-mode) (dired-map-over-marks-check #'dired-compress arg 'compress t)) @@ -1787,7 +1792,7 @@ dired-byte-compile ;;;###autoload (defun dired-do-byte-compile (&optional arg) "Byte compile marked (or next ARG) Emacs Lisp files." - (interactive "P") + (interactive "P" dired-mode) (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t)) (defun dired-load () @@ -1804,7 +1809,7 @@ dired-load ;;;###autoload (defun dired-do-load (&optional arg) "Load the marked (or next ARG) Emacs Lisp files." - (interactive "P") + (interactive "P" dired-mode) (dired-map-over-marks-check #'dired-load arg 'load t)) ;;;###autoload @@ -1821,7 +1826,7 @@ dired-do-redisplay \\\\[dired-reset-subdir-switches]. See Info node `(emacs)Subdir switches' for more details." ;; Moves point if the next ARG files are redisplayed. - (interactive "P\np") + (interactive "P\np" dired-mode) (if (and test-for-subdir (dired-get-subdir)) (let* ((dir (dired-get-subdir)) (switches (cdr (assoc-string dir dired-switches-alist)))) @@ -1851,7 +1856,7 @@ dired-do-redisplay (defun dired-reset-subdir-switches () "Set `dired-switches-alist' to nil and revert Dired buffer." - (interactive) + (interactive nil dired-mode) (setq dired-switches-alist nil) (revert-buffer)) @@ -2691,7 +2696,8 @@ dired-create-directory Parent directories of DIRECTORY are created as needed. If DIRECTORY already exists, signal an error." (interactive - (list (read-file-name "Create directory: " (dired-current-directory)))) + (list (read-file-name "Create directory: " (dired-current-directory))) + dired-mode) (let* ((expanded (directory-file-name (expand-file-name directory))) new) (if (file-exists-p expanded) @@ -2708,7 +2714,7 @@ dired-create-empty-file Add a new entry for the new file in the Dired buffer. Parent directories of FILE are created as needed. If FILE already exists, signal an error." - (interactive (list (read-file-name "Create empty file: "))) + (interactive (list (read-file-name "Create empty file: ")) dired-mode) (let* ((expanded (expand-file-name file)) new) (if (file-exists-p expanded) @@ -2771,7 +2777,7 @@ dired-do-copy `dired-copy-dereference' will be used. Also see `dired-do-revert-buffer'." - (interactive "P") + (interactive "P" dired-mode) (let ((dired-recursive-copies dired-recursive-copies) (dired-copy-dereference (if (equal arg '(4)) (not dired-copy-dereference) @@ -2794,7 +2800,7 @@ dired-do-symlink For relative symlinks, use \\[dired-do-relsymlink]. Also see `dired-do-revert-buffer'." - (interactive "P") + (interactive "P" dired-mode) (dired-do-create-files 'symlink #'make-symbolic-link "Symlink" arg dired-keep-marker-symlink)) @@ -2811,7 +2817,7 @@ dired-do-relsymlink foo -> /ugly/file/name/that/may/change/any/day/bar/foo For absolute symlinks, use \\[dired-do-symlink]." - (interactive "P") + (interactive "P" dired-mode) (dired-do-create-files 'relsymlink #'dired-make-relative-symlink "RelSymLink" arg dired-keep-marker-relsymlink)) @@ -2876,7 +2882,7 @@ dired-do-hardlink `dired-dwim-target', which see. Also see `dired-do-revert-buffer'." - (interactive "P") + (interactive "P" dired-mode) (dired-do-create-files 'hardlink #'dired-hardlink "Hardlink" arg dired-keep-marker-hardlink)) @@ -2897,7 +2903,7 @@ dired-do-rename of `dired-dwim-target', which see. Also see `dired-do-revert-buffer'." - (interactive "P") + (interactive "P" dired-mode) (when (seq-find (lambda (file) (member (file-name-nondirectory file) '("." ".."))) (dired-get-marked-files nil arg)) @@ -2996,7 +3002,7 @@ dired-do-rename-regexp With a zero prefix arg, renaming by regexp affects the absolute file name. Normally, only the non-directory part of the file name is used and changed." - (interactive (dired-mark-read-regexp "Rename")) + (interactive (dired-mark-read-regexp "Rename") dired-mode) (dired-do-create-files-regexp #'dired-rename-file "Rename" arg regexp newname whole-name dired-keep-marker-rename)) @@ -3005,7 +3011,7 @@ dired-do-rename-regexp (defun dired-do-copy-regexp (regexp newname &optional arg whole-name) "Copy selected files whose names match REGEXP to NEWNAME. See function `dired-do-rename-regexp' for more info." - (interactive (dired-mark-read-regexp "Copy")) + (interactive (dired-mark-read-regexp "Copy") dired-mode) (let ((dired-recursive-copies nil)) ; No recursive copies. (dired-do-create-files-regexp #'dired-copy-file @@ -3016,7 +3022,7 @@ dired-do-copy-regexp (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-name) "Hardlink selected files whose names match REGEXP to NEWNAME. See function `dired-do-rename-regexp' for more info." - (interactive (dired-mark-read-regexp "HardLink")) + (interactive (dired-mark-read-regexp "HardLink") dired-mode) (dired-do-create-files-regexp #'add-name-to-file "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink)) @@ -3025,7 +3031,7 @@ dired-do-hardlink-regexp (defun dired-do-symlink-regexp (regexp newname &optional arg whole-name) "Symlink selected files whose names match REGEXP to NEWNAME. See function `dired-do-rename-regexp' for more info." - (interactive (dired-mark-read-regexp "SymLink")) + (interactive (dired-mark-read-regexp "SymLink") dired-mode) (dired-do-create-files-regexp #'make-symbolic-link "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) @@ -3035,7 +3041,7 @@ dired-do-relsymlink-regexp "RelSymlink all marked files containing REGEXP to NEWNAME. See functions `dired-do-rename-regexp' and `dired-do-relsymlink' for more info." - (interactive (dired-mark-read-regexp "RelSymLink")) + (interactive (dired-mark-read-regexp "RelSymLink") dired-mode) (dired-do-create-files-regexp #'dired-make-relative-symlink "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) @@ -3080,13 +3086,13 @@ dired-rename-non-directory ;;;###autoload (defun dired-upcase (&optional arg) "Rename all marked (or next ARG) files to upper case." - (interactive "P") + (interactive "P" dired-mode) (dired-rename-non-directory #'upcase "Rename upcase" arg)) ;;;###autoload (defun dired-downcase (&optional arg) "Rename all marked (or next ARG) files to lower case." - (interactive "P") + (interactive "P" dired-mode) (dired-rename-non-directory #'downcase "Rename downcase" arg)) @@ -3114,7 +3120,8 @@ dired-maybe-insert-subdir (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " - (or dired-subdir-switches dired-actual-switches))))) + (or dired-subdir-switches dired-actual-switches)))) + dired-mode) (let ((opoint (point))) ;; We don't need a marker for opoint as the subdir is always ;; inserted *after* opoint. @@ -3146,7 +3153,8 @@ dired-insert-subdir (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " - (or dired-subdir-switches dired-actual-switches))))) + (or dired-subdir-switches dired-actual-switches)))) + dired-mode) (setq dirname (file-name-as-directory (expand-file-name dirname))) (or no-error-if-not-dir-p (file-directory-p dirname) @@ -3223,7 +3231,7 @@ dired-kill-tree When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." - (interactive "DKill tree below directory: \ni\nP") + (interactive "DKill tree below directory: \ni\nP" dired-mode) (setq dirname (file-name-as-directory (expand-file-name dirname))) (let ((s-alist dired-subdir-alist) dir m-alist) (while s-alist @@ -3377,7 +3385,8 @@ dired-prev-subdir (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) ;; if on subdir start already, don't stay there! - (if (dired-get-subdir) 1 0)))) + (if (dired-get-subdir) 1 0))) + dired-mode) (dired-next-subdir (- arg) no-error-if-not-found no-skip)) ;;;###autoload @@ -3410,7 +3419,7 @@ dired-mark-subdir-files "Mark all files except `.' and `..' in current subdirectory. If the Dired buffer shows multiple directories, this command marks the files listed in the subdirectory that point is in." - (interactive) + (interactive nil dired-mode) (let ((p-min (dired-subdir-min))) (dired-mark-files-in-region p-min (dired-subdir-max)))) @@ -3419,7 +3428,7 @@ dired-kill-subdir "Remove all lines of current subdirectory. Lower levels are unaffected." ;; With optional REMEMBER-MARKS, return a mark-alist. - (interactive) + (interactive nil dired-mode) (let* ((beg (dired-subdir-min)) (end (dired-subdir-max)) (modflag (buffer-modified-p)) @@ -3446,7 +3455,7 @@ dired-unsubdir ;;;###autoload (defun dired-tree-up (arg) "Go up ARG levels in the Dired tree." - (interactive "p") + (interactive "p" dired-mode) (let ((dir (dired-current-directory))) (while (>= arg 1) (setq arg (1- arg) @@ -3458,7 +3467,7 @@ dired-tree-up ;;;###autoload (defun dired-tree-down () "Go down in the Dired tree." - (interactive) + (interactive nil dired-mode) (let ((dir (dired-current-directory)) ; has slash pos case-fold-search) ; filenames are case sensitive (let ((rest (reverse dired-subdir-alist)) elt) @@ -3480,7 +3489,7 @@ dired-hide-subdir "Hide or unhide the current subdirectory and move to next directory. Optional prefix arg is a repeat factor. Use \\[dired-hide-all] to (un)hide all directories." - (interactive "p") + (interactive "p" dired-mode) (with-silent-modifications (while (>= (setq arg (1- arg)) 0) (let* ((cur-dir (dired-current-directory)) @@ -3501,7 +3510,7 @@ dired-hide-all "Hide all subdirectories, leaving only their header lines. If there is already something hidden, make everything visible again. Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." - (interactive "P") + (interactive "P" dired-mode) (with-silent-modifications (if (text-property-any (point-min) (point-max) 'invisible 'dired) (dired--unhide (point-min) (point-max)) @@ -3577,14 +3586,14 @@ dired-isearch-search-filenames ;;;###autoload (defun dired-isearch-filenames () "Search for a string using Isearch only in file names in the Dired buffer." - (interactive) + (interactive nil dired-mode) (setq-local dired-isearch-filenames t) (isearch-forward nil t)) ;;;###autoload (defun dired-isearch-filenames-regexp () "Search for a regexp using Isearch only in file names in the Dired buffer." - (interactive) + (interactive nil dired-mode) (setq-local dired-isearch-filenames t) (isearch-forward-regexp nil t)) @@ -3594,7 +3603,7 @@ dired-isearch-filenames-regexp ;;;###autoload (defun dired-do-isearch () "Search for a string through all marked files using Isearch." - (interactive) + (interactive nil dired-mode) (multi-isearch-files (prog1 (dired-get-marked-files nil nil #'dired-nondirectory-p nil t) @@ -3603,7 +3612,7 @@ dired-do-isearch ;;;###autoload (defun dired-do-isearch-regexp () "Search for a regexp through all marked files using Isearch." - (interactive) + (interactive nil dired-mode) (prog1 (multi-isearch-files-regexp (dired-get-marked-files nil nil 'dired-nondirectory-p nil t)) @@ -3619,7 +3628,7 @@ dired-do-search Stops when a match is found. To continue searching for next match, use command \\[fileloop-continue]." - (interactive "sSearch marked files (regexp): ") + (interactive "sSearch marked files (regexp): " dired-mode) (fileloop-initialize-search regexp (dired-get-marked-files nil nil #'dired-nondirectory-p) @@ -3642,7 +3651,8 @@ dired-do-query-replace-regexp (let ((common (query-replace-read-args "Query replace regexp in marked files" t t))) - (list (nth 0 common) (nth 1 common) (nth 2 common)))) + (list (nth 0 common) (nth 1 common) (nth 2 common))) + dired-mode) (dolist (file (dired-get-marked-files nil nil #'dired-nondirectory-p nil t)) (let ((buffer (get-file-buffer file))) (if (and buffer (with-current-buffer buffer @@ -3686,7 +3696,7 @@ dired-do-find-regexp directories. REGEXP should use constructs supported by your local `grep' command." - (interactive "sSearch marked files (regexp): ") + (interactive "sSearch marked files (regexp): " dired-mode) (require 'grep) (require 'xref) (defvar grep-find-ignored-files) @@ -3741,7 +3751,8 @@ dired-do-find-regexp-and-replace (let ((common (query-replace-read-args "Query replace regexp in marked files" t t))) - (list (nth 0 common) (nth 1 common)))) + (list (nth 0 common) (nth 1 common))) + dired-mode) (require 'xref) (defvar xref-show-xrefs-function) (defvar xref-auto-jump-to-first-xref) @@ -3763,7 +3774,7 @@ dired-show-file-type If you give a prefix argument \\[universal-argument] to this command, and FILE is a symbolic link, then the command will print the type of the target of the link instead." - (interactive (list (dired-get-filename t) current-prefix-arg)) + (interactive (list (dired-get-filename t) current-prefix-arg) dired-mode) (let (process-file-side-effects) (with-temp-buffer (if deref-symlinks @@ -3796,7 +3807,7 @@ dired-vc-next-action marked in the original Dired buffer. If the current directory doesn't belong to a VCS repository, prompt for a repository directory. In this case, the VERBOSE argument is ignored." - (interactive "P") + (interactive "P" dired-mode) (let* ((marked-files (dired-get-marked-files nil nil nil nil t)) (mark-files diff --git a/lisp/dired-x.el b/lisp/dired-x.el index b7824fa81bd..04b3c783084 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -299,7 +299,7 @@ dired-mark-extension Interactively, ask for EXTENSION. Prefixed with one \\[universal-argument], unmark files instead. Prefixed with two \\[universal-argument]'s, prompt for MARKER-CHAR and mark files with it." - (interactive (dired--mark-suffix-interactive-spec)) + (interactive (dired--mark-suffix-interactive-spec) dired-mode) (setq extension (ensure-list extension)) (dired-mark-files-regexp (concat ".";; don't match names with nothing but an extension @@ -323,7 +323,7 @@ dired-mark-suffix Interactively, ask for SUFFIX. Prefixed with one \\[universal-argument], unmark files instead. Prefixed with two \\[universal-argument]'s, prompt for MARKER-CHAR and mark files with it." - (interactive (dired--mark-suffix-interactive-spec)) + (interactive (dired--mark-suffix-interactive-spec) dired-mode) (setq suffix (ensure-list suffix)) (dired-mark-files-regexp (concat ".";; don't match names with nothing but an extension @@ -335,7 +335,7 @@ dired-mark-suffix (defun dired-flag-extension (extension) "In Dired, flag all files with a certain EXTENSION for deletion. A `.' is *not* automatically prepended to the string entered." - (interactive "sFlagging extension: ") + (interactive "sFlagging extension: " dired-mode) (dired-mark-extension extension dired-del-marker)) ;; Define some unpopular file extensions. Used for cleaning and omitting. @@ -364,7 +364,7 @@ dired-texinfo-unclean-extensions (defun dired-clean-patch () "Flag dispensable files created by patch for deletion. See variable `dired-patch-unclean-extensions'." - (interactive) + (interactive nil dired-mode) (dired-flag-extension dired-patch-unclean-extensions)) (defun dired-clean-tex () @@ -372,7 +372,7 @@ dired-clean-tex See variables `dired-tex-unclean-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and `dired-texinfo-unclean-extensions'." - (interactive) + (interactive nil dired-mode) (dired-flag-extension (append dired-texinfo-unclean-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions @@ -383,7 +383,7 @@ dired-very-clean-tex See variables `dired-texinfo-unclean-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and `dired-texinfo-unclean-extensions'." - (interactive) + (interactive nil dired-mode) (dired-flag-extension (append dired-texinfo-unclean-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions @@ -419,7 +419,7 @@ dired-omit-startup (defun dired-mark-omitted () "Mark files matching `dired-omit-files' and `dired-omit-extensions'." - (interactive) + (interactive nil dired-mode) (let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp (dired-omit-case-fold-p (if (stringp dired-directory) @@ -455,7 +455,7 @@ dired-omit-expunge Optional arg INIT-COUNT is an initial count tha'is added to the number of lines omitted by this invocation of `dired-omit-expunge', in the status message." - (interactive "sOmit files (regexp): \nP") + (interactive "sOmit files (regexp): \nP" dired-mode) ;; Bind `dired-marker-char' to `dired-omit-marker-char', ;; then call `dired-do-kill-lines'. (if (and dired-omit-mode @@ -531,7 +531,8 @@ dired-mark-unmarked-files (list (read-regexp (format-prompt "Mark unmarked files matching regexp" "all") nil 'dired-regexp-history) - nil current-prefix-arg nil)) + nil current-prefix-arg nil) + dired-mode) (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if (and @@ -736,7 +737,7 @@ dired-do-find-marked-files To keep Dired buffer displayed, type \\[split-window-below] first. To display just marked files, type \\[delete-other-windows] first." - (interactive "P") + (interactive "P" dired-mode) (dired-simultaneous-find-file (dired-get-marked-files nil nil nil nil t) noselect)) @@ -780,7 +781,7 @@ dired-vm "Run VM on this file. With optional prefix argument, visits the folder read-only. Otherwise obeys the value of `dired-vm-read-only-folders'." - (interactive "P") + (interactive "P" dired-mode) (let ((dir (dired-current-directory)) (fil (dired-get-filename))) (vm-visit-folder fil (or read-only @@ -792,7 +793,7 @@ dired-vm (defun dired-rmail () "Run RMAIL on this file." - (interactive) + (interactive nil dired-mode) (rmail (dired-get-filename))) (defun dired-do-run-mail () @@ -800,7 +801,7 @@ dired-do-run-mail Prompt for confirmation first; if the user says yes, call `dired-vm' if `dired-bind-vm' is non-nil, `dired-rmail' otherwise." - (interactive) + (interactive nil dired-mode) (let ((file (dired-get-filename t))) (if dired-bind-vm (if (y-or-n-p (format-message @@ -886,7 +887,8 @@ dired-mark-sexp (if current-prefix-arg "UNmark" "Mark"))) - current-prefix-arg)) + current-prefix-arg) + dired-mode) (message "%s" predicate) (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)) inode s mode nlink uid gid size time name sym) @@ -1012,7 +1014,7 @@ dired-x-bind-find-file "Bind `dired-x-find-file' in place of `find-file' (or vice-versa). Similarly for `dired-x-find-file-other-window' and `find-file-other-window'. Binding direction based on `dired-x-hands-off-my-keys'." - (interactive) + (interactive nil) (if (called-interactively-p 'interactive) (setq dired-x-hands-off-my-keys (not (y-or-n-p (format-message diff --git a/lisp/dired.el b/lisp/dired.el index 8919d2c223f..583cb2475e2 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1823,7 +1823,7 @@ dired-mouse-drag "Begin a drag-and-drop operation for the file at EVENT. If there are marked files and that file is marked, drag every other marked file as well. Otherwise, unmark all files." - (interactive "e") + (interactive "e" dired-mode) (when mark-active (deactivate-mark)) (let* ((modifiers (event-modifiers event)) @@ -2662,7 +2662,7 @@ dired-undo "Undo in a Dired buffer. This doesn't recover lost files, it just undoes changes in the buffer itself. You can use it to recover marks, killed lines or subdirs." - (interactive) + (interactive nil dired-mode) (let ((inhibit-read-only t)) (undo)) (dired-build-subdir-alist) @@ -2674,7 +2674,7 @@ dired-toggle-read-only If the current buffer can be edited with Wdired, (i.e. the major mode is `dired-mode'), call `wdired-change-to-wdired-mode'. Otherwise, toggle `read-only-mode'." - (interactive) + (interactive nil dired-mode) (unless (file-exists-p default-directory) (user-error "The current directory no longer exists")) (when (and (not (file-writable-p default-directory)) @@ -2703,7 +2703,7 @@ dired-next-line Whether to skip empty lines and how to move from last line is controlled by `dired-movement-style'." - (interactive "^p") + (interactive "^p" dired-mode) (if dired-movement-style (let ((old-position (progn ;; It's always true that we should move @@ -2750,12 +2750,12 @@ dired-previous-line Whether to skip empty lines and how to move from first line is controlled by `dired-movement-style'." - (interactive "^p") + (interactive "^p" dired-mode) (dired-next-line (- (or arg 1)))) (defun dired-next-dirline (arg &optional opoint) "Goto ARGth next directory file line." - (interactive "p") + (interactive "p" dired-mode) (or opoint (setq opoint (point))) (if (if (> arg 0) (re-search-forward dired-re-dir nil t arg) @@ -2767,7 +2767,7 @@ dired-next-dirline (defun dired-prev-dirline (arg) "Goto ARGth previous directory file line." - (interactive "p") + (interactive "p" dired-mode) (dired-next-dirline (- arg))) (defun dired-up-directory (&optional other-window) @@ -2776,7 +2776,7 @@ dired-up-directory Creates a buffer if necessary. If OTHER-WINDOW (the optional prefix arg), display the parent directory in another window." - (interactive "P") + (interactive "P" dired-mode) (let* ((dir (dired-current-directory)) (up (file-name-directory (directory-file-name dir)))) (or (dired-goto-file (directory-file-name dir)) @@ -2791,7 +2791,7 @@ dired-up-directory (defun dired-get-file-for-visit () "Get the current line's file name, with an error if file does not exist." - (interactive) + (interactive nil dired-mode) ;; We pass t for second arg so that we don't get error for `.' and `..'. (let ((raw (dired-get-filename nil t)) file-name) @@ -2811,7 +2811,7 @@ 'dired-advertised-find-file #'dired-find-file "23.2") (defun dired-find-file () "In Dired, visit the file or directory named on this line." - (interactive) + (interactive nil dired-mode) (dired--find-possibly-alternative-file (dired-get-file-for-visit))) (defun dired--find-possibly-alternative-file (file) @@ -2843,7 +2843,7 @@ dired--find-file (defun dired-find-alternate-file () "In Dired, visit file or directory on current line via `find-alternate-file'. This kills the Dired buffer, then visits the current line's file or directory." - (interactive) + (interactive nil dired-mode) (set-buffer-modified-p nil) (find-alternate-file (dired-get-file-for-visit))) ;; Don't override the setting from .emacs. @@ -2857,7 +2857,7 @@ dired-mouse-find-file respectively. If `dired-kill-when-opening-new-dired-buffer' is non-nil, FIND-DIR-FUNC defaults to `find-alternate-file' instead, so that the original Dired buffer is not kept." - (interactive "e") + (interactive "e" dired-mode) (or find-file-func (setq find-file-func 'find-file)) (let (window pos file) (save-excursion @@ -2885,19 +2885,19 @@ dired-mouse-find-file (defun dired-mouse-find-file-other-window (event) "In Dired, visit the file or directory name you click on in another window." - (interactive "e") + (interactive "e" dired-mode) (dired-mouse-find-file event 'find-file-other-window 'dired-other-window)) (defun dired-mouse-find-file-other-frame (event) "In Dired, visit the file or directory name you click on in another frame." - (interactive "e") + (interactive "e" dired-mode) (dired-mouse-find-file event 'find-file-other-frame 'dired-other-frame)) (defun dired-view-file () "In Dired, examine a file in view mode, returning to Dired when done. When file is a directory, show it in this buffer if it is inserted. Otherwise, display it in another buffer." - (interactive) + (interactive nil dired-mode) (let ((file (dired-get-file-for-visit))) (if (file-directory-p file) (or (and (cdr dired-subdir-alist) @@ -2907,12 +2907,12 @@ dired-view-file (defun dired-find-file-other-window () "In Dired, visit this file or directory in another window." - (interactive) + (interactive nil dired-mode) (dired--find-file #'find-file-other-window (dired-get-file-for-visit))) (defun dired-display-file () "In Dired, display this file or directory in another window." - (interactive) + (interactive nil dired-mode) (display-buffer (find-file-noselect (dired-get-file-for-visit)) t)) @@ -3249,7 +3249,7 @@ dired-copy-filename-as-kill prefix arg and marked files are ignored in this case. You can then feed the file name(s) to other commands with \\[yank]." - (interactive "P") + (interactive "P" dired-mode) (let* ((files (or (ensure-list (dired-get-subdir)) (if arg @@ -3435,7 +3435,7 @@ dired-next-subdir ;; Use 0 arg to go to this directory's header line. ;; NO-SKIP prevents moving to end of header line, returning whatever ;; position was found in dired-subdir-alist. - (interactive "p") + (interactive "p" dired-mode) (let ((this-dir (dired-current-directory)) pos index) ;; nth with negative arg does not return nil but the first element @@ -3456,7 +3456,7 @@ dired-build-subdir-alist Returns the new value of the alist. If optional arg SWITCHES is non-nil, use its value instead of `dired-actual-switches'." - (interactive) + (interactive nil dired-mode) (dired-clear-alist) (save-excursion (let* ((count 0) @@ -3560,7 +3560,8 @@ dired-goto-file (list (expand-file-name (read-file-name "Goto file: " (dired-current-directory)))) - (push-mark))) + (push-mark)) + dired-mode) (unless (file-name-absolute-p file) (error "File name `%s' is not absolute" file)) (setq file (directory-file-name file)) ; does no harm if not a directory @@ -3759,7 +3760,7 @@ dired-do-flagged-delete if there are no flagged files. `dired-recursive-deletes' controls whether deletion of non-empty directories is allowed." - (interactive) + (interactive nil dired-mode) (let* ((dired-marker-char dired-del-marker) (regexp (dired-marker-regexp)) case-fold-search markers) @@ -3789,7 +3790,7 @@ dired-do-delete non-empty directories is allowed." ;; This is more consistent with the file marking feature than ;; dired-do-flagged-delete. - (interactive "P") + (interactive "P" dired-mode) (let (markers) (dired-internal-do-deletions (nreverse @@ -4093,7 +4094,7 @@ dired-next-marked-file Optional argument OPOINT specifies the buffer position to return to if no ARGth marked file is found; it defaults to the position where this command was invoked." - (interactive "p\np") + (interactive "p\np" dired-mode) (or opoint (setq opoint (point)));; return to where interactively started (if (if (> arg 0) (re-search-forward dired-re-mark nil t arg) @@ -4114,7 +4115,7 @@ dired-prev-marked-file If WRAP is non-nil, which happens interactively, wrap around to the end of the buffer and search backwards from there, if no ARGth marked file is found before this line." - (interactive "p\np") + (interactive "p\np" dired-mode) (dired-next-marked-file (- arg) wrap)) (defun dired-file-marker (file) @@ -4153,7 +4154,7 @@ dired-mark Use \\[dired-unmark-all-files] to remove all marks and \\[dired-unmark] on a subdir to remove the marks in this subdir." - (interactive (list current-prefix-arg t)) + (interactive (list current-prefix-arg t) dired-mode) (cond ;; Mark files in the active region. ((and interactive dired-mark-region @@ -4192,7 +4193,7 @@ dired-unmark If looking at a subdir, unmark all its files except `.' and `..'. If the region is active in Transient Mark mode, unmark all files in the active region." - (interactive (list current-prefix-arg t)) + (interactive (list current-prefix-arg t) dired-mode) (let ((dired-marker-char ?\s)) (dired-mark arg interactive))) @@ -4204,7 +4205,7 @@ dired-flag-file-deletion If on a subdir headerline, flag all its files except `.' and `..'. If the region is active in Transient Mark mode, flag all files in the active region." - (interactive (list current-prefix-arg t)) + (interactive (list current-prefix-arg t) dired-mode) (let ((dired-marker-char dired-del-marker)) (dired-mark arg interactive))) @@ -4214,7 +4215,7 @@ dired-unmark-backward is one line. If the region is active in Transient Mark mode, unmark all files in the active region." - (interactive "p") + (interactive "p" dired-mode) (dired-unmark (- arg) t)) (defun dired-toggle-marks () @@ -4226,7 +4227,7 @@ dired-toggle-marks In Transient Mark mode, if the mark is active, operate on the contents of the region if `dired-mark-region' is non-nil. Otherwise, operate on the whole buffer." - (interactive) + (interactive nil dired-mode) (save-excursion (let ((inhibit-read-only t) (beg (dired-mark--region-beginning)) @@ -4277,7 +4278,8 @@ dired-mark-files-regexp (dired-get-filename nil t) t)) "\\'")))) 'dired-regexp-history) - (if current-prefix-arg ?\s))) + (if current-prefix-arg ?\s)) + dired-mode) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if (and (not (looking-at-p dired-re-dot)) @@ -4288,7 +4290,7 @@ dired-mark-files-regexp (defun dired-number-of-marked-files () "Display the number and total size of the marked files." - (interactive) + (interactive nil dired-mode) (let* ((files (dired-get-marked-files nil nil nil t)) (nmarked (cond ((null (cdr files)) @@ -4327,7 +4329,8 @@ dired-mark-files-containing-regexp (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark") " files containing (regexp): ") nil 'dired-regexp-history) - (if current-prefix-arg ?\s))) + (if current-prefix-arg ?\s)) + dired-mode) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if (and (not (looking-at-p dired-re-dot)) @@ -4356,7 +4359,8 @@ dired-flag-files-regexp and `$' to anchor matches. Exclude subdirs by hiding them. `.' and `..' are never flagged." (interactive (list (read-regexp "Flag for deletion (regexp): " - nil 'dired-regexp-history))) + nil 'dired-regexp-history)) + dired-mode) (dired-mark-files-regexp regexp dired-del-marker)) (defun dired-mark-symlinks (unflag-p) @@ -4364,7 +4368,7 @@ dired-mark-symlinks With prefix argument, unmark or unflag all those files. If the region is active in Transient Mark mode, mark files only in the active region if `dired-mark-region' is non-nil." - (interactive "P") + (interactive "P" dired-mode) (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if (looking-at-p dired-re-sym) "symbolic link"))) @@ -4373,7 +4377,7 @@ dired-mark-directories With prefix argument, unmark or unflag all those files. If the region is active in Transient Mark mode, mark files only in the active region if `dired-mark-region' is non-nil." - (interactive "P") + (interactive "P" dired-mode) (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if (and (looking-at-p dired-re-dir) (not (looking-at-p dired-re-dot))) @@ -4384,7 +4388,7 @@ dired-mark-executables With prefix argument, unmark or unflag all those files. If the region is active in Transient Mark mode, mark files only in the active region if `dired-mark-region' is non-nil." - (interactive "P") + (interactive "P" dired-mode) (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if (looking-at-p dired-re-exe) "executable file"))) @@ -4396,7 +4400,7 @@ dired-flag-auto-save-files A prefix argument says to unmark or unflag those files instead. If the region is active in Transient Mark mode, flag files only in the active region if `dired-mark-region' is non-nil." - (interactive "P") + (interactive "P" dired-mode) (let ((dired-marker-char (if unflag-p ?\s dired-del-marker))) (dired-mark-if ;; It is less than general to check for # here, @@ -4430,7 +4434,7 @@ dired-garbage-files-regexp (defun dired-flag-garbage-files () "Flag for deletion all files that match `dired-garbage-files-regexp'." - (interactive) + (interactive nil dired-mode) (dired-flag-files-regexp dired-garbage-files-regexp)) (defun dired-flag-backup-files (&optional unflag-p) @@ -4438,7 +4442,7 @@ dired-flag-backup-files With prefix argument, unmark or unflag these files. If the region is active in Transient Mark mode, flag files only in the active region if `dired-mark-region' is non-nil." - (interactive "P") + (interactive "P" dired-mode) (let ((dired-marker-char (if unflag-p ?\s dired-del-marker))) (dired-mark-if ;; Don't call backup-file-name-p unless the last character looks like @@ -4466,7 +4470,8 @@ dired-change-marks (old (progn (message "Change (old mark): ") (read-char))) (new (progn (message "Change %c marks to (new mark): " old) (read-char)))) - (list old new))) + (list old new)) + dired-mode) (dolist (c (list new old)) (if (or (not (char-displayable-p c)) (eq c ?\r)) @@ -4485,7 +4490,7 @@ dired-change-marks (defun dired-unmark-all-marks () "Remove all marks from all files in the Dired buffer." - (interactive) + (interactive nil dired-mode) (dired-unmark-all-files ?\r)) ;; Bound in dired-unmark-all-files @@ -4497,7 +4502,7 @@ dired-unmark-all-files or type RET to remove all marks. With prefix arg, query for each marked file. Type \\[help-command] at that time for help." - (interactive "cRemove marks (RET means all): \nP") + (interactive "cRemove marks (RET means all): \nP" dired-mode) (save-excursion (let* ((count 0) (inhibit-read-only t) case-fold-search @@ -4674,7 +4679,7 @@ dired-sort-set-mode-line (defun dired-sort-toggle-or-edit (&optional arg) "Toggle sorting by date, and refresh the Dired buffer. With a prefix argument, edit the current listing switches instead." - (interactive "P") + (interactive "P" dired-mode) (when dired-sort-inhibit (error "Cannot sort this Dired buffer")) (if arg @@ -5044,7 +5049,7 @@ dired-click-to-select-map (defun dired-mark-for-click (event) "Mark or unmark the file underneath the mouse click at EVENT. See `dired-click-to-select-mode' for more details." - (interactive "e") + (interactive "e" dired-mode) (let ((posn (event-start event)) (inhibit-read-only t)) (with-selected-window (posn-window posn) @@ -5067,7 +5072,7 @@ dired-enable-click-to-select-mode "Enable `dired-click-to-select-mode' and mark the file under EVENT. If there is no file under EVENT, call `touch-screen-hold' with EVENT instead." - (interactive "e") + (interactive "e" dired-mode) (let* ((posn (event-start event)) (window (posn-window posn)) (point (posn-point posn))) commit bb64e3a7985c5473f7b15ebcfe5f6b87d2237d92 Author: Eli Zaretskii Date: Sat Nov 18 10:13:37 2023 +0200 Avoid loading cl-lib as result of invoking 'load-library' * lisp/emacs-lisp/find-func.el (find-function--any-subform-p): Don't use 'cl-destructuring-bind'. (find-library--from-load-history): Don't use 'cl-loop'. * lisp/thingatpt.el (thing-at-point): Don't use 'cl-loop'. This avoids loading cl-lib whenever thingatpt.el is loaded, for example, as result of "M-x load-library". diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index d393ccc759a..24d31fefd7d 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -42,8 +42,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - ;;; User variables: (defgroup find-function nil @@ -247,13 +245,19 @@ find-library--from-load-history ;; LIBRARY may be "foo.el" or "foo". (let ((load-re (concat "\\(" (regexp-quote (file-name-sans-extension library)) "\\)" - (regexp-opt (get-load-suffixes)) "\\'"))) - (cl-loop - for (file . _) in load-history thereis - (and (stringp file) (string-match load-re file) - (let ((dir (substring file 0 (match-beginning 1))) - (basename (match-string 1 file))) - (locate-file basename (list dir) (find-library-suffixes))))))) + (regexp-opt (get-load-suffixes)) "\\'")) + (alist load-history) + elt file found) + (while (and alist (null found)) + (setq elt (car alist) + alist (cdr alist) + file (car elt) + found (and (stringp file) (string-match load-re file) + (let ((dir (substring file 0 (match-beginning 1))) + (basename (match-string 1 file))) + (locate-file basename (list dir) + (find-library-suffixes)))))) + found)) (defvar find-function-C-source-directory (let ((dir (expand-file-name "src" source-directory))) @@ -469,7 +473,8 @@ find-function--any-subform-p ((not (consp form)) nil) ((funcall pred form) t) (t - (cl-destructuring-bind (left-child . right-child) form + (let ((left-child (car form)) + (right-child (cdr form))) (or (find-function--any-subform-p left-child pred) (find-function--any-subform-p right-child pred)))))) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 5d4f4df9131..88efbf73beb 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -52,7 +52,6 @@ ;;; Code: -(require 'cl-lib) (provide 'thingatpt) (defvar thing-at-point-provider-alist nil @@ -175,11 +174,14 @@ thing-at-point a symbol as a valid THING." (let ((text (cond - ((cl-loop for (pthing . function) in thing-at-point-provider-alist - when (eq pthing thing) - for result = (funcall function) - when result - return result)) + ((let ((alist thing-at-point-provider-alist) + elt result) + (while (and alist (null result)) + (setq elt (car alist) + alist (cdr alist)) + (and (eq (car elt) thing) + (setq result (funcall (cdr elt))))) + result)) ((get thing 'thing-at-point) (funcall (get thing 'thing-at-point))) (t commit ae06e0275d6197e82eae5b8cb9bb30d33b863cee Author: Eli Zaretskii Date: Sat Nov 18 09:01:30 2023 +0200 ; Improve documentation of recently added functions * src/androidfns.c (Fandroid_external_storage_available_p) (Fandroid_request_storage_access): * lisp/term/android-win.el (android-after-splash-screen): Improve and clarify wording of doc strings. diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index bcf49da1225..36470097b40 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -404,9 +404,9 @@ android-after-splash-screen notice to that effect, followed by a button that enables the user to grant such permissions. -FANCY-P controls if the inserted notice should be displayed in a -variable space consequent on its being incorporated within the -fancy splash screen." +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'." (unless (android-external-storage-available-p) (if fancy-p (fancy-splash-insert diff --git a/src/androidfns.c b/src/androidfns.c index 785587d9282..aeba9d897ad 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -3101,7 +3101,7 @@ DEFUN ("android-request-directory-access", Fandroid_request_directory_access, DEFUN ("android-external-storage-available-p", Fandroid_external_storage_available_p, Sandroid_external_storage_available_p, 0, 0, 0, - doc: /* Return whether Emacs is entitled to access external storage. + doc: /* Return non-nil if Emacs is entitled to access external storage. Return nil if the requisite permissions for external storage access have not been granted to Emacs, t otherwise. Such permissions can be requested by means of the `android-request-storage-access' @@ -3117,13 +3117,13 @@ DEFUN ("android-external-storage-available-p", DEFUN ("android-request-storage-access", Fandroid_request_storage_access, Sandroid_request_storage_access, 0, 0, "", - doc: /* Request rights to access external storage. + doc: /* Request permissions to access external storage. -Return nil whether access is accorded or not, immediately subsequent -to displaying the permissions request dialog. +Return nil regardless of whether access permissions are granted or not, +immediately after displaying the permissions request dialog. -`android-external-storage-available-p' (which see) ascertains if Emacs -has received such rights. */) +Use `android-external-storage-available-p' (which see) to verify +whether Emacs has actually received such access permissions. */) (void) { android_request_storage_access (); commit 669e754f5bdc9f9130a68eec6966babe9a85ecae Author: Po Lu Date: Sat Nov 18 14:15:55 2023 +0800 Offer to grant storage permissions if absent * java/org/gnu/emacs/EmacsService.java (externalStorageAvailable) (requestStorageAccess23, requestStorageAccess30) (requestStorageAccess): New functions. * lisp/startup.el (fancy-startup-tail, normal-splash-screen): Call android-win functions for inserting the new storage permission notice. * lisp/term/android-win.el (android-display-storage-permission-popup) (android-after-splash-screen): New functions. * src/android.c (android_init_emacs_service): Link to new Java functions. (android_external_storage_available_p) (android_request_storage_access): New functions. * src/android.h: Update prototypes. * src/androidfns.c (Fandroid_external_storage_available_p) (Fandroid_request_storage_access): New functions. (syms_of_androidfns): Register new subrs. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 5bd1dcc5a88..3cc37dd992d 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -63,6 +63,7 @@ import android.os.BatteryManager; import android.os.Build; +import android.os.Environment; import android.os.Looper; import android.os.IBinder; import android.os.Handler; @@ -73,6 +74,7 @@ import android.provider.DocumentsContract; import android.provider.DocumentsContract.Document; +import android.provider.Settings; import android.util.Log; import android.util.DisplayMetrics; @@ -1909,4 +1911,124 @@ In addition, arbitrary runtime exceptions (such as return false; } + + + + /* Functions for detecting and requesting storage permissions. */ + + public boolean + externalStorageAvailable () + { + final String readPermission; + + readPermission = "android.permission.READ_EXTERNAL_STORAGE"; + + return (Build.VERSION.SDK_INT < Build.VERSION_CODES.R + ? (checkSelfPermission (readPermission) + == PackageManager.PERMISSION_GRANTED) + : Environment.isExternalStorageManager ()); + } + + private void + requestStorageAccess23 () + { + Runnable runnable; + + runnable = new Runnable () { + @Override + public void + run () + { + EmacsActivity activity; + String permission, permission1; + + permission = "android.permission.READ_EXTERNAL_STORAGE"; + permission1 = "android.permission.WRITE_EXTERNAL_STORAGE"; + + /* Find an activity that is entitled to display a permission + request dialog. */ + + if (EmacsActivity.focusedActivities.isEmpty ()) + { + /* If focusedActivities is empty then this dialog may + have been displayed immediately after another popup + dialog was dismissed. Try the EmacsActivity to be + focused. */ + + activity = EmacsActivity.lastFocusedActivity; + + if (activity == null) + { + /* Still no luck. Return failure. */ + return; + } + } + else + activity = EmacsActivity.focusedActivities.get (0); + + /* Now request these permissions. */ + activity.requestPermissions (new String[] { permission, + permission1, }, + 0); + } + }; + + runOnUiThread (runnable); + } + + private void + requestStorageAccess30 () + { + Runnable runnable; + final Intent intent; + + intent + = new Intent (Settings.ACTION_MANAGE_APP_ALL_FILES_ACCESS_PERMISSION, + Uri.parse ("package:org.gnu.emacs")); + + runnable = new Runnable () { + @Override + public void + run () + { + EmacsActivity activity; + + /* Find an activity that is entitled to display a permission + request dialog. */ + + if (EmacsActivity.focusedActivities.isEmpty ()) + { + /* If focusedActivities is empty then this dialog may + have been displayed immediately after another popup + dialog was dismissed. Try the EmacsActivity to be + focused. */ + + activity = EmacsActivity.lastFocusedActivity; + + if (activity == null) + { + /* Still no luck. Return failure. */ + return; + } + } + else + activity = EmacsActivity.focusedActivities.get (0); + + /* Now request these permissions. */ + + activity.startActivity (intent); + } + }; + + runOnUiThread (runnable); + } + + public void + requestStorageAccess () + { + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.R) + requestStorageAccess23 (); + else + requestStorageAccess30 (); + } }; diff --git a/lisp/startup.el b/lisp/startup.el index 37843eab176..e40c316a8e8 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2036,7 +2036,10 @@ fancy-startup-tail (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" @@ -2238,6 +2241,11 @@ normal-splash-screen "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 7d9a033d723..bcf49da1225 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -338,6 +338,92 @@ android-deactivate-mark-command (global-set-key [start-selecting-text] 'set-mark-command) (global-set-key [stop-selecting-text] 'android-deactivate-mark-command) + +;; Splash screen notice. Users are frequently left scratching their +;; heads when they overlook the Android appendex in the Emacs manual +;; and discover that external storage is not accessible; worse yet, +;; Android 11 and later veil the settings panel controlling such +;; permissions behind layer upon layer of largely immaterial settings +;; panels, such that several modified copies of the Android Settings +;; app have omitted them altogether after their developers conducted +;; their own interface simplifications. Display a button on the +;; splash screen that instructs users on granting these permissions +;; when they are denied. + +(declare-function android-external-storage-available-p "androidfns.c") +(declare-function android-request-storage-access "androidfns.c") +(declare-function android-request-directory-access "androidfns.c") + +(defun android-display-storage-permission-popup (&optional _ignored) + "Display a dialog regarding storage permissions. +Display a buffer explaining the need for storage permissions and +offering to grant them." + (interactive) + (with-current-buffer (get-buffer-create "*Android Permissions*") + (setq buffer-read-only nil) + (erase-buffer) + (insert (propertize "Storage Access Permissions" + 'face '(bold (:height 1.2)))) + (insert " + +Before Emacs can access your device's external storage +directories, such as /sdcard and /storage/emulated/0, you must +grant it permission to do so. + +Alternatively, you can request access to a particular directory +in external storage, whereafter it will be available under the +directory /content/storage. + +") + (insert-button "Grant storage permissions" + 'action (lambda (_) + (android-request-storage-access) + (quit-window))) + (newline) + (newline) + (insert-button "Request access to directory" + 'action (lambda (_) + (android-request-directory-access))) + (newline) + (special-mode) + (setq buffer-read-only t)) + (let ((window (display-buffer "*Android Permissions*"))) + (when (windowp window) + (with-selected-window window + ;; Fill the text to the width of this window in columns if it + ;; does not exceed 72, that the text might not be wrapped or + ;; truncated. + (when (<= (window-width window) 72) + (let ((fill-column (window-width window)) + (inhibit-read-only t)) + (fill-region (point-min) (point-max)))))))) + +(defun android-after-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 +to grant such permissions. + +FANCY-P controls if the inserted notice should be displayed in a +variable space consequent on its being incorporated within the +fancy splash screen." + (unless (android-external-storage-available-p) + (if fancy-p + (fancy-splash-insert + :face '(variable-pitch + font-lock-function-call-face) + "\nPermissions necessary to access external storage directories have +been denied. Click " + :link '("here" android-display-storage-permission-popup) + " to grant them.") + (insert + "Permissions necessary to access external storage directories have been +denied. ") + (insert-button "Click here to grant them." + 'action #'android-display-storage-permission-popup + 'follow-link t) + (newline)))) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/android.c b/src/android.c index e116426ca05..7ca5eab817c 100644 --- a/src/android.c +++ b/src/android.c @@ -1628,6 +1628,10 @@ #define FIND_METHOD(c_name, name, signature) \ "Ljava/lang/String;)Ljava/lang/String;"); FIND_METHOD (valid_authority, "validAuthority", "(Ljava/lang/String;)Z"); + FIND_METHOD (external_storage_available, + "externalStorageAvailable", "()Z"); + FIND_METHOD (request_storage_access, + "requestStorageAccess", "()V"); #undef FIND_METHOD } @@ -6558,6 +6562,57 @@ android_request_directory_access (void) return rc; } +/* Return whether Emacs is entitled to access external storage. + + On Android 5.1 and earlier, such permissions as are declared within + an application's manifest are granted during installation and are + irrevocable. + + On Android 6.0 through Android 10.0, the right to read external + storage is a regular permission granted from the Permissions + panel. + + On Android 11.0 and later, that right must be granted through an + independent ``Special App Access'' settings panel. */ + +bool +android_external_storage_available_p (void) +{ + jboolean rc; + jmethodID method; + + if (android_api_level <= 22) /* LOLLIPOP_MR1 */ + return true; + + method = service_class.external_storage_available; + rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env, + emacs_service, + service_class.class, + method); + android_exception_check (); + + return rc; +} + +/* Display a dialog from which the aforementioned rights can be + granted. */ + +void +android_request_storage_access (void) +{ + jmethodID method; + + if (android_api_level <= 22) /* LOLLIPOP_MR1 */ + return; + + method = service_class.request_storage_access; + (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, + emacs_service, + service_class.class, + method); + android_exception_check (); +} + /* The thread from which a query against a thread is currently being diff --git a/src/android.h b/src/android.h index 28d9d25930e..12f9472836f 100644 --- a/src/android.h +++ b/src/android.h @@ -123,6 +123,8 @@ Copyright (C) 2023 Free Software Foundation, Inc. extern void android_toggle_on_screen_keyboard (android_window, bool); extern _Noreturn void android_restart_emacs (void); extern int android_request_directory_access (void); +extern bool android_external_storage_available_p (void); +extern void android_request_storage_access (void); extern int android_get_current_api_level (void) __attribute__ ((pure)); @@ -289,6 +291,8 @@ #define android_is_special_directory(name, dir) (false) jmethodID rename_document; jmethodID move_document; jmethodID valid_authority; + jmethodID external_storage_available; + jmethodID request_storage_access; }; extern JNIEnv *android_java_env; diff --git a/src/androidfns.c b/src/androidfns.c index 772a4f51e78..785587d9282 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -3096,6 +3096,42 @@ DEFUN ("android-request-directory-access", Fandroid_request_directory_access, +/* Functions concerning storage permissions. */ + +DEFUN ("android-external-storage-available-p", + Fandroid_external_storage_available_p, + Sandroid_external_storage_available_p, 0, 0, 0, + doc: /* Return whether Emacs is entitled to access external storage. +Return nil if the requisite permissions for external storage access +have not been granted to Emacs, t otherwise. Such permissions can be +requested by means of the `android-request-storage-access' +command. + +External storage on Android encompasses the `/sdcard' and +`/storage/emulated' directories, access to which is denied to programs +absent these permissions. */) + (void) +{ + return android_external_storage_available_p () ? Qt : Qnil; +} + +DEFUN ("android-request-storage-access", Fandroid_request_storage_access, + Sandroid_request_storage_access, 0, 0, "", + doc: /* Request rights to access external storage. + +Return nil whether access is accorded or not, immediately subsequent +to displaying the permissions request dialog. + +`android-external-storage-available-p' (which see) ascertains if Emacs +has received such rights. */) + (void) +{ + android_request_storage_access (); + return Qnil; +} + + + /* Miscellaneous input method related stuff. */ /* Report X, Y, by the phys cursor width and height as the cursor @@ -3302,6 +3338,8 @@ syms_of_androidfns (void) #ifndef ANDROID_STUBIFY defsubr (&Sandroid_query_battery); defsubr (&Sandroid_request_directory_access); + defsubr (&Sandroid_external_storage_available_p); + defsubr (&Sandroid_request_storage_access); tip_timer = Qnil; staticpro (&tip_timer); commit 05213345c04d4572afec46b99a58d206a111c846 Author: Stefan Monnier Date: Fri Nov 17 18:12:03 2023 -0500 * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Add `null` diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 1c5ce5169ab..d5f7249e527 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -609,6 +609,16 @@ pcase-mutually-exclusive-predicates (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) commit d8c1ac6c35f84000aedff67d60cd420360183019 Author: Spencer Baugh Date: Thu Nov 16 11:34:08 2023 -0500 Return t from completion-emacs22-try-completion only for completions The emacs22 completion style ignores the text after point when computing completions. However, it still needs to take into account the entire string it's given, to avoid returning incorrect values. Previously, completion-emacs22-try-completion would return t if the text before point was an exact completion. But this is effectively saying that the entire input string was an exact completion, which may not be correct. This would cause completing-read with REQUIRE-MATCH=t to return a non-completion. Now, completion-emacs22-try-completion only returns t if the entire input string is an exact completion. * lisp/minibuffer.el (completion-emacs22-try-completion): Return t only if the entire input string is an exact completion. (Bug#67210) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 9ca3ecdf542..7af7a359674 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3531,8 +3531,13 @@ completion-emacs21-all-completions (defun completion-emacs22-try-completion (string table pred point) (let ((suffix (substring string point)) (completion (try-completion (substring string 0 point) table pred))) - (if (not (stringp completion)) - completion + (cond + ((eq completion t) + (if (equal "" suffix) + t + (cons string point))) + ((not (stringp completion)) completion) + (t ;; Merge a trailing / in completion with a / after point. ;; We used to only do it for word completion, but it seems to make ;; sense for all completions. @@ -3546,7 +3551,7 @@ completion-emacs22-try-completion (eq ?/ (aref suffix 0))) ;; This leaves point after the / . (setq suffix (substring suffix 1))) - (cons (concat completion suffix) (length completion))))) + (cons (concat completion suffix) (length completion)))))) (defun completion-emacs22-all-completions (string table pred point) (let ((beforepoint (substring string 0 point))) commit b1b9082b3eab0e83deeee622e61ad3d577646950 Author: Michael Albinus Date: Fri Nov 17 18:28:30 2023 +0100 Make Tramp aware of completion-regexp-list * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): New defmacro. (tramp-completion-handle-file-name-all-completions): * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Use it. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 3de4721ec77..acbf5ec01c6 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -435,7 +435,7 @@ tramp-adb-handle-delete-file (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -450,17 +450,14 @@ tramp-adb-handle-file-name-all-completions (file-name-as-directory f) f)) (with-current-buffer (tramp-get-buffer v) - (delete-dups - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. We fix this by `delete-dups'. - '("." "..") - (delq - nil - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n")))))))))))) + (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)))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 79eafc5c12e..587b9db067a 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -739,7 +739,7 @@ tramp-crypt-handle-file-locked-p (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (let* (completion-regexp-list diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index aadc64666a5..4b04f75ce96 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -102,22 +102,21 @@ tramp-fuse-handle-file-exists-p (defun tramp-fuse-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (tramp-fuse-remove-hidden-files - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory + (tramp-fuse-remove-hidden-files (all-completions filename - (delete-dups - (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)))))))))))) + (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))))))))))) ;; 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 451c033a044..573d89c0c51 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1463,8 +1463,8 @@ tramp-gvfs-handle-file-executable-p (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (unless (tramp-compat-string-search "/" filename) - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory + (unless (tramp-compat-string-search "/" filename) (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 49acf8395c5..186ef12775a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1848,60 +1848,60 @@ tramp-do-directory-files-and-attributes-with-stat ;; files. (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name directory) nil - (when (and (not (tramp-compat-string-search "/" filename)) - (tramp-connectable-p v)) - (unless (tramp-compat-string-search "/" filename) - (ignore-error file-missing - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including - ;; reliably tagging the directories with a trailing "/". - ;; Because I rock. --daniel@danann.net - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (setq result - (tramp-send-command-and-read - v (format "tramp_perl_file_name_all_completions %s" - (tramp-shell-quote-argument localname)) - 'noerror)) - ;; Cached values. - (dolist (elt result) - (tramp-set-file-property - v (cadr elt) "file-directory-p" (nth 2 elt)) - (tramp-set-file-property - v (cadr elt) "file-exists-p" (nth 3 elt)) - (tramp-set-file-property - v (cadr elt) "file-readable-p" (nth 4 elt))) - ;; Result. - (mapcar #'car result)) - - ;; Do it with ls. - (when (tramp-send-command-and-check - v (format (concat - "cd %s 2>&1 && %s -a 2>%s" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>%s;" - " then echo \"$f/\"; else echo \"$f\"; fi;" - " done") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - (tramp-get-remote-null-device v) - (tramp-get-test-command v) - (tramp-get-remote-null-device v))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - (while (zerop (forward-line -1)) - (push - (buffer-substring (point) (line-end-position)) result))) - result)))))))))) + (tramp-skeleton-file-name-all-completions filename directory + (with-parsed-tramp-file-name (expand-file-name directory) nil + (when (and (not (tramp-compat-string-search "/" filename)) + (tramp-connectable-p v)) + (unless (tramp-compat-string-search "/" filename) + (all-completions + filename + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including + ;; reliably tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (setq result + (tramp-send-command-and-read + v (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname)) + 'noerror)) + ;; Cached values. + (dolist (elt result) + (tramp-set-file-property + v (cadr elt) "file-directory-p" (nth 2 elt)) + (tramp-set-file-property + v (cadr elt) "file-exists-p" (nth 3 elt)) + (tramp-set-file-property + v (cadr elt) "file-readable-p" (nth 4 elt))) + ;; Result. + (mapcar #'car result)) + + ;; Do it with ls. + (when (tramp-send-command-and-check + v (format (concat + "cd %s 2>&1 && %s -a 2>%s" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>%s;" + " then echo \"$f/\"; else echo \"$f\"; fi;" + " done") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-remote-null-device v) + (tramp-get-test-command v) + (tramp-get-remote-null-device v))) + + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + (while (zerop (forward-line -1)) + (push + (buffer-substring (point) (line-end-position)) result))) + result)))))))))) ;; cp, mv and ln diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index ac1b29f08cd..e0622a26eeb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -972,20 +972,19 @@ tramp-smb-handle-file-local-copy ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (when (file-directory-p directory) (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (delete-dups - (mapcar - (lambda (x) - (list - (if (tramp-compat-string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory))))))))) + (mapcar + (lambda (x) + (list + (if (tramp-compat-string-search "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory)))))))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 40e438435fc..87685c06c1f 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -489,7 +489,7 @@ tramp-sudoedit-handle-file-exists-p (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -503,13 +503,11 @@ tramp-sudoedit-handle-file-name-all-completions (if (ignore-errors (file-directory-p (expand-file-name f directory))) (file-name-as-directory f) f)) - (delq - nil - (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit))))))))) + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit)))))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9cc319bef67..54f92cae98d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2741,6 +2741,23 @@ tramp-completion-handle-file-exists-p (tramp-run-real-handler #'file-exists-p (list filename)))) +(defmacro tramp-skeleton-file-name-all-completions + (_filename _directory &rest body) + "Skeleton for `tramp-*-handle-filename-all-completions'. +BODY is the backend specific code." + (declare (indent 2) (debug t)) + `(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)) + (if (consp completion-regexp-list) + ;; Discriminate over `completion-regexp-list'. + (mapcar + (lambda (x) (and (stringp x) (string-match-p regexp x) x)) + result) + result)))))) + (defvar tramp--last-hop-directory nil "Tracks the directory from which to run login programs.") @@ -2750,81 +2767,79 @@ tramp--last-hop-directory ;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." - (let ((fullname - (tramp-drop-volume-letter (expand-file-name filename directory))) - (directory (tramp-drop-volume-letter directory)) - tramp--last-hop-directory hop result result1) - - ;; Suppress hop from completion. - (when (string-match - (rx - (regexp tramp-prefix-regexp) - (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) - fullname) - (setq hop (match-string 1 fullname) - fullname (replace-match "" nil nil fullname 1) - tramp--last-hop-directory - (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) - - (let (;; When `tramp-syntax' is `simplified', we need a default method. - (tramp-default-method - (and (string-empty-p tramp-postfix-method-format) - tramp-default-method)) - (tramp-default-method-alist - (and (string-empty-p tramp-postfix-method-format) - tramp-default-method-alist)) - tramp-default-user tramp-default-user-alist - tramp-default-host tramp-default-host-alist) - - ;; Possible completion structures. - (dolist (elt (tramp-completion-dissect-file-name fullname)) - (let* ((method (tramp-file-name-method elt)) - (user (tramp-file-name-user elt)) - (host (tramp-file-name-host elt)) - (localname (tramp-file-name-localname elt)) - (m (tramp-find-method method user host)) - all-user-hosts) - - (unless localname ;; Nothing to complete. - - (if (or user host) - - ;; Method dependent user / host combinations. - (progn - (mapc - (lambda (x) - (setq all-user-hosts - (append all-user-hosts - (funcall (nth 0 x) (nth 1 x))))) - (tramp-get-completion-function m)) - - (setq result - (append result - (mapcar - (lambda (x) - (tramp-get-completion-user-host - method user host (nth 0 x) (nth 1 x))) - (delq nil all-user-hosts))))) - - ;; Possible methods. - (setq result - (append result (tramp-get-completion-methods m hop))))))) - - ;; Unify list, add hop, remove nil elements. - (dolist (elt result) - (when elt - (setq elt (replace-regexp-in-string - tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) - (push (substring elt (length directory)) result1))) - - ;; Complete local parts. - (delete-dups - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))))) + (tramp-skeleton-file-name-all-completions filename directory + (let ((fullname + (tramp-drop-volume-letter (expand-file-name filename directory))) + (directory (tramp-drop-volume-letter directory)) + tramp--last-hop-directory hop result result1) + + ;; Suppress hop from completion. + (when (string-match + (rx + (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + fullname) + (setq hop (match-string 1 fullname) + fullname (replace-match "" nil nil fullname 1) + tramp--last-hop-directory + (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) + + (let (;; When `tramp-syntax' is `simplified', we need a default method. + (tramp-default-method + (and (string-empty-p tramp-postfix-method-format) + tramp-default-method)) + (tramp-default-method-alist + (and (string-empty-p tramp-postfix-method-format) + tramp-default-method-alist)) + tramp-default-user tramp-default-user-alist + tramp-default-host tramp-default-host-alist) + + ;; Possible completion structures. + (dolist (elt (tramp-completion-dissect-file-name fullname)) + (let* ((method (tramp-file-name-method elt)) + (user (tramp-file-name-user elt)) + (host (tramp-file-name-host elt)) + (localname (tramp-file-name-localname elt)) + (m (tramp-find-method method user host)) + all-user-hosts) + + (unless localname ;; Nothing to complete. + (if (or user host) + ;; Method dependent user / host combinations. + (progn + (mapc + (lambda (x) + (setq all-user-hosts + (append all-user-hosts + (funcall (nth 0 x) (nth 1 x))))) + (tramp-get-completion-function m)) + + (setq result + (append result + (mapcar + (lambda (x) + (tramp-get-completion-user-host + method user host (nth 0 x) (nth 1 x))) + all-user-hosts)))) + + ;; Possible methods. + (setq result + (append result (tramp-get-completion-methods m hop))))))) + + ;; Add hop. + (dolist (elt result) + (when elt + (setq elt (replace-regexp-in-string + tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) + (push (substring elt (length directory)) result1))) + + ;; Complete local parts. + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory)))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion commit 8d2012024ded3fd13a4a86ac2d53dee57957fe1b Author: Michael Albinus Date: Fri Nov 17 18:17:28 2023 +0100 * test/lisp/net/tramp-tests.el (tramp--test-timeout-handler): Be more verbose. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e74837b926a..7854466b819 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4844,6 +4844,7 @@ tramp-test26-interactive-file-name-completion (if (tramp--test-expensive-test-p) ;; It doesn't work for `initials' and `shorthand' ;; completion styles. Should it? + ;; `orderless' passes the tests, but it is an ELPA package. '(emacs21 emacs22 basic partial-completion substring flex) '(basic))) @@ -5154,10 +5155,11 @@ tramp-test28-process-file (defun tramp--test-timeout-handler (&rest _ignore) "Timeout handler, reporting a failed test." (interactive) - (let ((proc (get-buffer-process (current-buffer)))) - (when (processp proc) - (tramp--test-message - "cmd: %s\nbuf:\n%s\n---" (process-command proc) (buffer-string)))) + (tramp--test-message "proc: %s" (get-buffer-process (current-buffer))) + (when-let ((proc (get-buffer-process (current-buffer))) + ((processp proc))) + (tramp--test-message "cmd: %s" (process-command proc))) + (tramp--test-message "buf: %s\n%s\n---" (current-buffer) (buffer-string)) (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) (ert-deftest tramp-test29-start-file-process () commit 7b0e07c41ae92d4cb139b1c47ce9debc37cfffcb Author: Michael Albinus Date: Fri Nov 17 18:16:58 2023 +0100 Make Tramp aware of completion-regexp-list (don't merge) * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): New defmacro. (tramp-completion-handle-file-name-all-completions): * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Use it. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index f16c97a235c..27645e143af 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -449,7 +449,7 @@ tramp-adb-handle-delete-file (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (tramp-compat-ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -464,17 +464,14 @@ tramp-adb-handle-file-name-all-completions (file-name-as-directory f) f)) (with-current-buffer (tramp-get-buffer v) - (delete-dups - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. We fix this by `delete-dups'. - '("." "..") - (delq - nil - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n")))))))))))) + (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)))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 62cd3f0a3b2..1cc4e96bc99 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -735,7 +735,7 @@ tramp-crypt-handle-file-locked-p (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (tramp-compat-ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (let* (completion-regexp-list diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index e4610b069ad..1446d31a869 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -104,22 +104,21 @@ tramp-fuse-handle-file-exists-p (defun tramp-fuse-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (tramp-fuse-remove-hidden-files - (tramp-compat-ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory + (tramp-fuse-remove-hidden-files (all-completions filename - (delete-dups - (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)))))))))))) + (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))))))))))) ;; 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 07390b50df2..9a94a2f4c9b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1434,8 +1434,8 @@ tramp-gvfs-handle-file-executable-p (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (unless (tramp-compat-string-search "/" filename) - (tramp-compat-ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory + (unless (tramp-compat-string-search "/" filename) (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 74b1638f120..7dc75cb337a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1831,46 +1831,47 @@ tramp-do-directory-files-and-attributes-with-stat ;; files. (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name directory) nil - (when (and (not (tramp-compat-string-search "/" filename)) - (tramp-connectable-p v)) - (unless (tramp-compat-string-search "/" filename) - (tramp-compat-ignore-error file-missing - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including - ;; reliably tagging the directories with a trailing "/". - ;; Because I rock. --daniel@danann.net - (when (tramp-send-command-and-check - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s" - (tramp-shell-quote-argument localname))) - - (format (concat - "cd %s 2>&1 && %s -a 2>%s" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>%s;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi;" - " done") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - (tramp-get-remote-null-device v) - (tramp-get-test-command v) - (tramp-get-remote-null-device v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - (while (zerop (forward-line -1)) - (push (buffer-substring (point) (line-end-position)) result))) - result))))))))) + (tramp-skeleton-file-name-all-completions filename directory + (with-parsed-tramp-file-name (expand-file-name directory) nil + (when (and (not (tramp-compat-string-search "/" filename)) + (tramp-connectable-p v)) + (unless (tramp-compat-string-search "/" filename) + (all-completions + filename + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including + ;; reliably tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (when (tramp-send-command-and-check + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname))) + + (format (concat + "cd %s 2>&1 && %s -a 2>%s" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>%s;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi;" + " done") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-remote-null-device v) + (tramp-get-test-command v) + (tramp-get-remote-null-device v)))) + + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + (while (zerop (forward-line -1)) + (push + (buffer-substring (point) (line-end-position)) result))) + result))))))))) ;; cp, mv and ln diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 0ba24352a3d..5c385641cf8 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -987,20 +987,19 @@ tramp-smb-handle-file-local-copy ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (tramp-compat-ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (when (file-directory-p directory) (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (delete-dups - (mapcar - (lambda (x) - (list - (if (tramp-compat-string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory))))))))) + (mapcar + (lambda (x) + (list + (if (tramp-compat-string-search "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory)))))))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 9939d93ba35..092a414f3de 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -467,7 +467,7 @@ tramp-sudoedit-handle-file-exists-p (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (tramp-compat-ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -481,13 +481,11 @@ tramp-sudoedit-handle-file-name-all-completions (if (ignore-errors (file-directory-p (expand-file-name f directory))) (file-name-as-directory f) f)) - (delq - nil - (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit))))))))) + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit)))))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 29f5ffd68f0..8b1a49edbae 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3069,85 +3069,100 @@ tramp-completion-handle-file-exists-p (tramp-run-real-handler #'file-exists-p (list filename)))) +(defmacro tramp-skeleton-file-name-all-completions + (_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)) + (if (consp completion-regexp-list) + ;; Discriminate over `completion-regexp-list'. + (mapcar + (lambda (x) (and (stringp x) (string-match-p regexp x) x)) + result) + result)))))) + ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-file-name' structures. For all of them we return possible ;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." - (let ((fullname - (tramp-drop-volume-letter (expand-file-name filename directory))) - ;; When `tramp-syntax' is `simplified', we need a default method. - (tramp-default-method - (and (string-empty-p tramp-postfix-method-format) - tramp-default-method)) - (tramp-default-method-alist - (and (string-empty-p tramp-postfix-method-format) - tramp-default-method-alist)) - tramp-default-user tramp-default-user-alist - tramp-default-host tramp-default-host-alist - hop result result1) - - ;; Suppress hop from completion. - (when (string-match - (tramp-compat-rx - (regexp tramp-prefix-regexp) - (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) - fullname) - (setq hop (match-string 1 fullname) - fullname (replace-match "" nil nil fullname 1))) - - ;; Possible completion structures. - (dolist (elt (tramp-completion-dissect-file-name fullname)) - (let* ((method (tramp-file-name-method elt)) - (user (tramp-file-name-user elt)) - (host (tramp-file-name-host elt)) - (localname (tramp-file-name-localname elt)) - (m (tramp-find-method method user host)) - all-user-hosts) - - (unless localname ;; Nothing to complete. - - (if (or user host) - - ;; Method dependent user / host combinations. - (progn - (mapc - (lambda (x) - (setq all-user-hosts - (append all-user-hosts - (funcall (nth 0 x) (nth 1 x))))) - (tramp-get-completion-function m)) - - (setq result - (append result - (mapcar - (lambda (x) - (tramp-get-completion-user-host - method user host (nth 0 x) (nth 1 x))) - (delq nil all-user-hosts))))) - - ;; Possible methods. - (setq result - (append result (tramp-get-completion-methods m))))))) - - ;; Unify list, add hop, remove nil elements. - (dolist (elt result) - (when elt - (string-match tramp-prefix-regexp elt) - (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt)) - (push - (substring elt (length (tramp-drop-volume-letter directory))) - result1))) - - ;; Complete local parts. - (delete-dups - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory))))))) + (tramp-skeleton-file-name-all-completions filename directory + (let ((fullname + (tramp-drop-volume-letter (expand-file-name filename directory))) + ;; When `tramp-syntax' is `simplified', we need a default method. + (tramp-default-method + (and (string-empty-p tramp-postfix-method-format) + tramp-default-method)) + (tramp-default-method-alist + (and (string-empty-p tramp-postfix-method-format) + tramp-default-method-alist)) + tramp-default-user tramp-default-user-alist + tramp-default-host tramp-default-host-alist + hop result result1) + + ;; Suppress hop from completion. + (when (string-match + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + fullname) + (setq hop (match-string 1 fullname) + fullname (replace-match "" nil nil fullname 1))) + + ;; Possible completion structures. + (dolist (elt (tramp-completion-dissect-file-name fullname)) + (let* ((method (tramp-file-name-method elt)) + (user (tramp-file-name-user elt)) + (host (tramp-file-name-host elt)) + (localname (tramp-file-name-localname elt)) + (m (tramp-find-method method user host)) + all-user-hosts) + + (unless localname ;; Nothing to complete. + (if (or user host) + ;; Method dependent user / host combinations. + (progn + (mapc + (lambda (x) + (setq all-user-hosts + (append all-user-hosts + (funcall (nth 0 x) (nth 1 x))))) + (tramp-get-completion-function m)) + + (setq result + (append result + (mapcar + (lambda (x) + (tramp-get-completion-user-host + method user host (nth 0 x) (nth 1 x))) + (delq nil all-user-hosts))))) + + ;; Possible methods. + (setq result + (append result (tramp-get-completion-methods m))))))) + + ;; Add hop. + (dolist (elt result) + (when elt + (string-match tramp-prefix-regexp elt) + (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt)) + (push + (substring elt (length (tramp-drop-volume-letter directory))) + result1))) + + ;; Complete local parts. + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion commit 232a57a3e32f8dc425887f6edda172255b265de3 Author: Eli Zaretskii Date: Fri Nov 17 14:28:13 2023 +0200 ; * doc/lispref/debugging.texi (Debugging): Add cross-references. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 4c1ad291876..57ed5806855 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -13,11 +13,12 @@ Debugging @itemize @bullet @item If a problem occurs when you run the program, you can use the built-in -Emacs Lisp debugger to suspend the Lisp evaluator, and examine and/or -alter its internal state. +Emacs Lisp debugger (@pxref{Debugger}) to suspend the Lisp evaluator, +and examine and/or alter its internal state. @item You can use Edebug, a source-level debugger for Emacs Lisp. +@xref{Edebug}. @item @cindex tracing Lisp programs commit c65ddf26a335157b31d6a3d2cedffd661e7e42bf Author: Ihor Radchenko Date: Fri Nov 17 11:47:46 2023 +0200 ; doc/lispref/debugging.texi: Add reference to Profiler docs (bug#67236). diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 1246b3ff57a..4c1ad291876 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -47,6 +47,7 @@ Debugging @item You can profile the program to get hints about how to make it more efficient. +@xref{Profiling}. @end itemize Other useful tools for debugging input and output problems are the commit 6f884d3aed9443393ca8e923b82f5d19359fa652 Author: Jeremy Bryant Date: Wed Nov 15 23:15:46 2023 +0000 Add 5 docstrings to abbrev.el (bug#67153) * lisp/abbrev.el (prepare-abbrev-list-buffer, add-abbrev) (inverse-add-abbrev, abbrev--describe) (abbrev--possibly-save): Add doc strings. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index e1311dbc83b..6269fd50adf 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -122,6 +122,9 @@ abbrev-table-name found)) (defun prepare-abbrev-list-buffer (&optional local) + "Return buffer listing abbreviations and expansions for each abbrev table. + +If LOCAL is non-nil, include in the buffer only the local abbrevs." (let ((local-table local-abbrev-table)) (with-current-buffer (get-buffer-create "*Abbrevs*") (erase-buffer) @@ -333,6 +336,20 @@ add-global-abbrev (add-abbrev global-abbrev-table "Global" arg)) (defun add-abbrev (table type arg) + "Define abbrev in TABLE, whose expansion is ARG words before point. +Read the abbreviation from the minibuffer, with prompt TYPE. + +ARG of zero means the entire region is the expansion. + +A negative ARG means to undefine the specified abbrev. + +TYPE is an arbitrary string used to prompt user for the kind of +abbrev, such as \"Global\", \"Mode\". (This has no influence on the +choice of the actual TABLE). + +See `inverse-add-abbrev' for the opposite task. + +Don't use this function in a Lisp program; use `define-abbrev' instead." (let ((exp (cond ((or (and (null arg) (use-region-p)) @@ -353,7 +370,7 @@ add-abbrev (if (or (null exp) (not (abbrev-expansion name table)) (y-or-n-p (format "%s expands into \"%s\"; redefine? " - name (abbrev-expansion name table)))) + name (abbrev-expansion name table)))) (define-abbrev table (downcase name) exp)))) (defun inverse-add-mode-abbrev (n) @@ -393,6 +410,19 @@ inverse-add-global-abbrev (inverse-add-abbrev global-abbrev-table "Global" n)) (defun inverse-add-abbrev (table type arg) + "Define the word before point as an abbrev in TABLE. +Read the expansion from the minibuffer, using prompt TYPE, define +the abbrev, and then expand the abbreviation in the current +buffer. + +ARG means use the ARG-th word before point as the abbreviation. +Negative ARG means use the ARG-th word after point. + +TYPE is an arbitrary string used to prompt user for the kind of +abbrev, such as \"Global\", \"Mode\". (This has no influence on the +choice of the actual TABLE). + +See also `add-abbrev', which performs the opposite task." (let (name exp start end) (save-excursion (forward-word (1+ (- arg))) @@ -1102,6 +1132,8 @@ abbrev--write (insert ")\n")) (defun abbrev--describe (sym) + "Describe abbrev SYM. +Print on `standard-output' the abbrev, count of use, expansion." (when (symbol-value sym) (prin1 (symbol-name sym)) (if (null (abbrev-get sym :system)) @@ -1243,11 +1275,12 @@ edit-abbrevs-mode (setq font-lock-multiline nil)) (defun abbrev--possibly-save (query &optional arg) + "Hook function for use by `save-some-buffer-functions'. + +Maybe save abbrevs, and record whether we either saved them or asked to." ;; Query mode. (if (eq query 'query) (and save-abbrevs abbrevs-changed) - ;; Maybe save abbrevs, and record whether we either saved them or - ;; asked to. (and save-abbrevs abbrevs-changed (prog1 commit b4d990bd63724bcaf346b0b21ff63ff724a41815 Author: Eli Zaretskii Date: Fri Nov 17 09:04:20 2023 +0200 ; Clarify wording about arguments in doc strings * doc/lispref/tips.texi (Documentation Tips): Clarify "important arguments". (Bug#67217) diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index edc16181d19..db9f64aa8a0 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -645,11 +645,11 @@ Documentation Tips @item The first line should mention all the important arguments of the -function, and should mention them in the order that they are written -in a function call. If the function has many arguments, then it is -not feasible to mention them all in the first line; in that case, the -first line should mention the first few arguments, including the most -important arguments. +function (in particular, the mandatory arguments), and should mention +them in the order that they are written in a function call. If the +function has many arguments, then it is not feasible to mention them +all in the first line; in that case, the first line should mention the +first few arguments, including the most important arguments. @item When a function's documentation string mentions the value of an argument commit 7d6896253b500abd655faac2c96f7c9d72fc5b62 Author: Po Lu Date: Fri Nov 17 11:36:58 2023 +0800 Correct initial scale calculation when pinching nonselected window * lisp/touch-screen.el (touch-screen-pinch): Retrieve present scale within the window pinched. (touch-screen-handle-point-update): Expunge inefficacious code meant to disregard events sent during gesture navigation. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 3e1a994402d..5a04425d343 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -908,16 +908,17 @@ touch-screen-pinch (require 'face-remap) (let* ((posn (cadr event)) (window (posn-window posn)) - (current-scale (if text-scale-mode - text-scale-mode-amount - 0)) - (start-scale (or (aref touch-screen-aux-tool 7) - (aset touch-screen-aux-tool 7 - current-scale))) (scale (nth 2 event)) - (ratio-diff (nth 5 event))) + (ratio-diff (nth 5 event)) + current-scale start-scale) (when (windowp window) (with-selected-window window + (setq current-scale (if text-scale-mode + text-scale-mode-amount + 0) + start-scale (or (aref touch-screen-aux-tool 7) + (aset touch-screen-aux-tool 7 + current-scale))) ;; Set the text scale. (text-scale-set (+ start-scale (round (log scale text-scale-mode-step)))) @@ -1057,25 +1058,12 @@ touch-screen-handle-point-update (cond ((or (null what) (eq what 'ancillary-tool)) (let* ((last-posn (nth 2 touch-screen-current-tool)) - (original-posn (nth 4 touch-screen-current-tool)) - (col (and (not (posn-area original-posn)) - (car (posn-col-row original-posn - (posn-window posn))))) - ;; Don't start horizontal scrolling if the touch - ;; point originated within two columns of the window - ;; edges, as systems like Android use those two - ;; columns to implement gesture navigation. - (diff-x-eligible - (and col (> col 2) - (< col (- (window-width window) 2)))) (diff-x (- (car last-posn) (car relative-xy))) (diff-y (- (cdr last-posn) (cdr relative-xy)))) (when (or (> diff-y 10) - (and diff-x-eligible - (> diff-x (frame-char-width))) + (> diff-x (frame-char-width)) (< diff-y -10) - (and diff-x-eligible - (< diff-x (- (frame-char-width))))) + (< diff-x (- (frame-char-width)))) (setcar (nthcdr 3 touch-screen-current-tool) 'scroll) (setcar (nthcdr 2 touch-screen-current-tool) commit 643c7fc85101b26625f8dc547a7fd09e9bc3df77 Author: Po Lu Date: Fri Nov 17 11:16:23 2023 +0800 Correct generation of touchscreen-pinch events * lisp/touch-screen.el (touch-screen-pinch): Check that posn-x-y is available before scrolling to it. (touch-screen-handle-aux-point-update): Don't provide posns for windows besides the window where the touch sequence started in touchscreen-pinch events. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index cc6f30bccbe..3e1a994402d 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -925,7 +925,8 @@ touch-screen-pinch ;; position. (if (and (not (eq current-scale text-scale-mode-amount)) - (posn-point posn)) + (posn-point posn) + (cdr (posn-x-y posn))) (touch-screen-scroll-point-to-y (posn-point posn) (cdr (posn-x-y posn))) ;; Rather than scroll POSN's point to its old row, scroll the @@ -1224,11 +1225,22 @@ touch-screen-handle-aux-point-update (throw 'input-event (list 'touchscreen-pinch (if (or (<= (car centrum) 0) (<= (cdr centrum) 0)) - (list window centrum nil nil nil - nil nil nil) - (posn-at-x-y (car centrum) - (cdr centrum) - window)) + (list window nil centrum nil nil + nil nil nil nil nil) + (let ((posn (posn-at-x-y (car centrum) + (cdr centrum) + window))) + (if (eq (posn-window posn) + window) + posn + ;; Return a placeholder + ;; outside the window if + ;; the centrum has moved + ;; beyond the confines of + ;; the window where the + ;; gesture commenced. + (list window nil centrum nil nil + nil nil nil nil nil)))) ratio (- (car centrum) (car initial-centrum)) commit c20ae7a30fb012402be41b6fbfb45318005a09d7 Author: Eli Zaretskii Date: Thu Nov 16 21:55:10 2023 +0200 ; Improve cross-references in description of 'pcase' * doc/lispref/control.texi (pcase Macro, Backquote Patterns): Improve cross-references. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 84196c9116a..90b1358b3cd 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -597,6 +597,10 @@ pcase Macro Likewise, it makes no sense to bind keyword symbols (@pxref{Constant Variables}). +@item `@var{qpat} +A backquote-style pattern. @xref{Backquote Patterns}, for the +details. + @item (cl-type @var{type}) Matches if @var{expval} is of type @var{type}, which is a type descriptor as accepted by @code{cl-typep} (@pxref{Type Predicates,,,cl,Common @@ -1235,7 +1239,8 @@ Backquote Patterns @code{`(add ,x ,y)} is a pattern that checks that @code{form} is a three-element list starting with the literal symbol @code{add}, then extracts the second and third elements and binds them -to symbols @code{x} and @code{y}, respectively. +to symbols @code{x} and @code{y}, respectively. This is known as +@dfn{destructuring}, see @ref{Destructuring with pcase Patterns}. The clause body evaluates @code{x} and @code{y} and adds the results. Similarly, the @code{call} clause implements a function call, and the @code{fn} clause implements an anonymous function definition. commit ed2497284910d0ea34861da831dc3598e025a61a Author: Juri Linkov Date: Thu Nov 16 19:37:21 2023 +0200 ; * etc/NEWS: Add new section. diff --git a/etc/NEWS b/etc/NEWS index 71067566b6d..eebada2db49 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1071,8 +1071,10 @@ A major mode based on the tree-sitter library for editing Elixir files. *** New major mode 'lua-ts-mode'. A major mode based on the tree-sitter library for editing Lua files. +** Minibuffer and Completions + +++ -** New global minor mode 'minibuffer-regexp-mode'. +*** New global minor mode 'minibuffer-regexp-mode'. This is a minor mode for editing regular expressions in the minibuffer. It highlights parens via ‘show-paren-mode’ and ‘blink-matching-paren’ in a user-friendly way, avoids reporting alleged paren mismatches and makes commit cfb117fee18cd14111066f308d09b8b737491ead Author: Stefan Monnier Date: Thu Nov 16 11:19:56 2023 -0500 * etc/NEWS: Mention incompatible change in `pp` (bug#67180) diff --git a/etc/NEWS b/etc/NEWS index e2a8e5dfdd8..71067566b6d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1099,6 +1099,9 @@ showcases all their customization options. * Incompatible Lisp Changes in Emacs 30.1 +** '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. + ** 'buffer-match-p' and 'match-buffers' take '&rest args'. They used to take a single '&optional arg' and were documented to use an unreliable hack to try and support condition predicates that commit 4194f9bd8705b7ccc23f49aa5795af228dab26bb Merge: ef6622bf047 44b5761b44a Author: Stefan Monnier Date: Thu Nov 16 09:57:38 2023 -0500 Merge branch 'derived-mode-add-parents' commit 44b5761b44aee8d7864b5aab6c324d26de55914c Author: Stefan Monnier Date: Thu Nov 16 09:50:45 2023 -0500 (merge-ordered-lists): Dot a few more `i`s Suggested by Mattias Engdegård. * lisp/subr.el (merge-ordered-lists): Don't mutate the arg. * test/lisp/subr-tests.el (subr-tests--merge-ordered-lists): Make the test a bit more precise. diff --git a/lisp/subr.el b/lisp/subr.el index abc937531ad..12f37d66ac1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2695,6 +2695,7 @@ merge-ordered-lists ;; Algorithm inspired from ;; [C3](https://en.wikipedia.org/wiki/C3_linearization) (let ((result '())) + (setq lists (remq nil lists)) ;Don't mutate the original `lists' argument. (while (cdr (setq lists (delq nil lists))) ;; Try to find the next element of the result. This ;; is achieved by considering the first element of each diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index f67ac70046a..f485328aa7a 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -365,7 +365,7 @@ subr-tests--mode-B (defalias 'subr-tests--mode-C #'subr-tests--mode-B) (derived-mode-add-parents 'subr-tests--mode-A '(subr-tests--mode-C)) -(ert-deftest subt-tests--derived-mode-add-parents () +(ert-deftest subr-tests--derived-mode-add-parents () ;; The Right Answer is somewhat unclear in the presence of cycles, ;; but let's make sure we get tolerable answers. ;; FIXME: Currently `prog-mode' doesn't always end up at the end :-( @@ -381,12 +381,14 @@ subt-tests--derived-mode-add-parents '(subr-tests--mode-A subr-tests--mode-B prog-mode subr-tests--mode-C subr-tests--derived-mode-1)))))) -(ert-deftest subt-tests--merge-ordered-lists () +(ert-deftest subr-tests--merge-ordered-lists () (should (equal (merge-ordered-lists - '((B A) (C A) (D B) (E D C))) + '((B A) (C A) (D B) (E D C)) + (lambda (_) (error "cycle"))) '(E D B C A))) (should (equal (merge-ordered-lists - '((E D C) (B A) (C A) (D B))) + '((E D C) (B A) (C A) (D B)) + (lambda (_) (error "cycle"))) '(E D C B A))) (should-error (merge-ordered-lists '((E C D) (B A) (A C) (D B)) commit ef6622bf04745a9088a3d152757e42061c6eca2a Author: Po Lu Date: Thu Nov 16 21:07:01 2023 +0800 Disable generation of mouse-1 events after ancillary tool presses * lisp/touch-screen.el (touch-screen-handle-scroll): Correct typo in comment. (touch-screen-handle-point-update): Attempt to detect scroll gestures and the like also when what is ancillary-tool. (touch-screen-handle-point-up): Don't needlessly compute relative xy when transforming aux tool into current tool. (touch-screen-handle-touch): Set what field to ancillary-tool rather than clear it when initializing the ancillary tool, indicating to t-s-h-p-u that it must not generate mouse up events. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index e9cd5ca4fd3..cc6f30bccbe 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -255,7 +255,7 @@ touch-screen-handle-scroll (window (cadr touch-screen-current-tool)) (lines-vscrolled (or (nth 7 touch-screen-current-tool) 0)) (lines-hscrolled (or (nth 8 touch-screen-current-tool) 0))) - (setq accumulator (+ accumulator dx)) ; Add dx; + (setq accumulator (+ accumulator dx)) ; Add dx. ;; Figure out how much it has scrolled and how much remains on the ;; left or right of the window. If a line has already been ;; vscrolled but no hscrolling has happened, don't hscroll, as @@ -1014,12 +1014,15 @@ touch-screen-handle-point-update `touch-screen-current-tool'. If the fourth element of `touch-screen-current-tool' is nil, then -the touch has just begun. Determine how much POINT has moved. -If POINT has moved upwards or downwards by a significant amount, -then set the fourth element to `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 and Y axes. +the touch has just begun. In a related case, if it is +`ancillary-tool', then the ancillary tool has been removed and +gesture translation must be resumed. Determine how much POINT +has moved. If POINT has moved upwards or downwards by a +significant amount, then set the fourth element to `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 +and Y axes. If the fourth element of `touchscreen-current-tool' is `scroll', then generate a `touchscreen-scroll' event with the window that @@ -1050,7 +1053,8 @@ touch-screen-handle-point-update (touch-screen-relative-xy posn window))) ;; Update the 10th field of the tool list with RELATIVE-XY. (setcar (nthcdr 9 touch-screen-current-tool) relative-xy) - (cond ((null what) + (cond ((or (null what) + (eq what 'ancillary-tool)) (let* ((last-posn (nth 2 touch-screen-current-tool)) (original-posn (nth 4 touch-screen-current-tool)) (col (and (not (posn-area original-posn)) @@ -1288,19 +1292,19 @@ touch-screen-handle-point-up is not read-only." (if touch-screen-aux-tool (progn - (let ((posn (cdr point)) - (window (cadr touch-screen-current-tool)) - (point-no (aref touch-screen-aux-tool 0))) + (let ((point-no (aref touch-screen-aux-tool 0)) + (relative-xy (aref touch-screen-aux-tool 3))) ;; Replace the current position of touch-screen-current-tool - ;; with posn and its number with point-no, but leave other - ;; information (such as its starting position) intact: this - ;; touchpoint is meant to continue the gesture interrupted - ;; by the removal of the last, not to commence a new one. + ;; with relative-xy and its number with point-no, but leave + ;; other information (such as its starting position) intact: + ;; this touchpoint is meant to continue the gesture + ;; interrupted by the removal of the last, not to commence a + ;; new one. (setcar touch-screen-current-tool point-no) (setcar (nthcdr 2 touch-screen-current-tool) - (touch-screen-relative-xy posn window)) + relative-xy) (setcar (nthcdr 9 touch-screen-current-tool) - (touch-screen-relative-xy posn window))) + relative-xy)) (setq touch-screen-aux-tool nil)) (let ((what (nth 3 touch-screen-current-tool)) (posn (cdr point)) window point) @@ -1522,7 +1526,15 @@ touch-screen-handle-touch ;; down-mouse-1 button beneath its first press. (unless (memq (nth 3 touch-screen-current-tool) '(mouse-drag mouse-1-menu)) - (setcar (nthcdr 3 touch-screen-current-tool) nil)))) + ;; Set the what field to the symbol `ancillary-tool' + ;; rather than nil, that mouse events may not be + ;; generated if no gesture is subsequently + ;; recognized; this, among others, prevents + ;; undesirable point movement (through the execution + ;; of `mouse-set-point') after both points are + ;; released without any gesture being detected. + (setcar (nthcdr 3 touch-screen-current-tool) + 'ancillary-tool)))) ;; Replace any previously ongoing gesture. If POSITION has no ;; window or position, make it nil instead. (setq tool-list (and (windowp window) @@ -1644,14 +1656,15 @@ touch-screen-handle-touch ;; further action is required, for the next update received will ;; resume regular gesture recognition. ;; - ;; The what field in touch-screen-current-tool is cleared when - ;; the ancillary tool is pressed, so gesture recognition will - ;; commence with a clean slate, save for when the first touch - ;; landed atop a menu or some other area down-mouse-1 was bound. + ;; The what field in touch-screen-current-tool is set to a + ;; signal value when the ancillary tool is pressed, so gesture + ;; recognition will commence with a clean slate, save for when + ;; the first touch landed atop a menu or some other area + ;; down-mouse-1 was bound. ;; ;; Gesture recognition will be inhibited in that case, so that - ;; menu bar or mouse motion events are generated in its place as - ;; they would be were no ancillary tool ever pressed. + ;; mouse menu or mouse motion events are generated in its place + ;; as they would be were no ancillary tool ever pressed. (when (and touch-screen-aux-tool (eq (caadr event) (aref touch-screen-aux-tool 0))) (setq touch-screen-aux-tool nil)) commit 076c5f1f173f034e45ed3f22a7a92305ee8204de Author: Po Lu Date: Thu Nov 16 17:38:53 2023 +0800 Don't pan horizontally when a pinch gesture represents a shrink * lisp/touch-screen.el (touch-screen-pinch): Don't pan left if the event represents a shrink. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index d7f095629cc..e9cd5ca4fd3 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -952,7 +952,7 @@ touch-screen-pinch ;; and Emacs can hscroll left even when no lines are ;; truncated. (unless (and (< x-accumulator 0) - (< ratio-diff -0.2)) + (< ratio-diff 0)) (if (> x-accumulator 0) (scroll-right 1) (scroll-left 1))) commit dd0f009c5157a3a05cb9f5919e5269d4fb6a97d6 Author: Po Lu Date: Thu Nov 16 17:31:04 2023 +0800 ; Commit omitted change * lisp/completion-preview.el (completion-preview-commands): Substitute analyze-text-conversion for text-conversion, as this list enumerates commands, not events. diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 4258e6bbf3c..6048d5be272 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -81,7 +81,7 @@ completion-preview-commands insert-char delete-backward-char backward-delete-char-untabify - text-conversion) + analyze-text-conversion) "List of commands that should trigger completion preview." :type '(repeat (function :tag "Command" :value self-insert-command)) :version "30.1") commit 46c2fffd891ae4392f6d5d2ec4a68011c06aa37d Author: Andrea Corallo Date: Thu Nov 16 10:19:20 2023 +0100 Clean-up some native-comp advice special handling. * lisp/emacs-lisp/nadvice.el (advice--add-function): Clean-up nativecomp special handling. * lisp/emacs-lisp/advice.el (ad-add-advice): Likewise. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 2a668f6ce0e..a6974e07cb2 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2067,9 +2067,6 @@ ad-add-advice If FUNCTION was not advised already, its advice info will be initialized. Redefining a piece of advice whose name is part of the cache-id will clear the cache." - (when (and (featurep 'native-compile) - (subr-primitive-p (symbol-function function))) - (comp-subr-trampoline-install function)) (cond ((not (ad-is-advised function)) (ad-initialize-advice-info function) (ad-set-advice-info-field diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 6c5b11d2bd4..42027c01491 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -391,23 +391,6 @@ add-function ;;;###autoload (defun advice--add-function (how ref function props) - (when (and (featurep 'native-compile) - (subr-primitive-p (gv-deref ref))) - (let ((subr-name (intern (subr-name (gv-deref ref))))) - ;; Requiring the native compiler to advice `macroexpand' cause a - ;; circular dependency in eager macro expansion. uniquify is - ;; advising `rename-buffer' while being loaded in loadup.el. - ;; This would require the whole native compiler machinery but we - ;; don't want to include it in the dump. Because these two - ;; functions are already handled in - ;; `native-comp-never-optimize-functions' we hack the problem - ;; this way for now :/ - (unless (memq subr-name '(macroexpand rename-buffer)) - ;; Must require explicitly as during bootstrap we have no - ;; autoloads. - (require 'comp-run) - (declare-function comp-subr-trampoline-install "comp-run") - (comp-subr-trampoline-install subr-name)))) (let* ((name (cdr (assq 'name props))) (a (advice--member-p (or name function) (if name t) (gv-deref ref)))) (when a commit 42181b65df165d3cbf472f7c9aa1f1b14ecf9a52 Author: Eli Zaretskii Date: Thu Nov 16 11:30:48 2023 +0200 ; * src/editfns.c (Fline_beginning_position): Doc fix. diff --git a/src/editfns.c b/src/editfns.c index 211f1a03bee..46af4a60c7e 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -723,6 +723,7 @@ DEFUN ("pos-bol", Fpos_bol, Spos_bol, 0, 1, 0, DEFUN ("line-beginning-position", Fline_beginning_position, Sline_beginning_position, 0, 1, 0, doc: /* Return the position of the first character in the current line/field. +With optional argument N non-nil, move forward N - 1 lines first. This function is like `pos-bol' (which see), but respects fields. This function constrains the returned position to the current field commit 6733f45383bc1f57860d98803391cda076ed7cbb Author: Eli Zaretskii Date: Thu Nov 16 11:22:58 2023 +0200 Fix scrolling when continuation line starts with a display string * src/xdisp.c (start_display): Compute continuation_lines_width for starting display in strings and images as well. (Bug#67201) diff --git a/src/xdisp.c b/src/xdisp.c index 041c7adfc50..2dbe85f0f04 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3766,18 +3766,25 @@ start_display (struct it *it, struct window *w, struct text_pos pos) /* Don't reseat to previous visible line start if current start position is in a string or image. */ - if (it->method == GET_FROM_BUFFER && it->line_wrap != TRUNCATE) + if (it->line_wrap != TRUNCATE) { - int first_y = it->current_y; + enum it_method method = it->method; - /* If window start is not at a line start, skip forward to POS to - get the correct continuation lines width. */ + /* If window start is not at a line start, skip forward to POS + from the beginning of physical line to get the correct + continuation lines width. */ bool start_at_line_beg_p = (CHARPOS (pos) == BEGV || FETCH_BYTE (BYTEPOS (pos) - 1) == '\n'); if (!start_at_line_beg_p) { + int first_y = it->current_y; + int continuation_width; + void *itdata = NULL; + struct it it2; int new_x; + if (method != GET_FROM_BUFFER) + SAVE_IT (it2, *it, itdata); reseat_at_previous_visible_line_start (it); move_it_to (it, CHARPOS (pos), -1, -1, -1, MOVE_TO_POS); @@ -3824,6 +3831,17 @@ start_display (struct it *it, struct window *w, struct text_pos pos) else if (it->current.dpvec_index >= 0) it->current.dpvec_index = 0; + continuation_width = it->continuation_lines_width; + /* If we started from a position in something other than a + buffer, restore the original iterator state, keeping only + the continuation_lines_width, since we could now be very + far from the original position. */ + if (method != GET_FROM_BUFFER) + { + RESTORE_IT (it, &it2, itdata); + it->continuation_lines_width = continuation_width; + } + /* We're starting a new display line, not affected by the height of the continued line, so clear the appropriate fields in the iterator structure. */ commit 4a2d39020c299332004bb2de1a698c18df40fe02 Author: Andrea Corallo Date: Thu Nov 16 09:03:20 2023 +0100 * lisp/emacs-lisp/nadvice.el (advice--add-function): Move func decl. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 98efb4c9c28..6c5b11d2bd4 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -389,8 +389,6 @@ add-function `(advice--add-function ,how (gv-ref ,(advice--normalize-place place)) ,function ,props)) -(declare-function comp-subr-trampoline-install "comp-run") - ;;;###autoload (defun advice--add-function (how ref function props) (when (and (featurep 'native-compile) @@ -408,6 +406,7 @@ advice--add-function ;; Must require explicitly as during bootstrap we have no ;; autoloads. (require 'comp-run) + (declare-function comp-subr-trampoline-install "comp-run") (comp-subr-trampoline-install subr-name)))) (let* ((name (cdr (assq 'name props))) (a (advice--member-p (or name function) (if name t) (gv-deref ref)))) commit 7c65ccfc8011e59c39c72adbe604d6325dc5a434 Author: Juri Linkov Date: Thu Nov 16 09:25:23 2023 +0200 * lisp/mail/emacsbug.el (submit-emacs-patch): Use pop-to-buffer-same-window. This allows customization with 'display-buffer-alist' (bug#65387). diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index bebaad720db..409ef7165fe 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -509,7 +509,7 @@ submit-emacs-patch (list (read-string (format-prompt "This patch is about" guess) nil nil guess) file))) - (switch-to-buffer "*Patch Help*") + (pop-to-buffer-same-window "*Patch Help*") (let ((inhibit-read-only t)) (erase-buffer) (insert "Thank you for considering submitting a patch to the Emacs project.\n\n" commit d72c974fd62897575e577287f3aefdabb079198d Author: Eli Zaretskii Date: Thu Nov 16 08:55:08 2023 +0200 ; * lisp/simple.el (minibuffer-default-add-completions): Doc fix. diff --git a/lisp/simple.el b/lisp/simple.el index 02005e3b4f9..e73e37efcfa 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2990,8 +2990,8 @@ minibuffer-default-add-completions "Return a list of all completions without the default value. This function is used to add all elements of the completion table to the end of the list of defaults just after the default value. -When you don't want to add initial completions to the default value, -you can use either `minibuffer-setup-hook' or `minibuffer-with-setup-hook' +If you don't want to add initial completions to the default value, +use either `minibuffer-setup-hook' or `minibuffer-with-setup-hook' to set the value of `minibuffer-default-add-function' to nil." (let ((def minibuffer-default) ;; Avoid some popular completions with undefined order commit 5f3309f6b0fb6d0b485c6e1cc444aff0beb0919c Author: Eli Zaretskii Date: Thu Nov 16 08:24:13 2023 +0200 ; Improve indexing in ELisp manual * doc/lispref/tips.texi (Documentation Tips, Coding Conventions) (Key Binding Conventions, Programming Tips, Compilation Tips) (Warning Tips, Comment Tips, Library Headers): Improve indexing. diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index f760b2554f0..edc16181d19 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -43,6 +43,7 @@ Coding Conventions @section Emacs Lisp Coding Conventions @cindex coding conventions in Emacs Lisp +@cindex conventions for Emacs Lisp programs Here are conventions that you should follow when writing Emacs Lisp code intended for widespread use: @@ -264,6 +265,7 @@ Coding Conventions @node Key Binding Conventions @section Key Binding Conventions @cindex key binding, conventions for +@cindex conventions for key bindings @itemize @bullet @item @@ -345,6 +347,7 @@ Key Binding Conventions @node Programming Tips @section Emacs Programming Tips @cindex programming conventions +@cindex conventions for Emacs programming Following these conventions will make your program fit better into Emacs when it runs. @@ -477,6 +480,7 @@ Compilation Tips @section Tips for Making Compiled Code Fast @cindex execution speed @cindex speedups +@cindex tips for faster Lisp code Here are ways of improving the execution speed of byte-compiled Lisp programs. @@ -531,6 +535,7 @@ Compilation Tips @node Warning Tips @section Tips for Avoiding Compiler Warnings @cindex byte compiler warnings, how to avoid +@cindex warnings from byte compiler @itemize @bullet @item @@ -585,6 +590,8 @@ Warning Tips @node Documentation Tips @section Tips for Documentation Strings @cindex documentation strings, conventions and tips +@cindex tips for documentation strings +@cindex conventions for documentation strings @findex checkdoc-minor-mode Here are some tips and conventions for the writing of documentation @@ -915,6 +922,7 @@ Documentation Tips @node Comment Tips @section Tips on Writing Comments @cindex comments, Lisp convention for +@cindex conventions for Lisp comments We recommend these conventions for comments: @@ -1030,6 +1038,7 @@ Library Headers @section Conventional Headers for Emacs Libraries @cindex header comments @cindex library header comments +@cindex conventions for library header comments Emacs has conventions for using special comments in Lisp libraries to divide them into sections and give information such as who wrote commit dc61c0fd3ab1d8a869fd51998762467b09453091 Author: Stefan Monnier Date: Thu Nov 16 00:16:31 2023 -0500 todo-mode.el: Don't let-bind `buffer-read-only` Prefer let-binding `inhibit-read-only` so the code can freely change `buffer-read-only`. While at it, prefer #' to quote function names. * lisp/calendar/todo-mode.el (todo-rename-category) (todo-delete-category, todo-delete-item) (todo-edit-item--diary-inclusion, todo-edit-category-diary-inclusion) (todo-edit-category-diary-nonmarking, todo-archive-done-item) (todo-unarchive-items, todo-display-categories) (todo-update-categories-display, todo-filter-items-1) (todo-reset-nondiary-marker, todo-reset-done-separator-string) (todo-reset-done-string, todo-reset-comment-string): Bind `inhibit-read-only` instead of `buffer-read-only`. (todo-mode, todo-archive-mode, todo-edit-mode, todo-categories-mode) (todo-filtered-items-mode): Let `define-derived-mode` take care of adding the keymap to the docstring. (todo-mode, todo-archive-mode, todo-categories-mode) (todo-filtered-items-mode): Let `define-derived-mode` set `mode-class`. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index dbd1388848e..4f6a964eb4d 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -139,8 +139,8 @@ todo-done-separator-string string consists of more (or less) than one character, it will be the value of `todo-done-separator'." :type 'string - :initialize 'custom-initialize-default - :set 'todo-reset-done-separator-string + :initialize #'custom-initialize-default + :set #'todo-reset-done-separator-string :group 'todo-display) (defun todo-done-separator () @@ -170,8 +170,8 @@ todo-nondiary-marker the diary date." :type '(list string string) :group 'todo-edit - :initialize 'custom-initialize-default - :set 'todo-reset-nondiary-marker) + :initialize #'custom-initialize-default + :set #'todo-reset-nondiary-marker) (defconst todo-nondiary-start (nth 0 todo-nondiary-marker) "String inserted before item date to block diary inclusion.") @@ -248,8 +248,8 @@ todo-date-string-start (defcustom todo-done-string "DONE " "Identifying string appended to the front of done todo items." :type 'string - :initialize 'custom-initialize-default - :set 'todo-reset-done-string + :initialize #'custom-initialize-default + :set #'todo-reset-done-string :group 'todo-edit) (defconst todo-done-string-start @@ -275,16 +275,16 @@ todo-prefix (format-message "Invalid value: must be distinct from `todo-item-mark'")) widget))) - :initialize 'custom-initialize-default - :set 'todo-reset-prefix + :initialize #'custom-initialize-default + :set #'todo-reset-prefix :group 'todo-display) (defcustom todo-number-prefix t "Non-nil to prefix items with consecutively increasing integers. These reflect the priorities of the items in each category." :type 'boolean - :initialize 'custom-initialize-default - :set 'todo-reset-prefix + :initialize #'custom-initialize-default + :set #'todo-reset-prefix :group 'todo-display) (defun todo-mode-line-control (cat) @@ -306,8 +306,8 @@ todo-mode-line-function (defcustom todo-highlight-item nil "Non-nil means highlight items at point." :type 'boolean - :initialize 'custom-initialize-default - :set 'todo-reset-highlight-item + :initialize #'custom-initialize-default + :set #'todo-reset-highlight-item :group 'todo-display) (defcustom todo-wrap-lines t @@ -605,8 +605,8 @@ todo-show-current-file "Non-nil to make `todo-show' visit the current todo file. Otherwise, `todo-show' always visits `todo-default-todo-file'." :type 'boolean - :initialize 'custom-initialize-default - :set 'todo-set-show-current-file + :initialize #'custom-initialize-default + :set #'todo-set-show-current-file :group 'todo) (defcustom todo-show-first 'first @@ -1367,7 +1367,7 @@ todo-rename-category (list archive))))) (dolist (buf buffers) (with-current-buffer (find-file-noselect buf) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (setq todo-categories (todo-set-categories)) (save-excursion (save-restriction @@ -1415,7 +1415,7 @@ todo-delete-category "\"" (and arg " and all its entries") "? ")))) (widen) - (let ((buffer-read-only) + (let ((inhibit-read-only t) (beg (re-search-backward (concat "^" (regexp-quote (concat todo-category-beg cat)) "\n") @@ -1795,8 +1795,8 @@ todo-item-mark (defcustom todo-comment-string "COMMENT" "String inserted before optional comment appended to done item." :type 'string - :initialize 'custom-initialize-default - :set 'todo-reset-comment-string + :initialize #'custom-initialize-default + :set #'todo-reset-comment-string :group 'todo-edit) (defcustom todo-undo-item-omit-comment 'ask @@ -2077,7 +2077,7 @@ todo-set-date-from-calendar (todo-date-from-calendar (let (calendar-view-diary-initially-flag) (calendar)) ; *Calendar* is now current buffer. - (define-key calendar-mode-map [remap newline] 'exit-recursive-edit) + (define-key calendar-mode-map [remap newline] #'exit-recursive-edit) ;; If user exits Calendar before choosing a date, clean up properly. (define-key calendar-mode-map [remap calendar-exit] (lambda () @@ -2112,7 +2112,7 @@ todo-insert-item-from-calendar (calendar-exit) (todo-insert-item--basic arg nil todo-date-from-calendar)) -(define-key calendar-mode-map "it" 'todo-insert-item-from-calendar) +(define-key calendar-mode-map "it" #'todo-insert-item-from-calendar) (defun todo-delete-item () "Delete at least one item in this category. @@ -2133,7 +2133,7 @@ todo-delete-item (save-excursion (todo-item-end)))) (overlay-put ov 'face 'todo-search) (todo-y-or-n-p "Permanently delete this item? ")))) - buffer-read-only) + (inhibit-read-only t)) (when answer (and marked (goto-char (point-min))) (catch 'done @@ -2566,7 +2566,7 @@ todo-edit-item--header (defun todo-edit-item--diary-inclusion (&optional nonmarking) "Function providing diary marking facilities of `todo-edit-item'." - (let ((buffer-read-only) + (let ((inhibit-read-only t) (marked (assoc (todo-current-category) todo-categories-with-marks))) (when marked (todo--user-error-if-marked-done-item)) (catch 'stop @@ -2616,7 +2616,7 @@ todo-edit-category-diary-inclusion (goto-char (point-min)) (let ((todo-count (todo-get-count 'todo)) (diary-count (todo-get-count 'diary)) - (buffer-read-only)) + (inhibit-read-only t)) (catch 'stop (while (not (eobp)) (if (todo-done-item-p) ; We've gone too far. @@ -2652,7 +2652,7 @@ todo-edit-category-diary-nonmarking (interactive "P") (save-excursion (goto-char (point-min)) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (catch 'stop (while (not (eobp)) (if (todo-done-item-p) ; We've gone too far. @@ -3322,13 +3322,14 @@ todo-archive-done-item (with-current-buffer archive (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode)) (let ((headers-hidden todo--item-headers-hidden) - buffer-read-only) + (inhibit-read-only t)) (if headers-hidden (todo-toggle-item-header)) (widen) (goto-char (point-min)) (if (and (re-search-forward (concat "^" (regexp-quote - (concat todo-category-beg cat)) "$") + (concat todo-category-beg cat)) + "$") nil t) (re-search-forward (regexp-quote todo-category-done) nil t)) @@ -3420,7 +3421,7 @@ todo-unarchive-items (item (concat (todo-item-string) "\n")) (marked-count 0) marked-items - buffer-read-only) + (inhibit-read-only t)) (when marked (save-excursion (goto-char (point-min)) @@ -3432,7 +3433,7 @@ todo-unarchive-items ;; Restore items to top of category's done section and update counts. (with-current-buffer tbuf (let ((headers-hidden todo--item-headers-hidden) - buffer-read-only newcat) + (inhibit-read-only t) newcat) (if headers-hidden (todo-toggle-item-header)) (widen) (goto-char (point-min)) @@ -3922,7 +3923,7 @@ todo-display-categories (kill-all-local-variables) (todo-categories-mode) (let ((archive (member todo-current-todo-file todo-archives)) - buffer-read-only) + (inhibit-read-only t)) (erase-buffer) (insert (format (concat "Category counts for todo " (if archive "archive" "file") @@ -3961,7 +3962,7 @@ todo-update-categories-display (forward-line -2) (goto-char (next-single-char-property-change (point) 'face nil (line-end-position)))))) - (buffer-read-only)) + (inhibit-read-only t)) (forward-line 2) (delete-region (point) (point-max)) ;; Fill in the table with buttonized lines, each showing a category and @@ -4533,7 +4534,7 @@ todo-filter-items-1 (widen))) (setq bufstr (buffer-string)) (with-current-buffer buf - (let (buffer-read-only) + (let ((inhibit-read-only t)) (insert bufstr))))))) (set-window-buffer (selected-window) (set-buffer buf)) (todo-prefix-overlays) @@ -5900,7 +5901,7 @@ todo-y-or-n-p SPC to affirm the question only if option `todo-y-with-space' is non-nil." (unless todo-y-with-space - (define-key query-replace-map " " 'ignore)) + (define-key query-replace-map " " #'ignore)) (prog1 (y-or-n-p prompt) (define-key query-replace-map " " 'act))) @@ -6333,7 +6334,7 @@ todo-reset-nondiary-marker (dolist (f files) (let ((buf (find-buffer-visiting f))) (with-current-buffer (find-file-noselect f) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (widen) (goto-char (point-min)) (while (not (eobp)) @@ -6363,7 +6364,7 @@ todo-reset-done-separator-string (when (not (equal value oldvalue)) (dolist (f files) (with-current-buffer (find-file-noselect f) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (setq todo-done-separator (todo-done-separator)) (when (= 1 (length value)) (todo-reset-done-separator sep))) @@ -6382,7 +6383,7 @@ todo-reset-done-string (dolist (f files) (let ((buf (find-buffer-visiting f))) (with-current-buffer (find-file-noselect f) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (widen) (goto-char (point-min)) (while (not (eobp)) @@ -6408,7 +6409,7 @@ todo-reset-comment-string (dolist (f files) (let ((buf (find-buffer-visiting f))) (with-current-buffer (find-file-noselect f) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (widen) (goto-char (point-min)) (while (not (eobp)) @@ -6643,32 +6644,32 @@ todo-archive-mode-map (define-key map (nth 0 kb) (nth 1 kb))) (dolist (kb todo-key-bindings-t+a) (define-key map (nth 0 kb) (nth 1 kb))) - (define-key map "a" 'todo-jump-to-archive-category) - (define-key map "u" 'todo-unarchive-items) + (define-key map "a" #'todo-jump-to-archive-category) + (define-key map "u" #'todo-unarchive-items) map) "Todo Archive mode keymap.") (defvar todo-edit-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-x\C-q" 'todo-edit-quit) + (define-key map "\C-x\C-q" #'todo-edit-quit) map) "Todo Edit mode keymap.") (defvar todo-categories-mode-map (let ((map (make-sparse-keymap))) - (define-key map "c" 'todo-sort-categories-alphabetically-or-numerically) - (define-key map "t" 'todo-sort-categories-by-todo) - (define-key map "y" 'todo-sort-categories-by-diary) - (define-key map "d" 'todo-sort-categories-by-done) - (define-key map "a" 'todo-sort-categories-by-archived) - (define-key map "#" 'todo-set-category-number) - (define-key map "l" 'todo-lower-category) - (define-key map "r" 'todo-raise-category) - (define-key map "n" 'todo-next-button) - (define-key map "p" 'todo-previous-button) - (define-key map [tab] 'todo-next-button) - (define-key map [backtab] 'todo-previous-button) - (define-key map "q" 'todo-quit) + (define-key map "c" #'todo-sort-categories-alphabetically-or-numerically) + (define-key map "t" #'todo-sort-categories-by-todo) + (define-key map "y" #'todo-sort-categories-by-diary) + (define-key map "d" #'todo-sort-categories-by-done) + (define-key map "a" #'todo-sort-categories-by-archived) + (define-key map "#" #'todo-set-category-number) + (define-key map "l" #'todo-lower-category) + (define-key map "r" #'todo-raise-category) + (define-key map "n" #'todo-next-button) + (define-key map "p" #'todo-previous-button) + (define-key map [tab] #'todo-next-button) + (define-key map [backtab] #'todo-previous-button) + (define-key map "q" #'todo-quit) map) "Todo Categories mode keymap.") @@ -6678,8 +6679,8 @@ todo-filtered-items-mode-map (define-key map (nth 0 kb) (nth 1 kb))) (dolist (kb todo-key-bindings-t+f) (define-key map (nth 0 kb) (nth 1 kb))) - (define-key map "g" 'todo-go-to-source-item) - (define-key map [remap newline] 'todo-go-to-source-item) + (define-key map "g" #'todo-go-to-source-item) + (define-key map [remap newline] #'todo-go-to-source-item) map) "Todo Filtered Items mode keymap.") @@ -6835,13 +6836,9 @@ todo-modes-set-3 ;; (add-hook 'find-file-hook #'todo-display-as-todo-file nil t) ) -(put 'todo-mode 'mode-class 'special) - ;;;###autoload (define-derived-mode todo-mode special-mode "Todo" - "Major mode for displaying, navigating and editing todo lists. - -\\{todo-mode-map}" + "Major mode for displaying, navigating and editing todo lists." (if (called-interactively-p 'any) (message "%s" (substitute-command-keys @@ -6863,15 +6860,11 @@ todo-mode #'todo-reset-and-enable-done-separator nil t) (add-hook 'kill-buffer-hook #'todo-reset-global-current-todo-file nil t))) -(put 'todo-archive-mode 'mode-class 'special) - ;; If todo-mode is parent, all todo-mode key bindings appear to be ;; available in todo-archive-mode (e.g. shown by C-h m). ;;;###autoload (define-derived-mode todo-archive-mode special-mode "Todo-Arch" - "Major mode for archived todo categories. - -\\{todo-archive-mode-map}" + "Major mode for archived todo categories." (todo-modes-set-1) (todo-modes-set-2) (todo-modes-set-3) @@ -6879,9 +6872,7 @@ todo-archive-mode (setq-local todo-show-done-only t)) (define-derived-mode todo-edit-mode text-mode "Todo-Ed" - "Major mode for editing multiline todo items. - -\\{todo-edit-mode-map}" + "Major mode for editing multiline todo items." (todo-modes-set-1) (setq-local indent-line-function #'todo-indent) (if (> (buffer-size) (- (point-max) (point-min))) @@ -6894,12 +6885,8 @@ todo-edit-mode (setq-local todo-categories (todo-set-categories))) (setq buffer-read-only nil)) -(put 'todo-categories-mode 'mode-class 'special) - (define-derived-mode todo-categories-mode special-mode "Todo-Cats" - "Major mode for displaying and editing todo categories. - -\\{todo-categories-mode-map}" + "Major mode for displaying and editing todo categories." (setq-local todo-current-todo-file todo-global-current-todo-file) (setq-local todo-categories ;; Can't use find-buffer-visiting when @@ -6910,13 +6897,9 @@ todo-categories-mode todo-current-todo-file 'nowarn) todo-categories))) -(put 'todo-filtered-items-mode 'mode-class 'special) - ;;;###autoload (define-derived-mode todo-filtered-items-mode special-mode "Todo-Fltr" - "Mode for displaying and reprioritizing top priority Todo. - -\\{todo-filtered-items-mode-map}" + "Mode for displaying and reprioritizing top priority Todo." (todo-modes-set-1) (todo-modes-set-2)) commit d03677343e9a54f76de7e3ac2db6e22df3fa4333 Author: Po Lu Date: Thu Nov 16 11:29:58 2023 +0800 Pan during touch screen pinch gestures * doc/lispref/commands.texi (Touchscreen Events): Document new ratio-diff parameter to touchscreen-pinch events. * lisp/completion-preview.el (completion-preview-commands): Account text-conversion events preview commands as well. * lisp/touch-screen.el (touch-screen-aux-tool): Introduce two new elements. (touch-screen-pinch): Scroll window in accord with event deltas. (touch-screen-handle-aux-point-update): Supply the ratio difference in generated events. (touch-screen-handle-touch): Create a vector with those two new elements. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index fd80a02e904..f6462a9e50b 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2209,7 +2209,7 @@ Touchscreen Events the initial @code{touchscreen-begin} event within that touch sequence. @cindex @code{touchscreen-pinch} event -@item (touchscreen-pinch @var{posn} @var{ratio} @var{pan-x} @var{pan-y}) +@item (touchscreen-pinch @var{posn} @var{ratio} @var{pan-x} @var{pan-y} @var{ratio-diff}) This event is delivered upon significant changes to the positions of either active touch point when an ancillary tool is active. @@ -2226,6 +2226,10 @@ Touchscreen Events that no such event exists, the centerpoint between both touch points when the ancillary tool was first registered. +@var{ratio-diff} is the difference between this event's ratio and +@var{ratio} in the last event delivered; it is @var{ratio} if no such +event exists. + Such events are sent when the magnitude of the changes they represent will yield a @var{ratio} which differs by more than @code{0.2} from that in the previous event, or the sum of @var{pan-x} and @var{pan-y} diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index a6e6e10c034..4258e6bbf3c 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -80,7 +80,8 @@ completion-preview-exact-match-only (defcustom completion-preview-commands '(self-insert-command insert-char delete-backward-char - backward-delete-char-untabify) + backward-delete-char-untabify + text-conversion) "List of commands that should trigger completion preview." :type '(repeat (function :tag "Command" :value self-insert-command)) :version "30.1") diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 605ae475257..d7f095629cc 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -52,7 +52,7 @@ touch-screen-current-tool (defvar touch-screen-aux-tool nil "The ancillary tool being tracked, or nil. -If non-nil, this is a vector of eight elements: the ID of the +If non-nil, this is a vector of ten elements: the ID of the touch point being tracked, the window where the touch began, a cons holding the initial position of the touch point, and the last known position of the touch point, all in the same format as @@ -60,8 +60,8 @@ touch-screen-aux-tool the current tool and the aformentioned initial position, the center of the line formed between those two points, the ratio between the present distance between both tools and the aforesaid -initial distance when a pinch gesture was last sent, and an -element into which commands can save data particular to a tool. +initial distance when a pinch gesture was last sent, and three +elements into which commands can save data particular to a tool. The ancillary tool is a second tool whose movement is interpreted in unison with that of the current tool to recognize gestures @@ -914,19 +914,50 @@ touch-screen-pinch (start-scale (or (aref touch-screen-aux-tool 7) (aset touch-screen-aux-tool 7 current-scale))) - (scale (nth 2 event))) - (with-selected-window window - ;; Set the text scale. - (text-scale-set (+ start-scale - (round (log scale text-scale-mode-step)))) - ;; Subsequently move the row which was at the centrum to its Y - ;; position. TODO: pan by the deltas in EVENT when the text - ;; scale has not changed, and hscroll to the centrum as well. - (when (and (not (eq current-scale + (scale (nth 2 event)) + (ratio-diff (nth 5 event))) + (when (windowp window) + (with-selected-window window + ;; Set the text scale. + (text-scale-set (+ start-scale + (round (log scale text-scale-mode-step)))) + ;; Subsequently move the row which was at the centrum to its Y + ;; position. + (if (and (not (eq current-scale text-scale-mode-amount)) (posn-point posn)) - (touch-screen-scroll-point-to-y (posn-point posn) - (cdr (posn-x-y posn))))))) + (touch-screen-scroll-point-to-y (posn-point posn) + (cdr (posn-x-y posn))) + ;; Rather than scroll POSN's point to its old row, scroll the + ;; display by the Y axis deltas within EVENT. + (let ((height (window-default-line-height)) + (y-accumulator (or (aref touch-screen-aux-tool 8) 0))) + (setq y-accumulator (+ y-accumulator (nth 4 event))) + (when (or (> y-accumulator height) + (< y-accumulator (- height))) + (ignore-errors + (if (> y-accumulator 0) + (scroll-down 1) + (scroll-up 1))) + (setq y-accumulator 0)) + (aset touch-screen-aux-tool 8 y-accumulator)) + ;; Likewise for the X axis deltas. + (let ((width (frame-char-width)) + (x-accumulator (or (aref touch-screen-aux-tool 9) 0))) + (setq x-accumulator (+ x-accumulator (nth 3 event))) + (when (or (> x-accumulator width) + (< x-accumulator (- width))) + ;; Do not hscroll if the ratio has shrunk, for that is + ;; generally attended by the centerpoint moving left, + ;; and Emacs can hscroll left even when no lines are + ;; truncated. + (unless (and (< x-accumulator 0) + (< ratio-diff -0.2)) + (if (> x-accumulator 0) + (scroll-right 1) + (scroll-left 1))) + (setq x-accumulator 0)) + (aset touch-screen-aux-tool 9 x-accumulator))))))) (define-key global-map [touchscreen-pinch] #'touch-screen-pinch) @@ -1135,12 +1166,14 @@ touch-screen-handle-aux-point-update window by the factor so derived. Such events are lists formed as so illustrated: - (touchscreen-pinch CENTRUM RATIO PAN-X PAN-Y) + (touchscreen-pinch CENTRUM RATIO PAN-X PAN-Y RATIO-DIFF) in which CENTRUM is a posn representing the midpoint of a line -between the present locations of both tools, PAN-X is the number -of pixels on the X axis that centrum has moved since the last -event, and PAN-Y is that on the Y axis." +between the present locations of both tools, RATIO is the said +factor, PAN-X is the number of pixels on the X axis that centrum +has moved since the last event, PAN-Y is that on the Y axis, and +RATIO-DIFF is the difference between RATIO and the ratio in the +last such event." (let (this-point-position other-point-position (window (cadr touch-screen-current-tool))) @@ -1168,6 +1201,7 @@ touch-screen-handle-aux-point-update (initial-distance (aref touch-screen-aux-tool 4)) (initial-centrum (aref touch-screen-aux-tool 5))) (let* ((ratio (/ distance initial-distance)) + (ratio-diff (- ratio (aref touch-screen-aux-tool 6))) (diff (abs (- ratio (aref touch-screen-aux-tool 6)))) (centrum-diff (+ (abs (- (car initial-centrum) (car centrum))) @@ -1195,7 +1229,8 @@ touch-screen-handle-aux-point-update (- (car centrum) (car initial-centrum)) (- (cdr centrum) - (cdr initial-centrum)))))))))) + (cdr initial-centrum)) + ratio-diff)))))))) (defun touch-screen-window-selection-changed (frame) "Notice that FRAME's selected window has changed. @@ -1477,7 +1512,7 @@ touch-screen-handle-touch position relative-x-y computed-distance computed-centrum - 1.0 nil))) + 1.0 nil nil nil))) ;; When an auxiliary tool is pressed, any gesture ;; previously in progress must be terminated, so long ;; as it represents a gesture recognized from the commit ff1f82cbe3fa9aee354581f2798faaae7163ea44 Author: Juri Linkov Date: Wed Nov 15 19:52:10 2023 +0200 * lisp/simple.el (minibuffer-default-add-completions): Improve (bug#64656). Return nil for some popular completions with undefined order that include obarray. Extend the docstring to explain how to disable this feature. diff --git a/lisp/simple.el b/lisp/simple.el index f86b3f9e208..02005e3b4f9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2989,11 +2989,17 @@ minibuffer-default-add-done (defun minibuffer-default-add-completions () "Return a list of all completions without the default value. This function is used to add all elements of the completion table to -the end of the list of defaults just after the default value." +the end of the list of defaults just after the default value. +When you don't want to add initial completions to the default value, +you can use either `minibuffer-setup-hook' or `minibuffer-with-setup-hook' +to set the value of `minibuffer-default-add-function' to nil." (let ((def minibuffer-default) - (all (all-completions "" - minibuffer-completion-table - minibuffer-completion-predicate))) + ;; Avoid some popular completions with undefined order + (all (unless (memq minibuffer-completion-table + `(help--symbol-completion-table ,obarray)) + (all-completions "" + minibuffer-completion-table + minibuffer-completion-predicate)))) (if (listp def) (append def all) (cons def (delete def all))))) commit 94763aa52112b4fc72ba5dfda2df558d6034fac8 Author: Juri Linkov Date: Wed Nov 15 19:44:04 2023 +0200 Enable completion-in-region-mode in minibuffer-complete-history/defaults * lisp/minibuffer.el (minibuffer-complete-history) (minibuffer-complete-defaults): Let-bind completion-in-region-mode-predicate to lambda that checks if the "*Completions*" buffer window is visible. This enables completion-in-region-mode that supports arrows with minibuffer-visible-completions. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 9f4ac704599..9ca3ecdf542 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4727,13 +4727,15 @@ minibuffer-complete-history history) (user-error "No history available")))) ;; FIXME: Can we make it work for CRM? - (completion-in-region - (minibuffer--completion-prompt-end) (point-max) - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity) - (cycle-sort-function . identity)) - (complete-with-action action completions string pred)))))) + (let ((completion-in-region-mode-predicate + (lambda () (get-buffer-window "*Completions*" 0)))) + (completion-in-region + (minibuffer--completion-prompt-end) (point-max) + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (display-sort-function . identity) + (cycle-sort-function . identity)) + (complete-with-action action completions string pred))))))) (defun minibuffer-complete-defaults () "Complete minibuffer defaults as far as possible. @@ -4744,7 +4746,9 @@ minibuffer-complete-defaults (functionp minibuffer-default-add-function)) (setq minibuffer-default-add-done t minibuffer-default (funcall minibuffer-default-add-function))) - (let ((completions (ensure-list minibuffer-default))) + (let ((completions (ensure-list minibuffer-default)) + (completion-in-region-mode-predicate + (lambda () (get-buffer-window "*Completions*" 0)))) (completion-in-region (minibuffer--completion-prompt-end) (point-max) (lambda (string pred action) commit 579ea5f6e2475b880737ba157a6629ab92c1138c Author: Juri Linkov Date: Wed Nov 15 19:37:30 2023 +0200 * lisp/minibuffer.el (minibuffer-completion-help): Fix base-suffix for region. When used with completion-in-region where completion-in-region-mode-predicate is non-nil, start base-suffix from point (bug#62700). diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 07a284134d6..9f4ac704599 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2405,9 +2405,14 @@ minibuffer-completion-help (base-prefix (buffer-substring (minibuffer--completion-prompt-end) (+ start base-size))) (base-suffix - (if (eq (alist-get 'category (cdr md)) 'file) - (buffer-substring (save-excursion (or (search-forward "/" nil t) (point-max))) - (point-max)) + (if (or (eq (alist-get 'category (cdr md)) 'file) + completion-in-region-mode-predicate) + (buffer-substring + (save-excursion + (if completion-in-region-mode-predicate + (point) + (or (search-forward "/" nil t) (point-max)))) + (point-max)) "")) (all-md (completion--metadata (buffer-substring-no-properties start (point)) commit e82d807a2845673e2d55a27915661b2f1374b89a Author: Eshel Yaron Date: Thu Nov 2 16:58:31 2023 +0100 Add Completion Preview mode This adds a new minor mode, 'completion-preview-mode', that displays in-buffer completion suggestions with an inline "preview" overlay. (Bug#66948) * lisp/completion-preview.el: New file. * doc/emacs/programs.texi (Symbol Completion): Document it. * etc/NEWS: Announce it. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 7746bc8bc23..3f3801abdb4 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1701,6 +1701,17 @@ Symbol Completion In Text mode and related modes, @kbd{M-@key{TAB}} completes words based on the spell-checker's dictionary. @xref{Spelling}. +@cindex completion preview +@cindex preview completion +@cindex suggestion preview +@cindex Completion Preview mode +@findex completion-preview-mode + Completion Preview mode is a minor mode that shows completion +suggestions as you type. When you enable this mode (with @kbd{M-x +completion-preview-mode}), Emacs automatically displays the +suggested completion for text around point as an in-line preview +right after point; type @key{TAB} to accept the suggestion. + @node MixedCase Words @section MixedCase Words @cindex camel case diff --git a/etc/NEWS b/etc/NEWS index 22a08bc97ea..23f4a8b5311 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1078,6 +1078,12 @@ It highlights parens via ‘show-paren-mode’ and ‘blink-matching-paren’ in a user-friendly way, avoids reporting alleged paren mismatches and makes sexp navigation more intuitive. ++++ +*** New minor mode 'completion-preview-mode'. +This minor mode shows you symbol completion suggestions as you type, +using an inline preview. New user options in the 'completion-preview' +customization group control exactly when Emacs displays this preview. + --- ** The highly accessible Modus themes collection has eight items. The 'modus-operandi' and 'modus-vivendi' are the main themes that have diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el new file mode 100644 index 00000000000..a6e6e10c034 --- /dev/null +++ b/lisp/completion-preview.el @@ -0,0 +1,336 @@ +;;; completion-preview.el --- Preview completion with inline overlay -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Eshel Yaron +;; Maintainer: Eshel Yaron +;; Keywords: abbrev convenience + +;; 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 library provides the Completion Preview mode. This minor mode +;; displays the top completion candidate for the symbol at point in an +;; overlay after point. Check out the customization group +;; `completion-preview' for user options that you may want to tweak. +;; +;; To accept the completion suggestion, press TAB. If you want to +;; ignore a completion suggestion, just go on editing or moving around +;; the buffer. Completion Preview mode continues to update the +;; suggestion as you type according to the text around point. +;; +;; The commands `completion-preview-next-candidate' and +;; `completion-preview-prev-candidate' allow you to cycle the +;; completion candidate that the preview suggests. These commands +;; don't have a default keybinding, but you can bind them, for +;; example, to M-n and M-p in `completion-preview-active-mode-map' to +;; have them handy whenever the preview is visible. +;; +;; If you set the user option `completion-preview-exact-match-only' to +;; non-nil, Completion Preview mode only suggests a completion +;; candidate when its the only possible completion for the (partial) +;; symbol at point. The user option `completion-preview-commands' +;; says which commands should trigger the completion preview. The +;; user option `completion-preview-minimum-symbol-length' specifies a +;; minimum number of consecutive characters with word or symbol syntax +;; that should appear around point for Emacs to suggest a completion. +;; By default, this option is set to 3, so Emacs suggests a completion +;; if you type "foo", but typing just "fo" doesn't show the preview. +;; +;; The user option `completion-preview-insert-on-completion' controls +;; what happens when you invoke `completion-at-point' while the +;; completion preview is visible. By default this option is nil, +;; which tells `completion-at-point' to ignore the completion preview +;; and show the list of completion candidates as usual. If you set +;; `completion-preview-insert-on-completion' to non-nil, then +;; `completion-at-point' inserts the preview directly without looking +;; for more candidates. + +;;; Code: + +(defgroup completion-preview nil + "In-buffer completion preview." + :group 'completion) + +(defcustom completion-preview-exact-match-only nil + "Whether to show completion preview only when there is an exact match. + +If this option is non-nil, Completion Preview mode only shows the +preview when there is exactly one completion candidate that +matches the symbol at point. Otherwise, if this option is nil, +when there are multiple matching candidates the preview shows the +first candidate, and you can cycle between the candidates with +\\[completion-preview-next-candidate] and +\\[completion-preview-prev-candidate]." + :type 'boolean + :version "30.1") + +(defcustom completion-preview-commands '(self-insert-command + insert-char + delete-backward-char + backward-delete-char-untabify) + "List of commands that should trigger completion preview." + :type '(repeat (function :tag "Command" :value self-insert-command)) + :version "30.1") + +(defcustom completion-preview-minimum-symbol-length 3 + "Minimum length of the symbol at point for showing completion preview." + :type 'natnum + :version "30.1") + +(defcustom completion-preview-insert-on-completion nil + "Whether \\[completion-at-point] inserts the previewed suggestion." + :type 'boolean + :version "30.1") + +(defvar completion-preview-sort-function #'minibuffer--sort-by-length-alpha + "Sort function to use for choosing a completion candidate to preview.") + +(defface completion-preview + '((t :inherit shadow)) + "Face for completion preview overlay." + :version "30.1") + +(defface completion-preview-exact + '((((supports :underline t)) + :underline t :inherit completion-preview) + (((supports :weight bold)) + :weight bold :inherit completion-preview) + (t :background "gray")) + "Face for exact completion preview overlay." + :version "30.1") + +(defvar-keymap completion-preview-active-mode-map + :doc "Keymap for Completion Preview Active mode." + "C-i" #'completion-preview-insert + ;; "M-n" #'completion-preview-next-candidate + ;; "M-p" #'completion-preview-prev-candidate + ) + +(defvar-local completion-preview--overlay nil) + +(defvar completion-preview--internal-commands + '(completion-preview-next-candidate completion-preview-prev-candidate) + "List of commands that manipulate the completion preview.") + +(defsubst completion-preview--internal-command-p () + "Return non-nil if `this-command' manipulates the completion preview." + (memq this-command completion-preview--internal-commands)) + +(defsubst completion-preview-require-certain-commands () + "Check if `this-command' is one of `completion-preview-commands'." + (or (completion-preview--internal-command-p) + (memq this-command completion-preview-commands))) + +(defun completion-preview-require-minimum-symbol-length () + "Check if the length of symbol at point is at least above a certain threshold. +`completion-preview-minimum-symbol-length' determines that threshold." + (let ((bounds (bounds-of-thing-at-point 'symbol))) + (and bounds (<= completion-preview-minimum-symbol-length + (- (cdr bounds) (car bounds)))))) + +(defun completion-preview-hide () + "Hide the completion preview." + (when completion-preview--overlay + (delete-overlay completion-preview--overlay) + (setq completion-preview--overlay nil))) + +(defun completion-preview--make-overlay (pos string) + "Make a new completion preview overlay at POS showing STRING." + (if completion-preview--overlay + (move-overlay completion-preview--overlay pos pos) + (setq completion-preview--overlay (make-overlay pos pos)) + (overlay-put completion-preview--overlay 'window (selected-window))) + (let ((previous (overlay-get completion-preview--overlay 'after-string))) + (unless (and previous (string= previous string)) + (add-text-properties 0 1 '(cursor 1) string) + (overlay-put completion-preview--overlay 'after-string string)) + completion-preview--overlay)) + +(defun completion-preview--get (prop) + "Return property PROP of the completion preview overlay." + (overlay-get completion-preview--overlay prop)) + +(define-minor-mode completion-preview-active-mode + "Mode for when the completion preview is shown." + :interactive nil + (if completion-preview-active-mode + (add-hook 'completion-at-point-functions #'completion-preview--insert -1 t) + (remove-hook 'completion-at-point-functions #'completion-preview--insert t) + (completion-preview-hide))) + +(defun completion-preview--exit-function (func) + "Return an exit function that hides the completion preview and calls FUNC." + (lambda (&rest args) + (completion-preview-active-mode -1) + (when (functionp func) (apply func args)))) + +(defun completion-preview--update () + "Update completion preview." + (seq-let (beg end table &rest plist) + (let ((completion-preview-insert-on-completion nil)) + (run-hook-with-args-until-success 'completion-at-point-functions)) + (when (and beg end table) + (let* ((pred (plist-get plist :predicate)) + (exit-fn (completion-preview--exit-function + (plist-get plist :exit-function))) + (string (buffer-substring beg end)) + (md (completion-metadata string table pred)) + (sort-fn (or (completion-metadata-get md 'cycle-sort-function) + (completion-metadata-get md 'display-sort-function) + completion-preview-sort-function)) + (all (let ((completion-lazy-hilit t)) + (completion-all-completions string table pred + (- (point) beg) md))) + (last (last all)) + (base (or (cdr last) 0)) + (bbeg (+ beg base)) + (prefix (substring string base))) + (when last + (setcdr last nil) + (let* ((filtered (remove prefix (all-completions prefix all))) + (sorted (funcall sort-fn filtered)) + (multi (cadr sorted)) ; multiple candidates + (cand (car sorted))) + (when (and cand + (not (and multi + completion-preview-exact-match-only))) + (let* ((face (if multi + 'completion-preview + 'completion-preview-exact)) + (after (propertize (substring cand (length prefix)) + 'face face)) + (ov (completion-preview--make-overlay end after))) + (overlay-put ov 'completion-preview-beg bbeg) + (overlay-put ov 'completion-preview-end end) + (overlay-put ov 'completion-preview-index 0) + (overlay-put ov 'completion-preview-cands sorted) + (overlay-put ov 'completion-preview-exit-fn exit-fn) + (completion-preview-active-mode))))))))) + +(defun completion-preview--show () + "Show a new completion preview. + +Call `completion-at-point-functions' in order to obtain and +display a completion candidate for the text around point. + +If the preview is already shown, first check whether the +suggested candidate remains a valid completion for the text at +point. If so, update the preview according the new text at +point, otherwise hide it." + (when completion-preview-active-mode + ;; We were already showing a preview before this command, so we + ;; check if the text before point is still a prefix of the + ;; candidate that the preview suggested, and if so we first update + ;; existing preview according to the changes made by this command, + ;; and only then try to get a new candidate. This ensures that we + ;; 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)) + (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)) + ;; The previous preview is still applicable, update it. + (overlay-put (completion-preview--make-overlay + cur (propertize (substring cand (- cur beg)) + 'face face)) + 'completion-preview-end cur) + ;; The previous preview is no longer applicable, hide it. + (completion-preview-active-mode -1)))) + ;; Run `completion-at-point-functions' to get a new candidate. + (while-no-input (completion-preview--update))) + +(defun completion-preview--post-command () + "Create, update or delete completion preview post last command." + (if (and (completion-preview-require-certain-commands) + (completion-preview-require-minimum-symbol-length)) + ;; We should show the preview. + (or + ;; If we're called after a command that itself updates the + ;; preview, don't do anything. + (completion-preview--internal-command-p) + ;; Otherwise, show the preview. + (completion-preview--show)) + (completion-preview-active-mode -1))) + +(defun completion-preview--insert () + "Completion at point function for inserting the current preview. + +When `completion-preview-insert-on-completion' is nil, this +function returns nil. Completion Preview mode adds this function +to `completion-at-point-functions' when the preview is shown, +such that `completion-at-point' inserts the preview candidate if +and only if `completion-preview-insert-on-completion' is non-nil." + (when (and completion-preview-active-mode + completion-preview-insert-on-completion) + (list (completion-preview--get 'completion-preview-beg) + (completion-preview--get 'completion-preview-end) + (list (nth (completion-preview--get 'completion-preview-index) + (completion-preview--get 'completion-preview-cands))) + :exit-function (completion-preview--get 'completion-preview-exit-fn)))) + +(defun completion-preview-insert () + "Insert the completion candidate that the preview shows." + (interactive) + (let ((completion-preview-insert-on-completion t)) + (completion-at-point))) + +(defun completion-preview-prev-candidate () + "Cycle the candidate that the preview shows to the previous suggestion." + (interactive) + (completion-preview-next-candidate -1)) + +(defun completion-preview-next-candidate (direction) + "Cycle the candidate that the preview shows in direction DIRECTION. + +DIRECTION should be either 1 which means cycle forward, or -1 +which means cycle backward. Interactively, DIRECTION is the +prefix argument and defaults to 1." + (interactive "p") + (when completion-preview-active-mode + (let* ((beg (completion-preview--get 'completion-preview-beg)) + (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))) + (setq new (mod (+ new direction) len) str (nth new all))) + (let ((aft (propertize (substring str (- pos beg)) + 'face (if (< 1 len) + 'completion-preview + 'completion-preview-exact)))) + (add-text-properties 0 1 '(cursor 1) aft) + (overlay-put completion-preview--overlay 'completion-preview-index new) + (overlay-put completion-preview--overlay 'after-string aft))))) + +;;;###autoload +(define-minor-mode completion-preview-mode + "Show in-buffer completion preview as you type." + :lighter " CP" + (if completion-preview-mode + (add-hook 'post-command-hook #'completion-preview--post-command nil t) + (remove-hook 'post-command-hook #'completion-preview--post-command t) + (completion-preview-active-mode -1))) + +(provide 'completion-preview) +;;; completion-preview.el ends here commit 7cfe088bc35f14391014b4f93a784fdef412da9c Author: Spencer Baugh Date: Fri Nov 10 11:27:10 2023 -0500 Don't infinite loop in map-y-or-n-p if at the end of kmacro Previously, if map-y-or-n-p got -1 from read-event (indicating no input due to the end of a keyboard macro), it would just infinite loop. Now it behaves like other commands which use read-event/read-char/etc, and just errors when we try to look up -1 in our keymap and find nothing. Also, just for the sake of users, print a slightly prettier message when this happens. * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): Don't loop if we reach the end of a keyboard macro. (Bug#67046) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index cb1cc88e78f..fffb199e2ea 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -168,16 +168,14 @@ map-y-or-n-p (key-description (vector help-char))) (if minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) - (while (progn - (setq char (read-event)) - ;; If we get -1, from end of keyboard - ;; macro, try again. - (equal char -1))) + (setq char (read-event)) ;; Show the answer to the question. (message "%s(y, n, !, ., q, %sor %s) %s" prompt user-keys (key-description (vector help-char)) - (single-key-description char))) + (if (equal char -1) + "[end-of-keyboard-macro]" + (single-key-description char)))) (setq def (lookup-key map (vector char)))) (cond ((eq def 'exit) (setq next (lambda () nil))) commit 4e406bb4208175c50c26e513011f646b67191d2e Author: Morgan J. Smith Date: Sun Nov 12 12:31:39 2023 -0500 Fix CBZ file detection in doc-view-mode * lisp/doc-view.el (doc-view-set-doc-type): Fix CBZ file detection. (Bug#67133) This fix is almost identical to the previous fix for ODF file detection in bug#54947 which resulted in commit b3ff4905388834994ff26d9d033d6bc62b094c1c diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 427da557d23..5b807d26435 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -2085,7 +2085,7 @@ doc-view-set-doc-type ;; zip-archives, so that this same association is used for ;; cbz files. This is fine, as cbz files should be handled ;; like epub anyway. - ((looking-at "PK") '(epub odf)))))) + ((looking-at "PK") '(epub odf cbz)))))) (setq-local doc-view-doc-type (car (or (nreverse (seq-intersection name-types content-types #'eq)) commit 1a1f47e4a1fb70e6810f9eabd0f1826b71a2bcb0 Author: Eli Zaretskii Date: Wed Nov 15 15:58:17 2023 +0200 Fix 'tex-compile-commands' * lisp/textmodes/tex-mode.el (tex-compile-commands): Respect 'tex-start-options' better. (Bug#67030) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index a26e7b9c83a..d1644b5613e 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2133,6 +2133,7 @@ tex-compile-commands t "%r.pdf")) '("pdf" "xe" "lua")) ((concat tex-command + " " tex-start-options " " (if (< 0 (length tex-start-commands)) (shell-quote-argument tex-start-commands)) " %f") commit f554872997a2f8e4e8ad4342a4b0955bfc7ad3f4 Author: Spencer Baugh Date: Fri Nov 10 07:20:09 2023 -0500 Signal file-locked on lock conflict with noninteractive=t Previously we would signal a generic error on lock conflict when noninteractive=t. That meant that non-interactively handling a lock conflict would require catching all errors and checking the string in DATA. Now we just signal file-locked instead, which matches the interactive behavior when the user says "q" at the prompt. Also, when noninteractive, we signal before we write the prompt about the lock conflict. That prompt usually gets in the way of noninteractively handling and suppress lock conflict errors. The signal data contains all the necessary information, we don't need to write a separate message for noninteractive. * lisp/userlock.el (ask-user-about-lock): Signal file-locked on noninteractive lock conflict. (bug#66993) diff --git a/lisp/userlock.el b/lisp/userlock.el index 4623608f1db..91d5b7308dd 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -64,10 +64,11 @@ ask-user-about-lock (match-string 0 opponent))) opponent)) (while (null answer) + (when noninteractive + (signal 'file-locked (list file opponent "Cannot resolve lock conflict in batch mode"))) (message (substitute-command-keys "%s locked by %s: (\\`s', \\`q', \\`p', \\`?')? ") short-file short-opponent) - (if noninteractive (error "Cannot resolve lock conflict in batch mode")) (let ((tem (let ((inhibit-quit t) (cursor-in-echo-area t)) (prog1 (downcase (read-char)) commit 8b458aea86ccbba255cbc5e97d6426df1e8bc6d9 Author: Eli Zaretskii Date: Wed Nov 15 15:15:35 2023 +0200 Fix query-replace at EOB * lisp/replace.el (replace-match-maybe-edit): Avoid clobbering match-data with outdated buffer position. (Bug#67124) diff --git a/lisp/replace.el b/lisp/replace.el index 6b06e48c384..7fec54ecb27 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2644,8 +2644,11 @@ replace-match-maybe-edit (replace-match newtext fixedcase literal) ;; `query-replace' undo feature needs the beginning of the match position, ;; but `replace-match' may change it, for instance, with a regexp like "^". - ;; Ensure that this function preserves the match data (Bug#31492). - (set-match-data match-data) + ;; Ensure that this function preserves the beginning of the match position + ;; (bug#31492). But we need to avoid clobbering the end of the match with + ;; the original match-end position, since `replace-match' could have made + ;; that incorrect or even invalid (bug#67124). + (set-match-data (list (car match-data) (nth 1 (match-data)))) ;; `replace-match' leaves point at the end of the replacement text, ;; so move point to the beginning when replacing backward. (when backward (goto-char (nth 0 match-data))) commit 8fd26c03070dcf786276ea3a939ef74bfa05f5cb Merge: f054e9924cc 4913dc75576 Author: Eli Zaretskii Date: Wed Nov 15 15:10:04 2023 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 4913dc755766f240c6ef1d2de52422c2444c613b Author: Po Lu Date: Wed Nov 15 21:06:27 2023 +0800 ; * doc/lispref/commands.texi (Touchscreen Events): Correct typo. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 75685ffe5dc..fd80a02e904 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2227,7 +2227,7 @@ Touchscreen Events when the ancillary tool was first registered. Such events are sent when the magnitude of the changes they represent -will yield a @code{ratio} which differs by more than @code{0.2} from +will yield a @var{ratio} which differs by more than @code{0.2} from that in the previous event, or the sum of @var{pan-x} and @var{pan-y} will surpass half the frame's character width in pixels (@pxref{Frame Font}). commit a9a8d5e95992ab63a63305e2a0b2d2b36bb2c698 Author: Po Lu Date: Wed Nov 15 20:58:46 2023 +0800 Register ``pinch to zoom'' touch screen gestures * doc/emacs/input.texi (Touchscreens): Address pinch gestures. * doc/lispref/commands.texi (Touchscreen Events): Address touch screen pinch events and the process by which they are produced. * java/org/gnu/emacs/EmacsWindow.java (figureChange) : Supply pointer index to getX and getY, correcting a mistake where the first touch point's coordinate was saved here in lieu of the pointer that was pressed's. * lisp/touch-screen.el (touch-screen-current-tool): Revise doc string. (touch-screen-aux-tool): New variable. (touch-screen-scroll-point-to-y, touch-screen-pinch): New functions. (global-map): Bind [touchscreen-pinch] to touch-screen-pinch. (touch-screen-handle-point-update): Revise doc string; set new tenth field of t-s-c-t to POINT relative to its window, without regard to whether an event has been sent. (touch-screen-distance, touch-screen-centrum): New functions. (touch-screen-handle-aux-point-update): New function; generate and send touchscreen-pinch if need be. (touch-screen-handle-point-up): If an ancillary tool exists, transfer the information there into touch-screen-current-tool and clear t-s-a-t. (touch-screen-handle-touch): Call t-s-a-p-u as is proper; set t-s-a-t if a touchscreen-down event arrives and t-s-c-t is set. * src/androidterm.c (handle_one_android_event): Properly save the event's X and Y when a new touch point is registered. diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index 0dd7fca41cc..e4d595caf84 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -62,6 +62,13 @@ Touchscreens if @code{mouse-1} were to be held down and a mouse moved analogously. @xref{Mouse Commands}. +@item +@cindex pinching, touchscreens + @dfn{Pinching}, which is placing two tools apart on the screen and +adjusting their position such as to increase or decrease the distance +between them will modify the text scale (@xref{Text Scale}) in +proportion to the change in that distance. + @vindex touch-screen-word-select @cindex word selection mode, touchscreens To the detriment of text selection, it can prove challenging to diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 2518740ad3b..75685ffe5dc 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2106,8 +2106,9 @@ Touchscreen Events translate key sequences containing touch screen events into ordinary mouse events (@pxref{Mouse Events}.) Since Emacs doesn't support distinguishing events originating from separate mouse devices, it -assumes that only one touchpoint is active while translation takes -place; breaking this assumption may lead to unexpected behavior. +assumes that a maximum of two touchpoints are active while translation +takes place, and does not place any guarantees on the results of event +translation when that restriction is overstepped. Emacs applies two different strategies for translating touch events into mouse events, contingent on factors such as the commands bound to @@ -2159,6 +2160,15 @@ Touchscreen Events illustrated in the last paragraph if @code{down-mouse-1} is bound to a command whose name has the property @code{mouse-1-menu-command}. +@cindex pinch-to-zoom touchscreen gesture translation +When a second touch point is registered as a touch point is already +being translated, gesture translation is terminated, and the distance +from the second touch point (the @dfn{ancillary tool}) to the first is +measured. Subsequent motion from either of those touch points will +yield @code{touchscreen-pinch} events incorporating the ratio formed +by the distance between their new positions and the distance measured +at the outset, as illustrated in the following table. + @cindex touchscreen gesture events If touch gestures are detected during translation, one of the following input events may be generated: @@ -2197,6 +2207,30 @@ Touchscreen Events continuation of a ``drag-to-select'' gesture (subject to the aformentioned user option) with @var{posn} set to the position list of the initial @code{touchscreen-begin} event within that touch sequence. + +@cindex @code{touchscreen-pinch} event +@item (touchscreen-pinch @var{posn} @var{ratio} @var{pan-x} @var{pan-y}) +This event is delivered upon significant changes to the positions of +either active touch point when an ancillary tool is active. + +@var{posn} is a mouse position list for the midpoint of a line drawn +from the ancillary tool to the other touch point being observed. + +@var{ratio} is the distance between both touch points being observed +divided by that distance when the ancillary point was first +registered; which is to say, the scale of the ``pinch'' gesture. + +@var{pan-x} and @var{pan-y} are the difference between the pixel +position of @var{posn} and this position within the last event +delivered appertaining to this series of touch events, or in the case +that no such event exists, the centerpoint between both touch points +when the ancillary tool was first registered. + +Such events are sent when the magnitude of the changes they represent +will yield a @code{ratio} which differs by more than @code{0.2} from +that in the previous event, or the sum of @var{pan-x} and @var{pan-y} +will surpass half the frame's character width in pixels (@pxref{Frame +Font}). @end table @cindex handling touch screen events diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index d7a37a8d57f..013f09cb756 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -918,8 +918,8 @@ private static class Coordinate it in the map. */ pointerIndex = event.getActionIndex (); pointerID = event.getPointerId (pointerIndex); - coordinate = new Coordinate ((int) event.getX (0), - (int) event.getY (0), + coordinate = new Coordinate ((int) event.getX (pointerIndex), + (int) event.getY (pointerIndex), buttonForEvent (event), pointerID); pointerMap.put (pointerID, coordinate); diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 2e5a88da071..605ae475257 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -33,15 +33,41 @@ (defvar touch-screen-current-tool nil "The touch point currently being tracked, or nil. -If non-nil, this is a list of nine elements: the ID of the touch +If non-nil, this is a list of ten elements: the ID of the touch point being tracked, the window where the touch began, a cons -containing the last known position of the touch point, relative +holding the last registered position of the touch point, relative to that window, a field used to store data while tracking the -touch point, the initial position of the touchpoint, and another -four fields to used store data while tracking the touch point. +touch point, the initial position of the touchpoint, another four +fields to used store data while tracking the touch point, and the +last known position of the touch point. + See `touch-screen-handle-point-update' and `touch-screen-handle-point-up' for the meanings of the fourth -element.") +element. + +The third and last elements differ in that the former is not +modified until after a gesture is recognized in reaction to an +update, whereas the latter is updated upon each apposite +`touchscreen-update' event.") + +(defvar touch-screen-aux-tool nil + "The ancillary tool being tracked, or nil. +If non-nil, this is a vector of eight elements: the ID of the +touch point being tracked, the window where the touch began, a +cons holding the initial position of the touch point, and the +last known position of the touch point, all in the same format as +in `touch-screen-current-tool', the distance in pixels between +the current tool and the aformentioned initial position, the +center of the line formed between those two points, the ratio +between the present distance between both tools and the aforesaid +initial distance when a pinch gesture was last sent, and an +element into which commands can save data particular to a tool. + +The ancillary tool is a second tool whose movement is interpreted +in unison with that of the current tool to recognize gestures +comprising the motion of both such as \"pinch\" gestures, in +which the text scale is adjusted in proportion to the distance +between both tools.") (defvar touch-screen-set-point-commands '(mouse-set-point) "List of commands known to set the point. @@ -844,6 +870,68 @@ touch-screen-restart-drag +;; Pinch gesture. + +(defvar text-scale-mode) +(defvar text-scale-mode-amount) +(defvar text-scale-mode-step) + +(defun touch-screen-scroll-point-to-y (target-point target-y) + "Move the row surrounding TARGET-POINT to TARGET-Y. +Scroll the current window such that the position of TARGET-POINT +within it on the Y axis approaches TARGET-Y." + (condition-case nil + (let* ((last-point (point)) + (current-y (cadr (pos-visible-in-window-p target-point + nil t))) + (direction (if (if current-y + (< target-y current-y) + (< (window-start) target-point)) + -1 1))) + (while (< 0 (* direction (if current-y + (- target-y current-y) + (- (window-start) target-point)))) + (scroll-down direction) + (setq last-point (point)) + (setq current-y (cadr (pos-visible-in-window-p target-point nil t)))) + (unless (and (< direction 0) current-y) + (scroll-up direction) + (goto-char last-point))) + ;; Ignore BOB and EOB. + ((beginning-of-buffer end-of-buffer) nil))) + +(defun touch-screen-pinch (event) + "Scroll the window in the touchscreen-pinch event EVENT. +Pan the display by the pan deltas in EVENT, and adjust the +text scale by the ratio therein." + (interactive "e") + (require 'face-remap) + (let* ((posn (cadr event)) + (window (posn-window posn)) + (current-scale (if text-scale-mode + text-scale-mode-amount + 0)) + (start-scale (or (aref touch-screen-aux-tool 7) + (aset touch-screen-aux-tool 7 + current-scale))) + (scale (nth 2 event))) + (with-selected-window window + ;; Set the text scale. + (text-scale-set (+ start-scale + (round (log scale text-scale-mode-step)))) + ;; Subsequently move the row which was at the centrum to its Y + ;; position. TODO: pan by the deltas in EVENT when the text + ;; scale has not changed, and hscroll to the centrum as well. + (when (and (not (eq current-scale + text-scale-mode-amount)) + (posn-point posn)) + (touch-screen-scroll-point-to-y (posn-point posn) + (cdr (posn-x-y posn))))))) + +(define-key global-map [touchscreen-pinch] #'touch-screen-pinch) + + + ;; Touch screen event translation. The code here translates raw touch ;; screen events into `touchscreen-scroll' events and mouse events in ;; a ``DWIM'' fashion, consulting the keymaps at the position of the @@ -886,6 +974,11 @@ touch-screen-handle-point-update function with an input event tied to any gesture that is recognized. +Update the tenth element of `touch-screen-current-tool' with +POINT relative to the window it was placed on. Update the third +element in like fashion, once sufficient motion has accumulated +that an event is generated. + POINT must be the touch point currently being tracked as `touch-screen-current-tool'. @@ -899,7 +992,7 @@ touch-screen-handle-point-update If the fourth element of `touchscreen-current-tool' is `scroll', then generate a `touchscreen-scroll' event with the window that -qPOINT was initially placed upon, and pixel deltas describing how +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. @@ -918,16 +1011,17 @@ touch-screen-handle-point-update If the fourth element of `touch-screen-current-tool' is `drag', then move point to the position of POINT." - (let ((window (nth 1 touch-screen-current-tool)) - (what (nth 3 touch-screen-current-tool))) + (let* ((window (nth 1 touch-screen-current-tool)) + (what (nth 3 touch-screen-current-tool)) + (posn (cdr point)) + ;; Now get the position of X and Y relative to WINDOW. + (relative-xy + (touch-screen-relative-xy posn window))) + ;; Update the 10th field of the tool list with RELATIVE-XY. + (setcar (nthcdr 9 touch-screen-current-tool) relative-xy) (cond ((null what) - (let* ((posn (cdr point)) - (last-posn (nth 2 touch-screen-current-tool)) + (let* ((last-posn (nth 2 touch-screen-current-tool)) (original-posn (nth 4 touch-screen-current-tool)) - ;; Now get the position of X and Y relative to - ;; WINDOW. - (relative-xy - (touch-screen-relative-xy posn window)) (col (and (not (posn-area original-posn)) (car (posn-col-row original-posn (posn-window posn))))) @@ -966,12 +1060,7 @@ touch-screen-handle-point-update (when touch-screen-current-timer (cancel-timer touch-screen-current-timer) (setq touch-screen-current-timer nil)) - (let* ((posn (cdr point)) - (last-posn (nth 2 touch-screen-current-tool)) - ;; Now get the position of X and Y relative to - ;; WINDOW. - (relative-xy - (touch-screen-relative-xy posn window)) + (let* ((last-posn (nth 2 touch-screen-current-tool)) (diff-x (- (car last-posn) (car relative-xy))) (diff-y (- (cdr last-posn) (cdr relative-xy)))) (setcar (nthcdr 3 touch-screen-current-tool) @@ -1014,6 +1103,100 @@ touch-screen-handle-point-update ;; Generate a (touchscreen-drag POSN) event. (throw 'input-event (list 'touchscreen-drag posn))))))) +(defsubst touch-screen-distance (pos1 pos2) + "Compute the distance in pixels between POS1 and POS2. +Each is a coordinate whose car and cdr are respectively its X and +Y values." + (let ((v1 (- (cdr pos2) (cdr pos1))) + (v2 (- (car pos2) (car pos1)))) + (abs (sqrt (+ (* v1 v1) (* v2 v2)))))) + +(defsubst touch-screen-centrum (pos1 pos2) + "Compute the center of a line between the points POS1 and POS2. +Each, and value, is a coordinate whose car and cdr are +respectively its X and Y values." + (let ((v1 (+ (cdr pos2) (cdr pos1))) + (v2 (+ (car pos2) (car pos1)))) + (cons (/ v2 2) (/ v1 2)))) + +(defun touch-screen-handle-aux-point-update (point number) + "Notice that a point being observed has moved. +Register motion from either the current or ancillary tool while +an ancillary tool is present. + +POINT must be the cdr of an element of a `touchscreen-update' +event's list of touch points. NUMBER must be its touch ID. + +Calculate the distance between POINT's position and that of the +other tool (which is to say the ancillary tool of POINT is the +current tool, and vice versa). Compare this distance to that +between both points at the time they were placed on the screen, +and signal a pinch event to adjust the text scale and scroll the +window by the factor so derived. Such events are lists formed as +so illustrated: + + (touchscreen-pinch CENTRUM RATIO PAN-X PAN-Y) + +in which CENTRUM is a posn representing the midpoint of a line +between the present locations of both tools, PAN-X is the number +of pixels on the X axis that centrum has moved since the last +event, and PAN-Y is that on the Y axis." + (let (this-point-position + other-point-position + (window (cadr touch-screen-current-tool))) + (when (windowp window) + (if (eq number (aref touch-screen-aux-tool 0)) + (progn + ;; The point pressed is the ancillary tool. Set + ;; other-point-position to that of the current tool. + (setq other-point-position (nth 9 touch-screen-current-tool)) + ;; Update the position within touch-screen-aux-tool. + (aset touch-screen-aux-tool 3 + (setq this-point-position + (touch-screen-relative-xy point window)))) + (setq other-point-position (aref touch-screen-aux-tool 3)) + (setcar (nthcdr 2 touch-screen-current-tool) + (setq this-point-position + (touch-screen-relative-xy point window))) + (setcar (nthcdr 9 touch-screen-current-tool) + this-point-position)) + ;; Now compute, and take the absolute of, this distance. + (let ((distance (touch-screen-distance this-point-position + other-point-position)) + (centrum (touch-screen-centrum this-point-position + other-point-position)) + (initial-distance (aref touch-screen-aux-tool 4)) + (initial-centrum (aref touch-screen-aux-tool 5))) + (let* ((ratio (/ distance initial-distance)) + (diff (abs (- ratio (aref touch-screen-aux-tool 6)))) + (centrum-diff (+ (abs (- (car initial-centrum) + (car centrum))) + (abs (- (cdr initial-centrum) + (cdr centrum)))))) + ;; If the difference in ratio has surpassed a threshold of + ;; 0.2 or the centrum difference exceeds the frame's char + ;; width, send a touchscreen-pinch event with this + ;; information and update that saved in + ;; touch-screen-aux-tool. + (when (or (> diff 0.2) + (> centrum-diff + (/ (frame-char-width) 2))) + (aset touch-screen-aux-tool 5 centrum) + (aset touch-screen-aux-tool 6 ratio) + (throw 'input-event (list 'touchscreen-pinch + (if (or (<= (car centrum) 0) + (<= (cdr centrum) 0)) + (list window centrum nil nil nil + nil nil nil) + (posn-at-x-y (car centrum) + (cdr centrum) + window)) + ratio + (- (car centrum) + (car initial-centrum)) + (- (cdr centrum) + (cdr initial-centrum)))))))))) + (defun touch-screen-window-selection-changed (frame) "Notice that FRAME's selected window has changed. Cancel any timer that is supposed to hide the keyboard in @@ -1037,6 +1220,13 @@ touch-screen-handle-point-up PREFIX should be a virtual function key used to look up key bindings. +If an ancillary touch point is being observed, transfer touch +information from `touch-screen-aux-tool' to +`touch-screen-current-tool' and set it to nil, thereby resuming +gesture recognition with that tool replacing the tool removed. + +Otherwise: + If the fourth element of `touch-screen-current-tool' is nil or `restart-drag', move point to the position of POINT, selecting the window under POINT as well, and deactivate the mark; if there @@ -1061,140 +1251,161 @@ touch-screen-handle-point-up `touch-screen-set-point-commands' also display the on-screen keyboard if the current buffer and the character at the new point is not read-only." - (let ((what (nth 3 touch-screen-current-tool)) - (posn (cdr point)) window point) - (cond ((or (null what) - ;; If dragging has been restarted but the touch point - ;; hasn't been moved, translate the sequence into a - ;; regular mouse click. - (eq what 'restart-drag)) - (when (windowp (posn-window posn)) - (setq point (posn-point posn) - window (posn-window posn)) - ;; Select the window that was tapped given that it isn't - ;; an inactive minibuffer window. - (when (or (not (eq window - (minibuffer-window - (window-frame window)))) - (minibuffer-window-active-p window)) - (select-window window)) - ;; Now simulate a mouse click there. If there is a link - ;; or a button, use mouse-2 to push it. - (let* ((event (list (if (or (mouse-on-link-p posn) - (and point (button-at point))) - 'mouse-2 - 'mouse-1) - posn)) - ;; Look for the command bound to this event. - (command (key-binding (if prefix - (vector prefix - (car event)) - (vector (car event))) - t nil posn))) - (deactivate-mark) - (when point - ;; This is necessary for following links. - (goto-char point)) - ;; Figure out if the on screen keyboard needs to be - ;; displayed. - (when command - (if (memq command touch-screen-set-point-commands) - (if touch-screen-translate-prompt - ;; When a `mouse-set-point' command is - ;; encountered and - ;; `touch-screen-handle-touch' is being - ;; called from the keyboard command loop, - ;; call it immediately so that point is set - ;; prior to the on screen keyboard being - ;; displayed. - (call-interactively command nil - (vector event)) - (if (and (or (not buffer-read-only) - touch-screen-display-keyboard) - ;; Detect the splash screen and avoid - ;; displaying the on screen keyboard - ;; there. - (not (equal (buffer-name) "*GNU Emacs*"))) - ;; Once the on-screen keyboard has been - ;; opened, add - ;; `touch-screen-window-selection-changed' - ;; as a window selection change function - ;; This then prevents it from being hidden - ;; after exiting the minibuffer. - (progn - (add-hook 'window-selection-change-functions - #'touch-screen-window-selection-changed) - (frame-toggle-on-screen-keyboard (selected-frame) - nil)) - ;; Otherwise, hide the on screen keyboard - ;; now. - (frame-toggle-on-screen-keyboard (selected-frame) t)) - ;; But if it's being called from `describe-key' - ;; or some such, return it as a key sequence. - (throw 'input-event event))) - ;; If not, return the event. - (throw 'input-event event))))) - ((eq what 'mouse-drag) - ;; Generate a corresponding `mouse-1' event. - (let* ((new-window (posn-window posn)) - (new-point (posn-point posn)) - (old-posn (nth 4 touch-screen-current-tool)) - (old-window (posn-window posn)) - (old-point (posn-point posn))) + (if touch-screen-aux-tool + (progn + (let ((posn (cdr point)) + (window (cadr touch-screen-current-tool)) + (point-no (aref touch-screen-aux-tool 0))) + ;; Replace the current position of touch-screen-current-tool + ;; with posn and its number with point-no, but leave other + ;; information (such as its starting position) intact: this + ;; touchpoint is meant to continue the gesture interrupted + ;; by the removal of the last, not to commence a new one. + (setcar touch-screen-current-tool point-no) + (setcar (nthcdr 2 touch-screen-current-tool) + (touch-screen-relative-xy posn window)) + (setcar (nthcdr 9 touch-screen-current-tool) + (touch-screen-relative-xy posn window))) + (setq touch-screen-aux-tool nil)) + (let ((what (nth 3 touch-screen-current-tool)) + (posn (cdr point)) window point) + (cond ((or (null what) + ;; If dragging has been restarted but the touch point + ;; hasn't been moved, translate the sequence into a + ;; regular mouse click. + (eq what 'restart-drag)) + (when (windowp (posn-window posn)) + (setq point (posn-point posn) + window (posn-window posn)) + ;; Select the window that was tapped given that it + ;; isn't an inactive minibuffer window. + (when (or (not (eq window + (minibuffer-window + (window-frame window)))) + (minibuffer-window-active-p window)) + (select-window window)) + ;; Now simulate a mouse click there. If there is a + ;; link or a button, use mouse-2 to push it. + (let* ((event (list (if (or (mouse-on-link-p posn) + (and point (button-at point))) + 'mouse-2 + 'mouse-1) + posn)) + ;; Look for the command bound to this event. + (command (key-binding (if prefix + (vector prefix + (car event)) + (vector (car event))) + t nil posn))) + (deactivate-mark) + (when point + ;; This is necessary for following links. + (goto-char point)) + ;; Figure out if the on screen keyboard needs to be + ;; displayed. + (when command + (if (memq command touch-screen-set-point-commands) + (if touch-screen-translate-prompt + ;; When a `mouse-set-point' command is + ;; encountered and + ;; `touch-screen-handle-touch' is being + ;; called from the keyboard command loop, + ;; call it immediately so that point is set + ;; prior to the on screen keyboard being + ;; displayed. + (call-interactively command nil + (vector event)) + (if (and (or (not buffer-read-only) + touch-screen-display-keyboard) + ;; Detect the splash screen and + ;; avoid displaying the on screen + ;; keyboard there. + (not (equal (buffer-name) "*GNU Emacs*"))) + ;; Once the on-screen keyboard has been + ;; opened, add + ;; `touch-screen-window-selection-changed' + ;; as a window selection change function + ;; This then prevents it from being + ;; hidden after exiting the minibuffer. + (progn + (add-hook + 'window-selection-change-functions + #'touch-screen-window-selection-changed) + (frame-toggle-on-screen-keyboard + (selected-frame) nil)) + ;; Otherwise, hide the on screen keyboard + ;; now. + (frame-toggle-on-screen-keyboard (selected-frame) + t)) + ;; But if it's being called from `describe-key' + ;; or some such, return it as a key sequence. + (throw 'input-event event))) + ;; If not, return the event. + (throw 'input-event event))))) + ((eq what 'mouse-drag) + ;; Generate a corresponding `mouse-1' event. + (let* ((new-window (posn-window posn)) + (new-point (posn-point posn)) + (old-posn (nth 4 touch-screen-current-tool)) + (old-window (posn-window posn)) + (old-point (posn-point posn))) + (throw 'input-event + ;; If the position of the touch point hasn't + ;; changed, or it doesn't start or end on a + ;; window... + (if (and (not old-point) (not new-point)) + ;; Should old-point and new-point both equal + ;; nil, compare the posn areas and nominal + ;; column position. If either are + ;; different, generate a drag event. + (let ((new-col-row (posn-col-row posn)) + (new-area (posn-area posn)) + (old-col-row (posn-col-row old-posn)) + (old-area (posn-area old-posn))) + (if (and (equal new-col-row old-col-row) + (eq new-area old-area)) + ;; ... generate a mouse-1 event... + (list 'mouse-1 posn) + ;; ... otherwise, generate a + ;; drag-mouse-1 event. + (list 'drag-mouse-1 old-posn posn))) + (if (and (eq new-window old-window) + (eq new-point old-point) + (windowp new-window) + (windowp old-window)) + ;; ... generate a mouse-1 event... + (list 'mouse-1 posn) + ;; ... otherwise, generate a drag-mouse-1 + ;; event. + (list 'drag-mouse-1 old-posn posn)))))) + ((eq what 'mouse-1-menu) + ;; Generate a `down-mouse-1' event at the position the tap + ;; took place. (throw 'input-event - ;; If the position of the touch point hasn't - ;; changed, or it doesn't start or end on a - ;; window... - (if (and (not old-point) (not new-point)) - ;; Should old-point and new-point both equal - ;; nil, compare the posn areas and nominal - ;; column position. If either are different, - ;; generate a drag event. - (let ((new-col-row (posn-col-row posn)) - (new-area (posn-area posn)) - (old-col-row (posn-col-row old-posn)) - (old-area (posn-area old-posn))) - (if (and (equal new-col-row old-col-row) - (eq new-area old-area)) - ;; ... generate a mouse-1 event... - (list 'mouse-1 posn) - ;; ... otherwise, generate a drag-mouse-1 event. - (list 'drag-mouse-1 old-posn posn))) - (if (and (eq new-window old-window) - (eq new-point old-point) - (windowp new-window) - (windowp old-window)) - ;; ... generate a mouse-1 event... - (list 'mouse-1 posn) - ;; ... otherwise, generate a drag-mouse-1 event. - (list 'drag-mouse-1 old-posn posn)))))) - ((eq what 'mouse-1-menu) - ;; Generate a `down-mouse-1' event at the position the tap - ;; took place. - (throw 'input-event - (list 'down-mouse-1 - (nth 4 touch-screen-current-tool)))) - ((or (eq what 'drag) - ;; Merely initiating a drag is sufficient to select a - ;; word if word selection is enabled. - (eq what 'held)) - ;; Display the on screen keyboard if the region is now - ;; active. Check this within the window where the tool was - ;; first place. - (setq window (nth 1 touch-screen-current-tool)) - (when window - (with-selected-window window - (when (and (region-active-p) - (not buffer-read-only)) - ;; Once the on-screen keyboard has been opened, add - ;; `touch-screen-window-selection-changed' as a window - ;; selection change function This then prevents it from - ;; being hidden after exiting the minibuffer. - (progn - (add-hook 'window-selection-change-functions - #'touch-screen-window-selection-changed) - (frame-toggle-on-screen-keyboard (selected-frame) - nil))))))))) + (list 'down-mouse-1 + (nth 4 touch-screen-current-tool)))) + ((or (eq what 'drag) + ;; Merely initiating a drag is sufficient to select a + ;; word if word selection is enabled. + (eq what 'held)) + ;; Display the on screen keyboard if the region is now + ;; active. Check this within the window where the tool + ;; was first place. + (setq window (nth 1 touch-screen-current-tool)) + (when window + (with-selected-window window + (when (and (region-active-p) + (not buffer-read-only)) + ;; Once the on-screen keyboard has been opened, add + ;; `touch-screen-window-selection-changed' as a + ;; window selection change function. This then + ;; prevents it from being hidden after exiting the + ;; minibuffer. + (progn + (add-hook 'window-selection-change-functions + #'touch-screen-window-selection-changed) + (frame-toggle-on-screen-keyboard (selected-frame) + nil)))))))))) (defun touch-screen-handle-touch (event prefix &optional interactive) "Handle a single touch EVENT, and perform associated actions. @@ -1234,81 +1445,126 @@ touch-screen-handle-touch (when touch-screen-current-timer (cancel-timer touch-screen-current-timer) (setq touch-screen-current-timer nil)) - ;; Replace any previously ongoing gesture. If POSITION has no - ;; window or position, make it nil instead. - (setq tool-list (and (windowp window) - (list touchpoint window - (posn-x-y position) - nil position - nil nil nil nil)) - touch-screen-current-tool tool-list) - - ;; Select the window underneath the event as the checks below - ;; will look up keymaps and markers inside its buffer. - (save-selected-window - ;; Check if `touch-screen-extend-selection' is enabled, the - ;; tap lies on the point or the mark, and the region is - ;; active. If that's the case, set the fourth element of - ;; `touch-screen-current-tool' to `restart-drag', then - ;; generate a `touchscreen-restart-drag' event. - (when tool-list - ;; tool-list is always non-nil where the selected window - ;; matters. - (select-window window) - (when (and touch-screen-extend-selection - (or (eq point (point)) - (eq point (mark))) - (region-active-p) - ;; Only restart drag-to-select if the tap falls - ;; on the same row as the selection. This - ;; prevents dragging from starting if the tap - ;; is below the last window line with text and - ;; `point' is at ZV, as the user most likely - ;; meant to scroll the window instead. - (when-let* ((posn-point (posn-at-point point)) - (posn-row (cdr (posn-col-row posn-point)))) - (eq (cdr (posn-col-row position)) posn-row))) - ;; Indicate that a drag is about to restart. - (setcar (nthcdr 3 tool-list) 'restart-drag) - ;; Generate the `restart-drag' event. - (throw 'input-event (list 'touchscreen-restart-drag - position)))) - ;; Determine if there is a command bound to `down-mouse-1' - ;; at the position of the tap and that command is not a - ;; command whose functionality is replaced by the long-press - ;; mechanism. If so, set the fourth element of - ;; `touch-screen-current-tool' to `mouse-drag' and generate - ;; an emulated `mouse-1' event. - ;; - ;; If the command in question is a keymap, set that element - ;; to `mouse-1-menu' instead of `mouse-drag', and don't - ;; generate a `down-mouse-1' event immediately. Instead, - ;; wait for the touch point to be released. - (if (and tool-list - (and (setq binding - (key-binding (if prefix - (vector prefix - 'down-mouse-1) - [down-mouse-1]) - t nil position)) - (not (and (symbolp binding) - (get binding 'ignored-mouse-command))))) - (if (or (keymapp binding) - (and (symbolp binding) - (get binding 'mouse-1-menu-command))) - ;; binding is a keymap, or a command that does - ;; almost the same thing. If a `mouse-1' event is - ;; generated after the keyboard command loop - ;; displays it as a menu, that event could cause - ;; unwanted commands to be run. Set what to - ;; `mouse-1-menu' instead and wait for the up event - ;; to display the menu. - (setcar (nthcdr 3 tool-list) 'mouse-1-menu) - (progn (setcar (nthcdr 3 tool-list) 'mouse-drag) - (throw 'input-event (list 'down-mouse-1 position)))) - (and point - ;; Start the long-press timer. - (touch-screen-handle-timeout nil)))))) + ;; If a tool already exists... + (if touch-screen-current-tool + ;; Then record this tool as the ``auxiliary tool''. + ;; Updates to the auxiliary tool are considered in unison + ;; with those to the current tool; the distance between + ;; both tools is measured and compared with that when the + ;; auxiliary tool was first pressed, then interpreted as a + ;; scale by which to adjust text within the current tool's + ;; window. + (progn + ;; Set touch-screen-aux-tool as is proper. Mind that + ;; the last field is always relative to the current + ;; tool's window. + (let* ((window (nth 1 touch-screen-current-tool)) + (relative-x-y (touch-screen-relative-xy position + window)) + (initial-pos (nth 4 touch-screen-current-tool)) + (initial-x-y (touch-screen-relative-xy initial-pos + window)) + computed-distance computed-centrum) + ;; Calculate the distance and centrum from this point + ;; to the initial position of the current tool. + (setq computed-distance (touch-screen-distance relative-x-y + initial-x-y) + computed-centrum (touch-screen-centrum relative-x-y + initial-x-y)) + ;; If computed-distance is zero, ignore this tap. + (unless (zerop computed-distance) + (setq touch-screen-aux-tool (vector touchpoint window + position relative-x-y + computed-distance + computed-centrum + 1.0 nil))) + ;; When an auxiliary tool is pressed, any gesture + ;; previously in progress must be terminated, so long + ;; as it represents a gesture recognized from the + ;; current tool's motion rather than ones detected by + ;; this function from circumstances surrounding its + ;; first press, such as the presence of a menu or + ;; down-mouse-1 button beneath its first press. + (unless (memq (nth 3 touch-screen-current-tool) + '(mouse-drag mouse-1-menu)) + (setcar (nthcdr 3 touch-screen-current-tool) nil)))) + ;; Replace any previously ongoing gesture. If POSITION has no + ;; window or position, make it nil instead. + (setq tool-list (and (windowp window) + (list touchpoint window + (posn-x-y position) + nil position + nil nil nil nil + (posn-x-y position))) + touch-screen-current-tool tool-list) + ;; Select the window underneath the event as the checks below + ;; will look up keymaps and markers inside its buffer. + (save-selected-window + ;; Check if `touch-screen-extend-selection' is enabled, + ;; the tap lies on the point or the mark, and the region + ;; is active. If that's the case, set the fourth element + ;; of `touch-screen-current-tool' to `restart-drag', then + ;; generate a `touchscreen-restart-drag' event. + (when tool-list + ;; tool-list is always non-nil where the selected window + ;; matters. + (select-window window) + (when (and touch-screen-extend-selection + (or (eq point (point)) + (eq point (mark))) + (region-active-p) + ;; Only restart drag-to-select if the tap + ;; falls on the same row as the selection. + ;; This prevents dragging from starting if + ;; the tap is below the last window line with + ;; text and `point' is at ZV, as the user + ;; most likely meant to scroll the window + ;; instead. + (when-let* ((posn-point (posn-at-point point)) + (posn-row (cdr + (posn-col-row posn-point)))) + (eq (cdr (posn-col-row position)) posn-row))) + ;; Indicate that a drag is about to restart. + (setcar (nthcdr 3 tool-list) 'restart-drag) + ;; Generate the `restart-drag' event. + (throw 'input-event (list 'touchscreen-restart-drag + position)))) + ;; Determine if there is a command bound to `down-mouse-1' + ;; at the position of the tap and that command is not a + ;; command whose functionality is replaced by the + ;; long-press mechanism. If so, set the fourth element of + ;; `touch-screen-current-tool' to `mouse-drag' and + ;; generate an emulated `mouse-1' event. + ;; + ;; If the command in question is a keymap, set that + ;; element to `mouse-1-menu' instead of `mouse-drag', and + ;; don't generate a `down-mouse-1' event immediately. + ;; Instead, wait for the touch point to be released. + (if (and tool-list + (and (setq binding + (key-binding (if prefix + (vector prefix + 'down-mouse-1) + [down-mouse-1]) + t nil position)) + (not (and (symbolp binding) + (get binding 'ignored-mouse-command))))) + (if (or (keymapp binding) + (and (symbolp binding) + (get binding 'mouse-1-menu-command))) + ;; binding is a keymap, or a command that does + ;; almost the same thing. If a `mouse-1' event is + ;; generated after the keyboard command loop + ;; displays it as a menu, that event could cause + ;; unwanted commands to be run. Set what to + ;; `mouse-1-menu' instead and wait for the up + ;; event to display the menu. + (setcar (nthcdr 3 tool-list) 'mouse-1-menu) + (progn (setcar (nthcdr 3 tool-list) 'mouse-drag) + (throw 'input-event (list 'down-mouse-1 position)))) + (and point + ;; Start the long-press timer. + (touch-screen-handle-timeout nil))))))) ((eq (car event) 'touchscreen-update) (unless touch-screen-current-tool ;; If a stray touchscreen-update event arrives (most likely @@ -1320,7 +1576,17 @@ touch-screen-handle-touch (let ((new-point (assq (car touch-screen-current-tool) (cadr event)))) (when new-point - (touch-screen-handle-point-update new-point)))) + (if touch-screen-aux-tool + (touch-screen-handle-aux-point-update (cdr new-point) + (car new-point)) + (touch-screen-handle-point-update new-point)))) + ;; Check for updates to any ancillary point being monitored. + (when touch-screen-aux-tool + (let ((new-point (assq (aref touch-screen-aux-tool 0) + (cadr event)))) + (when new-point + (touch-screen-handle-aux-point-update (cdr new-point) + (car new-point)))))) ((eq (car event) 'touchscreen-end) ;; A tool has been removed from the screen. If it is the tool ;; currently being tracked, clear `touch-screen-current-tool'. @@ -1339,6 +1605,21 @@ touch-screen-handle-touch ;; Make sure the tool list is cleared even if ;; `touch-screen-handle-point-up' throws. (setq touch-screen-current-tool nil))) + ;; If it is rather the ancillary tool, delete its vector. No + ;; further action is required, for the next update received will + ;; resume regular gesture recognition. + ;; + ;; The what field in touch-screen-current-tool is cleared when + ;; the ancillary tool is pressed, so gesture recognition will + ;; commence with a clean slate, save for when the first touch + ;; landed atop a menu or some other area down-mouse-1 was bound. + ;; + ;; Gesture recognition will be inhibited in that case, so that + ;; menu bar or mouse motion events are generated in its place as + ;; they would be were no ancillary tool ever pressed. + (when (and touch-screen-aux-tool + (eq (caadr event) (aref touch-screen-aux-tool 0))) + (setq touch-screen-aux-tool nil)) ;; Throw to the key translation function. (throw 'input-event nil))))) diff --git a/src/androidterm.c b/src/androidterm.c index 1593cac36ba..cfb64cd69a0 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -1377,7 +1377,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, { /* Simply update the tool position and send an update. */ touchpoint->x = event->touch.x; - touchpoint->y = event->touch.x; + touchpoint->y = event->touch.y; android_update_tools (any, &inev.ie); inev.ie.timestamp = event->touch.time; @@ -1390,7 +1390,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, touchpoint = xmalloc (sizeof *touchpoint); touchpoint->tool_id = event->touch.pointer_id; touchpoint->x = event->touch.x; - touchpoint->y = event->touch.x; + touchpoint->y = event->touch.y; touchpoint->next = FRAME_OUTPUT_DATA (any)->touch_points; touchpoint->tool_bar_p = false; FRAME_OUTPUT_DATA (any)->touch_points = touchpoint; commit f054e9924cc3fda38a710b76db668cfab8b7d1d9 Author: nverno Date: Sun Nov 12 11:36:09 2023 -0800 Fix font-lock for string escapes in lua-ts-mode * lua-ts-mode.el (lua-ts--font-lock-settings): Apply font-lock to the entire string containing an escape sequence. (Bug#67135) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 4856888344c..a910d759c83 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -148,10 +148,6 @@ lua-ts--font-lock-settings :feature 'delimiter '(["," ";"] @font-lock-delimiter-face) - :language 'lua - :feature 'escape - '((escape_sequence) @font-lock-escape-face) - :language 'lua :feature 'constant '((variable_list @@ -213,6 +209,11 @@ lua-ts--font-lock-settings :feature 'string '((string) @font-lock-string-face) + :language 'lua + :feature 'escape + :override t + '((escape_sequence) @font-lock-escape-face) + :language 'lua :feature 'comment '((comment) @font-lock-comment-face commit 03d2e26108b21b4a9c86a30e5552f9535f4245ac Author: john muhl Date: Mon Nov 13 16:06:07 2023 -0600 Fix flymake integration in lua-ts-mode (Bug#67152) * lisp/progmodes/lua-ts-mode.el (lua-ts-flymake-luacheck): Use 'flymake-diag-region' to mark highlighted region. diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 2193779b759..4856888344c 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -506,17 +506,18 @@ lua-ts-flymake-luacheck (group (0+ nonl)) eol)) nil t) - for line = (string-to-number (match-string 1)) - for beg = (string-to-number (match-string 2)) - for end = (string-to-number (match-string 3)) + for (beg . end) = (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 2))) for msg = (match-string 4) for type = (if (string-match "^(W" msg) :warning :error) when (and beg end) collect (flymake-make-diagnostic source - (cons line beg) - (cons line (1+ end)) + beg + end type msg) into diags commit c1251ae1f939975446a9da5015ae6ce82f7a74a1 Author: João Távora Date: Wed Nov 15 04:12:03 2023 -0600 * lisp/progmodes/eglot.el (eglot-server-programs): Fix previous commit. (cherry picked from commit 58d9e735e721ecf0187a5e15eefc7641112ace0b) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index dfeff7143bb..80f98d7553d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -193,11 +193,11 @@ eglot-server-programs . ,(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)) + (((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) commit 58d9e735e721ecf0187a5e15eefc7641112ace0b Author: João Távora Date: Wed Nov 15 04:12:03 2023 -0600 * lisp/progmodes/eglot.el (eglot-server-programs): Fix previous commit. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f6c57125fd3..48ea33c3ee1 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -221,11 +221,11 @@ eglot-server-programs . ,(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)) + (((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) commit 5a1808da5f31c5cfc0a555384a24f7534d7b7af0 Author: Eli Zaretskii Date: Tue Nov 14 21:14:48 2023 +0200 ; * doc/misc/eglot.texi (Eglot Commands): Fix typos (bug#67159). Reported by Alfie John . diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 3ddbac01ce8..e1074bf9f0e 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -682,12 +682,12 @@ Eglot Commands These commands allow you to invoke the so-called @dfn{code actions}: requests for the language server to provide editing commands for correcting, refactoring or beautifying your code. These commands may -affect more than one visited file belong to the project. +affect more than one visited file belonging to the project. The command @code{eglot-code-actions} asks the server if there any code actions for any point in the buffer or contained in the active -region. If there are, you the choice to execute one of them via the -minibuffer. +region. If there are, you have the choice to execute one of them via +the minibuffer. A common use of code actions is fixing the Flymake error diagnostics issued by Eglot (@pxref{Top,,, flymake, GNU Flymake manual}). commit 260ba357bbe3e6faaadb20d998107c11fab40aa5 Author: João Távora Date: Tue Nov 14 00:06:24 2023 +0000 Eglot: Send standard :language-id for typescript-language-server bug#67150 * lisp/progmodes/eglot.el (eglot-server-programs): Update language-id for languages handled by typescript-language-server. (cherry picked from commit 1fe949888057b0275da041288709bd5690501974) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 4c5b9c30d91..dfeff7143bb 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -193,7 +193,11 @@ eglot-server-programs . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("vscode-json-languageserver" "--stdio") ("json-languageserver" "--stdio")))) - ((js-mode js-ts-mode tsx-ts-mode typescript-ts-mode typescript-mode) + (((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) commit 32a32853ce914fd10770b463e8109e288047a211 Author: Zajcev Evgeny Date: Tue Nov 14 13:32:57 2023 +0300 Typofix in the doc/lispref/modes.texi diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 78e73359b6d..bcebcc31a96 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2660,7 +2660,7 @@ Header Lines value returned by @code{frame-char-width} (@pxref{Frame Font}), and then use the result to align header-line text using the @code{:align-to} display property spec (@pxref{Specified Space}) in -pixels on the relevant parts of @code{header-line-frormat}. +pixels on the relevant parts of @code{header-line-format}. @end defvar @defun window-header-line-height &optional window commit f98637b51b5b938c894cb77a5d5aa6a86b2a727d Author: Eshel Yaron Date: Sun Nov 12 21:42:25 2023 +0100 ; Fix 'add-face-text-property' shortdoc * lisp/emacs-lisp/shortdoc.el (text-properties): Add missing ':no-eval' keyword. (Bug#67138) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index f5cbb2e645f..e7c38d996b9 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1384,7 +1384,7 @@ text-properties (set-text-properties :no-eval (set-text-properties (point) (1+ (point)) '(face error))) (add-face-text-property - (add-face-text-property START END '(:foreground "green"))) + :no-eval (add-face-text-property START END '(:foreground "green"))) (propertize :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) "Searching for Text Properties" commit 3fff22eb20cc59c730c7ec4560c8663dfd55147b Author: Eli Zaretskii Date: Tue Nov 14 15:14:01 2023 +0200 Fix spell-checking email message with citations This became broken 7 years ago, when the 'boundp condition was removed, and with it an important unrelated part of the code. * lisp/textmodes/ispell.el (ispell-message): Fix cite-regexp. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index eb550b639a3..48d48b07937 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3973,7 +3973,8 @@ ispell-message (point-max))) (t (min (point-max) (funcall ispell-message-text-end)))))) (default-prefix ; Vanilla cite prefix (just used for cite-regexp) - (if (ispell-non-empty-string mail-yank-prefix) + (if mail-yank-prefix + (ispell-non-empty-string mail-yank-prefix) " \\|\t")) (cite-regexp ;Prefix of quoted text (cond commit 7d42a76234ea5ca417915f8d5d755cc1f5aae7e5 Author: Juri Linkov Date: Tue Nov 14 09:44:15 2023 +0200 * lisp/vc/vc.el (vc-deduce-backend-nonvc-modes): New variable (bug#67145). (vc-deduce-backend): Use it. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 95f9218dcbf..d768af678c3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1071,14 +1071,20 @@ log-edit-vc-backend (defvar diff-vc-backend) (defvar diff-vc-revisions) +;; Maybe we could even use comint-mode rather than shell-mode? +(defvar vc-deduce-backend-nonvc-modes + '(dired-mode shell-mode eshell-mode compilation-mode) + "List of modes not supported by VC where backend should be deduced. +In these modes the backend is deduced based on `default-directory'. +When nil, the backend is deduced in all modes.") + (defun vc-deduce-backend () (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) ((derived-mode-p 'log-view-mode) log-view-vc-backend) ((derived-mode-p 'log-edit-mode) log-edit-vc-backend) ((derived-mode-p 'diff-mode) diff-vc-backend) - ;; Maybe we could even use comint-mode rather than shell-mode? - ((derived-mode-p - 'dired-mode 'shell-mode 'eshell-mode 'compilation-mode) + ((or (null vc-deduce-backend-nonvc-modes) + (apply #'derived-mode-p vc-deduce-backend-nonvc-modes)) (ignore-errors (vc-responsible-backend default-directory))) (vc-mode (vc-backend buffer-file-name)))) commit bda31b2c6d62652c742e800b692dffd926f8284b Author: Po Lu Date: Tue Nov 14 10:57:18 2023 +0800 Properly merge EXTRA_EMAIL content with mailto URIs * java/org/gnu/emacs/EmacsOpenActivity.java (onCreate): EXTRA_EMAIL is an array rather than a string, so insert its first element into an empty mailto URI. diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java index a5e8be2f238..5cca6cfcdff 100644 --- a/java/org/gnu/emacs/EmacsOpenActivity.java +++ b/java/org/gnu/emacs/EmacsOpenActivity.java @@ -414,6 +414,7 @@ private class EmacsClientThread extends Thread String subjectString, textString, attachmentString; CharSequence tem; String tem1; + String[] emails; StringBuilder builder; List list; @@ -466,16 +467,16 @@ private class EmacsClientThread extends Thread /* If fileName is merely mailto: (absent either an email address or content), then the program launching Emacs conceivably provided such an URI to exclude non-email - programs from being enumerated within the Share dialog; - whereupon Emacs should replace it with any address - provided as EXTRA_EMAIL. */ + programs from the Share dialog. Intents created thus + might hold the recipient email as a string array, which + is non-standard behavior. */ if (fileName.equals ("mailto:") || fileName.equals ("mailto://")) { - tem = intent.getCharSequenceExtra (Intent.EXTRA_EMAIL); + emails = intent.getStringArrayExtra (Intent.EXTRA_EMAIL); - if (tem != null) - fileName = "mailto:" + tem; + if (emails[0] != null && emails.length > 0) + fileName = "mailto:" + emails[0]; } /* Subsequently, escape fileName such that it is rendered commit 1fe949888057b0275da041288709bd5690501974 Author: João Távora Date: Tue Nov 14 00:06:24 2023 +0000 Eglot: Send standard :language-id for typescript-language-server bug#67150 * lisp/progmodes/eglot.el (eglot-server-programs): Update language-id for languages handled by typescript-language-server. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 816f6952d2e..f6c57125fd3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -221,7 +221,11 @@ eglot-server-programs . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("vscode-json-languageserver" "--stdio") ("json-languageserver" "--stdio")))) - ((js-mode js-ts-mode tsx-ts-mode typescript-ts-mode typescript-mode) + (((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) commit 6a6c2058f1907b9ec0c32079f0f9ab28d01cf3f7 Author: Sean Whitton Date: Mon Nov 13 21:58:46 2023 +0000 ; * etc/NEWS: Use setopt not setq for project-switch-commands. diff --git a/etc/NEWS b/etc/NEWS index d9ec527fcae..22a08bc97ea 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -416,7 +416,7 @@ have access to all keys defined inside 'project-prefix-map', as well as global bindings (to run other commands inside the project root), you can add this to your init script: - (setq project-switch-commands #'project-prefix-or-any-command) + (setopt project-switch-commands #'project-prefix-or-any-command) ** VC commit 1124a9853f660d243de7fdc4819140b82447ead9 Author: Stefan Monnier Date: Mon Nov 13 13:24:12 2023 -0500 (wisent-python-lex-beginning-of-line): Fix compiler warning * lisp/cedet/semantic/wisent/python.el (wisent-python-lex-beginning-of-line): Comment out unused test. diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index c6a8a35d8df..6b274df614c 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -262,18 +262,19 @@ wisent-python-lex-beginning-of-line ;; Loop lexer to handle tokens in current line. t) ;; Indentation decreased - ((progn - ;; Pop items from indentation stack - (while (< curr-indent last-indent) - (pop wisent-python-indent-stack) - (setq semantic-lex-current-depth (1- semantic-lex-current-depth) - last-indent (car wisent-python-indent-stack)) - (semantic-lex-push-token - (semantic-lex-token 'DEDENT last-pos (point)))) - (= last-pos (point))) - ;; If pos did not change, then we must return nil so that - ;; other lexical analyzers can be run. - nil)))) + (t + ;; Pop items from indentation stack + (while (< curr-indent last-indent) + (pop wisent-python-indent-stack) + (setq semantic-lex-current-depth (1- semantic-lex-current-depth) + last-indent (car wisent-python-indent-stack)) + (semantic-lex-push-token + (semantic-lex-token 'DEDENT last-pos (point)))) + ;; (if (= last-pos (point)) + ;; ;; If pos did not change, then we must return nil so that + ;; ;; other lexical analyzers can be run. + ;; nil) + )))) ;; All the work was done in the above analyzer matching condition. ) commit 183d2c3e5463d33af05e5ea8ea546bd348da0d10 Author: Harald Jörg Date: Mon Nov 13 16:39:20 2023 +0100 ; cperl-mode.el: Eliminate warnings about using obsolete functions * lisp/progmodes/cperl-mode.el (cperl-info-on-current-command): Use cperl-perldoc instead of cperl-info-on-command. (cperl-imenu-on-info): Shortcut this function since the Perl info file can no longer be installed. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5b3395b77d2..ab624a08646 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6641,7 +6641,7 @@ cperl-info-on-command (defun cperl-info-on-current-command () (declare (obsolete cperl-perldoc "30.1")) (interactive) - (cperl-info-on-command (cperl-word-at-point))) + (cperl-perldoc (cperl-word-at-point))) (defun cperl-imenu-info-imenu-search () (declare (obsolete nil "30.1")) @@ -6660,32 +6660,9 @@ cperl-imenu-info-imenu-name (defun cperl-imenu-on-info () (declare (obsolete nil "30.1")) (interactive) - (require 'imenu) - (let* ((buffer (current-buffer)) - imenu-create-index-function - imenu-prev-index-position-function - imenu-extract-index-name-function - (index-item (save-restriction - (save-window-excursion - (set-buffer (cperl-info-buffer nil)) - (setq imenu-create-index-function - 'imenu-default-create-index-function - imenu-prev-index-position-function - #'cperl-imenu-info-imenu-search - imenu-extract-index-name-function - #'cperl-imenu-info-imenu-name) - (imenu-choose-buffer-index))))) - (and index-item - (progn - (push-mark) - (pop-to-buffer "*info-perl*") - (cond - ((markerp (cdr index-item)) - (goto-char (marker-position (cdr index-item)))) - (t - (goto-char (cdr index-item)))) - (set-window-start (selected-window) (point)) - (pop-to-buffer buffer))))) + (message + (concat "The info file `perl' is no longer available.\n" + "Consider installing the perl-doc package from GNU ELPA."))) (defun cperl-lineup (beg end &optional step minshift) "Lineup construction in a region. commit 1247dc87bab7ec56b05e87ab0ae8bf37aa90021b Author: Mattias Engdegård Date: Mon Nov 13 11:49:32 2023 +0100 Fix variable aliasing bytecode miscompilation (bug#67116) The compiler didn't cancel aliasing if the aliased variable was modified in a variable binding in the same `let` that created the alias. For example, (let ((x A)) (let ((y x) (z (setq x B))) y)) would incorrectly substitute y->x in the body form despite x being already modified at that point, which normally should have cancelled the aliasing. Bug reported by Alan Mackenzie. * lisp/emacs-lisp/byte-opt.el (byte-optimize--aliased-vars): Now an alist that also contains the aliases; update the doc string. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): * lisp/emacs-lisp/byte-opt.el (byte-optimize-let-form): Detect aliasing early for `let`-bound variables as well. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test cases. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ecc5fff3b67..2caaadc9f9e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -217,10 +217,10 @@ byte-optimize--dynamic-vars (defvar byte-optimize--aliased-vars nil "List of variables which may be aliased by other lexical variables. -If an entry in `byte-optimize--lexvars' has another variable as its VALUE, -then that other variable must be in this list. -This variable thus carries no essential information but is maintained -for speeding up processing.") +Each element is (NAME . ALIAS) where NAME is the aliased variable +and ALIAS the variable record (in the format described for +`byte-optimize--lexvars') for an alias, which may have NAME as its VALUE. +There can be multiple entries for the same NAME if it has several aliases.") (defun byte-optimize--substitutable-p (expr) "Whether EXPR is a constant that can be propagated." @@ -462,13 +462,17 @@ byte-optimize-form-code-walker (setcar (cdr lexvar) t) ; Mark variable to be kept. (setcdr (cdr lexvar) nil) ; Inhibit further substitution. - (when (memq var byte-optimize--aliased-vars) - ;; Cancel aliasing of variables aliased to this one. - (dolist (v byte-optimize--lexvars) - (when (eq (nth 2 v) var) - ;; V is bound to VAR but VAR is now mutated: - ;; cancel aliasing. - (setcdr (cdr v) nil))))) + ;; Cancel substitution of variables aliasing this one. + (let ((aliased-vars byte-optimize--aliased-vars)) + (while + (let ((alias (assq var aliased-vars))) + (and alias + (progn + ;; Found a variable bound to VAR but VAR is + ;; now mutated; cancel aliasing. + (setcdr (cddr alias) nil) + (setq aliased-vars (cdr (memq alias aliased-vars))) + t)))))) `(,fn ,var ,value))) (`(defvar ,(and (pred symbolp) name) . ,rest) @@ -587,7 +591,6 @@ byte-optimize-let-form (let* ((byte-optimize--lexvars byte-optimize--lexvars) (byte-optimize--aliased-vars byte-optimize--aliased-vars) (new-lexvars nil) - (new-aliased-vars nil) (let-vars nil) (body (cdr form)) (bindings (car form))) @@ -597,7 +600,7 @@ byte-optimize-let-form (expr (byte-optimize-form (cadr binding) nil))) (setq bindings (cdr bindings)) (when (and (eq head 'let*) - (memq name byte-optimize--aliased-vars)) + (assq name byte-optimize--aliased-vars)) ;; New variable shadows an aliased variable -- α-rename ;; it in this and all subsequent bindings. (let ((new-name (make-symbol (symbol-name name)))) @@ -610,14 +613,12 @@ byte-optimize-let-form bindings)) (setq body (byte-optimize--rename-var-body name new-name body)) (setq name new-name))) - (let* ((aliased nil) - (value (and - (or (byte-optimize--substitutable-p expr) - ;; Aliasing another lexvar. - (setq aliased - (and (symbolp expr) - (assq expr byte-optimize--lexvars)))) - (list expr))) + (let* ((aliased + ;; Aliasing another lexvar. + (and (symbolp expr) (assq expr byte-optimize--lexvars))) + (value (and (or aliased + (byte-optimize--substitutable-p expr)) + (list expr))) (lexical (not (or (special-variable-p name) (memq name byte-compile-bound-variables) (memq name byte-optimize--dynamic-vars)))) @@ -626,20 +627,16 @@ byte-optimize-let-form (when lexinfo (push lexinfo (if (eq head 'let*) byte-optimize--lexvars - new-lexvars))) - (when aliased - (push expr (if (eq head 'let*) - byte-optimize--aliased-vars - new-aliased-vars)))))) - - (setq byte-optimize--aliased-vars - (append new-aliased-vars byte-optimize--aliased-vars)) + new-lexvars)) + (when aliased + (push (cons expr lexinfo) byte-optimize--aliased-vars)))))) + (when (and (eq head 'let) byte-optimize--aliased-vars) ;; Find new variables that shadow aliased variables. (let ((shadowing-vars nil)) (dolist (lexvar new-lexvars) (let ((name (car lexvar))) - (when (and (memq name byte-optimize--aliased-vars) + (when (and (assq name byte-optimize--aliased-vars) (not (memq name shadowing-vars))) (push name shadowing-vars)))) ;; α-rename them diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 06918f5901c..27056c99a50 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -643,6 +643,16 @@ bytecomp-tests--test-cases (funcall (car f) 3) (list a b)) + (let ((x (list 1))) + (let ((y x) + (z (setq x (vector x)))) + (list x y z))) + + (let ((x (list 1))) + (let* ((y x) + (z (setq x (vector x)))) + (list x y z))) + (cond) (mapcar (lambda (x) (cond ((= x 0)))) '(0 1)) commit 8090ab05434f39b73e6238ebc5ab8e4fcc52acf3 Author: João Távora Date: Mon Nov 13 04:11:09 2023 -0600 Fix hanful-insert-character (bug#66970) * lisp/leim/quail/hangul.el (hangul-insert-character): Rework. diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index 46a2e5a6ba2..f399a20a41c 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -146,21 +146,34 @@ hangul-insert-character (progn (delete-region (region-beginning) (region-end)) (deactivate-mark))) - (quail-delete-region) - (let ((first (car queues))) - (insert - (hangul-character - (+ (aref first 0) (hangul-djamo 'cho (aref first 0) (aref first 1))) - (+ (aref first 2) (hangul-djamo 'jung (aref first 2) (aref first 3))) - (+ (aref first 4) (hangul-djamo 'jong (aref first 4) (aref first 5)))))) - (move-overlay quail-overlay (overlay-start quail-overlay) (point)) - (dolist (queue (cdr queues)) - (insert - (hangul-character - (+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref queue 1))) - (+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref queue 3))) - (+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref queue 5))))) - (move-overlay quail-overlay (1+ (overlay-start quail-overlay)) (point)))) + (let* ((chars-to-insert + (with-temp-buffer + (dolist (queue queues (mapcar #'identity (buffer-string))) + (insert + (hangul-character + (+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref queue 1))) + (+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref queue 3))) + (+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref queue 5)))))))) + (overwrite-maybe + (or + ;; If the overlay isn't showing (i.e. it has 0 length) then + ;; we may want to insert char overwriting (iff overwrite-mode is + ;; non-nil, of course) + (= (overlay-start quail-overlay) (overlay-end quail-overlay)) + ;; Likewise we want to do it if there is more then one + ;; character that were combined. + (cdr chars-to-insert)))) + (quail-delete-region) ; this empties the overlay + (dolist (c chars-to-insert) + (let ((last-command-event c) + (overwrite-mode (and overwrite-mode + overwrite-maybe + overwrite-mode))) + (self-insert-command 1) + ;; For chars other than fhe first, no more overwrites desired + (setq overwrite-maybe nil))) + ; this shows the overlay again (TODO: do we really always revive?) + (move-overlay quail-overlay (1- (point)) (point)))) (defun hangul-djamo (jamo char1 char2) "Return the double Jamo index calculated from the arguments. commit 4dc26a1e6e11416ea631121e46e2084d4fc29203 Author: Juri Linkov Date: Mon Nov 13 09:18:49 2023 +0200 ; * etc/NEWS: Rearrange wrongly categorized entries. Move Project, Minibuffer and Completions, JS Mode from "New Modes and Packages" to "Changes in Specialized Modes and Packages". diff --git a/etc/NEWS b/etc/NEWS index 58bb1c052f1..d9ec527fcae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -384,6 +384,40 @@ 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'. +** Project + ++++ +*** New user option 'project-mode-line'. +When non-nil, display the name of the current project on the mode +line. Clicking 'mouse-1' on the project name pops up the project +menu. The default value is nil. + +*** New user option 'project-file-history-behavior'. +Customizing it to 'relativize' makes commands like 'project-find-file' +and 'project-find-dir' display previous history entries relative to +the current project. + +*** New user option 'project-key-prompt-style'. +The look of the key prompt in the project switcher has been changed +slightly. To get the previous one, set this option to 'brackets'. + +*** 'project-try-vc' tries harder to find the responsible VCS. +When 'project-vc-extra-root-markers' is non-nil, and causes +subdirectory project to be detected which is not a VCS root, we now +additionally traverse the parent directories until a VCS root is found +(if any), so that the ignore rules for that repository are used, and +the file listing's performance is still optimized. + +*** New commands 'project-any-command' and 'project-prefix-or-any-command'. +The former is now bound to 'C-x p o' by default. +The latter is designed primarily for use as a value of +'project-switch-commands'. If instead of a short menu you prefer to +have access to all keys defined inside 'project-prefix-map', as well +as global bindings (to run other commands inside the project root), +you can add this to your init script: + + (setq project-switch-commands #'project-prefix-or-any-command) + ** VC --- @@ -540,6 +574,21 @@ calling external rgrep. +++ *** If a command exits abnormally, the Eshell prompt now shows its exit code. +** Minibuffer and Completions + +*** New commands 'previous-line-completion' and 'next-line-completion'. +Bound to '' and '' arrow keys, respectively, they navigate +the "*Completions*" buffer vertically by lines, wrapping at the +top/bottom when 'completion-auto-wrap' is non-nil. + +*** New user option 'minibuffer-visible-completions'. +When customized to non-nil, you can use arrow key in the minibuffer +to navigate the completions displayed in the *Completions* window. +Typing 'RET' selects the highlighted candidate. 'C-g' hides the +completions window. When the completions window is not visible, +then all these keys have their usual meaning in the minibuffer. +This option is supported for in-buffer completion as well. + ** Pcomplete --- @@ -768,6 +817,13 @@ 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. +** 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 +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. + ** Python mode --- @@ -1015,23 +1071,8 @@ A major mode based on the tree-sitter library for editing Elixir files. *** New major mode 'lua-ts-mode'. A major mode based on the tree-sitter library for editing Lua files. -** Minibuffer and Completions - -*** New commands 'previous-line-completion' and 'next-line-completion'. -Bound to '' and '' arrow keys, respectively, they navigate -the "*Completions*" buffer vertically by lines, wrapping at the -top/bottom when 'completion-auto-wrap' is non-nil. - -*** New user option 'minibuffer-visible-completions'. -When customized to non-nil, you can use arrow key in the minibuffer -to navigate the completions displayed in the *Completions* window. -Typing 'RET' selects the highlighted candidate. 'C-g' hides the -completions window. When the completions window is not visible, -then all these keys have their usual meaning in the minibuffer. -This option is supported for in-buffer completion as well. - +++ -*** New global minor mode 'minibuffer-regexp-mode'. +** New global minor mode 'minibuffer-regexp-mode'. This is a minor mode for editing regular expressions in the minibuffer. It highlights parens via ‘show-paren-mode’ and ‘blink-matching-paren’ in a user-friendly way, avoids reporting alleged paren mismatches and makes @@ -1049,47 +1090,6 @@ 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. -** Project - -+++ -*** New user option 'project-mode-line'. -When non-nil, display the name of the current project on the mode -line. Clicking 'mouse-1' on the project name pops up the project -menu. The default value is nil. - -*** New user option 'project-file-history-behavior'. -Customizing it to 'relativize' makes commands like 'project-find-file' -and 'project-find-dir' display previous history entries relative to -the current project. - -*** New user option 'project-key-prompt-style'. -The look of the key prompt in the project switcher has been changed -slightly. To get the previous one, set this option to 'brackets'. - -*** 'project-try-vc' tries harder to find the responsible VCS. -When 'project-vc-extra-root-markers' is non-nil, and causes -subdirectory project to be detected which is not a VCS root, we now -additionally traverse the parent directories until a VCS root is found -(if any), so that the ignore rules for that repository are used, and -the file listing's performance is still optimized. - -*** New commands 'project-any-command' and 'project-prefix-or-any-command'. -The former is now bound to 'C-x p o' by default. -The latter is designed primarily for use as a value of -'project-switch-commands'. If instead of a short menu you prefer to -have access to all keys defined inside 'project-prefix-map', as well -as global bindings (to run other commands inside the project root), -you can add this to your init script: - - (setq project-switch-commands #'project-prefix-or-any-command) - -** 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 -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. - * Incompatible Lisp Changes in Emacs 30.1 commit b3d57d4397945e16edffe78d71fd1ce040f86967 Author: Juri Linkov Date: Mon Nov 13 09:09:15 2023 +0200 * lisp/vc/vc-hooks.el (vc-display-status): New value 'no-backend' (bug#66464). * lisp/vc/vc-hooks.el (vc-default-mode-line-string): Use it. * lisp/vc/vc-git.el (vc-git-mode-line-string): Use it. * lisp/vc/vc-hg.el (vc-hg-mode-line-string): Use it. diff --git a/etc/NEWS b/etc/NEWS index 8324eb7da1e..58bb1c052f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -392,6 +392,10 @@ This is a string or a list of strings that specifies the Git log switches for shortlogs, such as the one produced by 'C-x v L'. 'vc-git-log-switches' is no longer used for shortlogs. +--- +*** New value 'no-backend' for user option 'vc-display-status'. +With this value only the revision number is displayed on the mode-line. + --- *** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'. The command was previously obsoleted and unbound in Emacs 28. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 707fc7cfc07..2e057ecfaa7 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -423,7 +423,9 @@ vc-git-mode-line-string (rev (vc-working-revision file 'Git)) (disp-rev (or (vc-git--symbolic-ref file) (and rev (substring rev 0 7)))) - (state-string (concat backend-name indicator disp-rev))) + (state-string (concat (unless (eq vc-display-status 'no-backend) + backend-name) + indicator disp-rev))) (propertize state-string 'face face 'help-echo (concat state-echo " under the " backend-name " version control system" diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 89b2814a0a3..9df517ea847 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -365,7 +365,9 @@ vc-hg-mode-line-string (and vc-hg-use-file-version-for-mode-line-version truename))))) (rev (or rev "???")) - (state-string (concat backend-name indicator rev))) + (state-string (concat (unless (eq vc-display-status 'no-backend) + backend-name) + indicator rev))) (propertize state-string 'face face 'help-echo (concat state-echo " under the " backend-name " version control system")))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index c16fb63b2ff..8451128286b 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -152,8 +152,12 @@ vc-follow-symlinks (defcustom vc-display-status t "If non-nil, display revision number and lock status in mode line. -Otherwise, not displayed." - :type 'boolean +If nil, only the backend name is displayed. When the value +is `no-backend', then no backend name is displayed before the +revision number and lock status." + :type '(choice (const :tag "Show only revision/status" no-backend) + (const :tag "Show backend and revision/status" t) + (const :tag "Show only backend name" nil)) :group 'vc) @@ -766,7 +770,9 @@ vc-default-mode-line-string (rev (vc-working-revision file backend)) (`(,state-echo ,face ,indicator) (vc-mode-line-state state)) - (state-string (concat backend-name indicator rev))) + (state-string (concat (unless (eq vc-display-status 'no-backend) + backend-name) + indicator rev))) (propertize state-string 'face face 'help-echo (concat state-echo " under the " backend-name " version control system")))) commit ece62f5c1c3ab0e1ed5e71b7adb3a6bc230f23d1 Author: F. Jason Park Date: Tue Nov 7 23:51:27 2023 -0800 ; Prepare for ERC 5.6 release * doc/misc/erc.texi: Minor tweak in SASL section. * etc/ERC-NEWS: Revise various sections under 5.6. * lisp/erc/erc-button.el (erc-button-alist): Remove comment. (erc-nick-popup-alist): Remove comment. * lisp/erc/erc-fill.el (erc-fill-wrap-margin-width): Remove comment. (erc-fill-wrap-margin-side): Remove comment. (erc-fill-line-spacing): Remove comment. (erc-fill-wrap-use-pixels): Remove comment. (erc-fill-wrap-visual-keys): Remove comment. (erc-fill-wrap-force-screen-line-movement): Remove comment. (erc-fill-wrap-merge): Remove comment. * lisp/erc/erc-goodies.el (erc-scrolltobottom-all): Remove comment. (erc-keep-place-indicator-style): Remove comment. (erc-keep-place-indicator-buffer-type): Remove comment. (erc-keep-place-indicator-follow): Remove comment. * lisp/erc/erc-networks.el (erc-server-alist): Remove comment. * lisp/erc/erc-nicks.el (erc-nicks): Remove comment. * lisp/erc/erc-speedbar.el (erc-speedbar-nicknames-window-width): Remove comment. (erc-speedbar-hide-mode-topic): Remove comment. (erc-speedbar-my-nick-face): Remove comment. * lisp/erc/erc-stamp.el (erc-timestamp-format-right): Remove comment. (erc-echo-timestamp-zone): Remove comment. (erc-timestamp-use-align-to): Remove comment. * lisp/erc/erc-status-sidebar.el (erc-status-sidebar-highlight-active-buffer): Remove comment. (erc-status-sidebar-style): Remove comment. (erc-status-sidebar-click-display-action): Remove comment. * lisp/erc/erc.el: Bump required Compat version to 29.1.4.3 in Package-Requires header. (erc-notice-face): Remove comment. (erc-action-face): Remove comment. (erc-interactive-display): Remove comment. (erc-auto-reconnect-display-timeout): Remove comment. (erc-reconnect-display-server-buffers): Remove comment. (erc-modules): Remove comment. * test/lisp/erc/resources/base/display-message/multibuf.eld: Remove reference to specific ERC version in QUIT command reason. * test/lisp/erc/resources/base/assoc/reconplay/foonet.eld: Timeout. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 44e82084b90..d7260ffa329 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1066,14 +1066,14 @@ SASL The value can be one of the following: @table @asis -@item @code{plain} and @code{scram} (``password-based'') +@item @code{plain} or @code{scram} (``password-based'') Here, ``password'' refers to your account password, which is usually your @samp{NickServ} password. To make this work, customize @code{erc-sasl-user} and @code{erc-sasl-password} or specify the @code{:user} and @code{:password} keyword arguments when invoking @code{erc-tls}. -@item @code{external} (via Client TLS Certificate) +@item @code{external} (via client @acronym{TLS} certificate) This works in conjunction with the @code{:client-certificate} keyword offered by @code{erc-tls}. Just ensure you've registered your fingerprint with the network beforehand. The fingerprint is usually a diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index cd4a283ef1c..04b11fc19f0 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -100,7 +100,7 @@ one's optionally accessible from the keyboard, just like any other side window. Hit '' over a nick to spawn a "/QUERY" or a "Lastlog" (Occur) session. See 'erc-nickbar-mode' for more. -** The option 'erc-timestamp-use-align-to' is more versatile. +** Option 'erc-timestamp-use-align-to' more versatile. While this option has always offered to right-align stamps via the 'display' text property, it's now more effective at doing so when set to a number indicating an offset from the right edge. Users of the @@ -220,7 +220,7 @@ the same effect by issuing a "/CLEAR" at the prompt. ** The 'truncate' module no longer enables logging automatically. Users expecting 'truncate' to perform logging based on the option 'erc-enable-logging' need to instead add 'log' to 'erc-modules' for -continued integration. With the existing design, merely loading the +continued integration. Under the original design, merely loading the library 'erc-log' caused 'truncate' to start writing logs, possibly against a user's wishes. @@ -257,10 +257,10 @@ tally of blank lines padded and trailing blanks culled. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new command 'erc-match-toggle-hidden-fools'. The 'button' module's -'erc-button-previous' now moves to the beginning instead of the end of -buttons. A new command, 'erc-news', can be invoked to visit this very -file. And the 'irccontrols' module now supports additional colors and -special handling for "spoilers" (hidden text). +'erc-button-previous' command now moves to the beginning instead of +the end of buttons. A new command, 'erc-news', can be invoked to +visit this very file. And the 'irccontrols' module now supports +additional colors and special handling for "spoilers" (hidden text). ** Changes in the library API. @@ -276,21 +276,26 @@ sparingly, and the latter two have only been around for one minor release cycle, so their removal hopefully won't cause much churn. *** Some ERC-applied text properties have changed. -Chiefly, 'rear-sticky' has been replaced by 'erc-command', which -records the IRC command (or numeric) associated with a message. Less -impactfully, the value of the 'field' property for ERC's prompt has -changed from 't' to the more useful 'erc-prompt', although the -property of the same name has been retained and now has a value of -'hidden' when disconnected. +Chiefly, a new set of metadata-oriented properties, the details of +which should be considered internal, now occupy the first character of +all inserted messages, including local notices, date stamps, and +interactive feedback. These properties will likely form the basis for +a new message-traversal/insertion/deletion API in future versions. +Less impactfully, the no-op property 'rear-sticky' has been removed, +and the value of the 'field' property for ERC's prompt has changed +from 't' to the more useful 'erc-prompt', although the property of the +same name has been retained and now has a value of 'hidden' when +disconnected. *** Members of insert- and send-related hooks have been reordered. -Built-in and third-party modules rely on certain hooks for adjusting -incoming and outgoing messages upon insertion. And some modules only -want to do so after others have done their damage. Traditionally, -this has required various hacks and finagling to achieve. And while -this release makes an effort to load modules in a more consistent -order, that alone isn't enough to ensure similar predictability among -essential members of important hooks. +As anyone reading this is no doubt aware, both built-in and +third-party modules rely on certain hooks for adjusting incoming and +outgoing messages upon insertion. And some modules only want to do so +after others have done their damage. Traditionally, this has required +various hacks and finagling to achieve. And while this release makes +an effort to load modules in a more consistent order, that alone isn't +enough to ensure predictability among essential members of important +hooks. Luckily, ERC now leverages a feature introduced in Emacs 27, "hook depth," to secure the positions of a few key members of @@ -317,18 +322,18 @@ ERC's own code base in 2002. That this example has endured makes some sense because it's probably seen as less cumbersome than fiddling with the more powerful and complicated 'erc-display-message'. -The latest twist in this saga comes with this release, in which a -healthy bit of "pre-insertion" business has taken up residence in -'erc-display-message'. While this would seem to put antiquated -patterns, like the above mentioned 'erc-make-notice' combo, at risk of -having messages ignored or subject to degraded treatment by built-in -modules, an adaptive measure has been introduced that recasts -'erc-display-line' as a thin wrapper around 'erc-display-message'. -And though nothing of the sort has been done for the lower-level -'erc-display-line-1' (now an obsolete alias for 'erc-insert-line'), -some last-ditch fallback code is in place to ensure baseline -functionality. As always, if you find these developments disturbing, -please say so on the tracker. +The latest twist in this tale comes with this release, for which a +healthy helping of "pre-insertion" business has permanently ensconced +itself in none other than 'erc-display-message'. While this would +seem to put antiquated patterns, like the above mentioned +'erc-make-notice' combo, at risk of having messages ignored or subject +to degraded treatment by built-in modules, an adaptive measure has +been introduced that recasts 'erc-display-line' as a thin wrapper +around 'erc-display-message'. And though nothing of the sort has been +done for the lower-level 'erc-display-line-1' (now an obsolete alias +for 'erc-insert-line'), some last-ditch fallback code has been +introduced to guarantee baseline functionality. As always, if you +find these developments disturbing, please say so on the tracker. *** ERC now manages timestamp-related properties a bit differently. For starters, the 'cursor-sensor-functions' text property is absent by @@ -342,37 +347,45 @@ Also affecting the 'stamp' module is the deprecation of the function 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 also extends to all +This "propertizing" of surrounding white space extends to all 'stamp'-applied properties, like 'field', in all intervening space between message text and timestamps. Technically, this constitutes a breaking change from the perspective of detecting a timestamp's bounds. However, ERC has always propertized leading space before -right-sided stamps on the same line as message text but not those -folded onto the next line. Such inconsistency made stamp detection -overly complex and produced uneven results when toggling stamp -visibility. +right-sided stamps on the same line as message text but not before +those folded onto the next line. Such inconsistency made stamp +detection overly complex and produced uneven results when toggling +stamp visibility. -*** Date stamps are independent messages. +*** Date stamps have become independent messages. ERC now inserts "date stamps" generated from the option -'erc-timestamp-format-left' as separate, standalone messages. (This -only matters if 'erc-insert-timestamp-function' is set to its default -value of 'erc-insert-timestamp-left-and-right'.) ERC's near-term UI -goals require exposing these stamps to existing code designed to +'erc-timestamp-format-left' as separate, standalone messages. This +currently only matters if 'erc-insert-timestamp-function' is set to +its default value of 'erc-insert-timestamp-left-and-right', however +plans exist to decouple these features. In any case, ERC's near-term +UI goals require exposing these stamps to existing code designed to operate on complete messages. For example, users likely expect date stamps to be togglable with 'erc-toggle-timestamps' while also being immune to hiding from commands like 'erc-match-toggle-hidden-fools'. Before this change, meeting such expectations demanded brittle heuristics that checked for the presence of these stamps in the leading portion of message bodies as well as special casing to act on -these areas without inflicting collateral damage. It may also be -worth noting that as consequence of these changes, the internally -managed variable 'erc-timestamp-last-inserted-left' no longer records -the final trailing newline in 'erc-timestamp-format-left'. If you -must, see variable 'erc-stamp-prepend-date-stamps-p' for a temporary -escape hatch. +these areas without inflicting collateral damage. + +Despite the rationale, this move admittedly ushers in a heightened +potential for disruption because third-party members of ERC's +modification hooks may not take kindly to encountering stamp-only +messages. They may also expect members of 'erc-insert-pre-hook' and +'erc-insert-done-hook' to run unconditionally, even though ERC +suppresses those hooks when inserting date stamps. Third parties may +also not appreciate that 'erc-timestamp-last-inserted-left' no longer +records the final trailing newline in 'erc-timestamp-format-left'. If +these inconveniences prove too encumbering to deal with right away, +see the escape hatch 'erc-stamp-prepend-date-stamps-p', which should +help ease the transition. *** The role of a module's Custom group is now more clearly defined. -Associating built-in modules with Custom groups and provided library +Associating built-in modules with Custom groups and "provided" library features has improved. More specifically, a module's group now enjoys the singular purpose of determining where the module's minor mode variable lives in the Customize interface. And although ERC is now @@ -390,7 +403,8 @@ like bridges to other protocols. Some IRC "slash" commands are hierarchical and require users to specify a subcommand to actually carry out anything of consequence. Built-in modules can now provide more detailed help for a particular -subcommand by telling ERC to defer to a specialized handler. +subcommand by telling ERC to defer to a specialized handler. This +facility can be opened up to third parties should any one request it. *** Longtime quasi modules made proper. The 'fill' module is now defined by 'define-erc-module'. The same @@ -423,7 +437,9 @@ than lone ones. 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. See doc string for details. +prior to being sent. To facilitate this, the 'erc-input' object +shared among hook members has gained a new 'refoldp' slot, making this +a breaking change, if only in theory. See doc string for details. *** 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-button.el b/lisp/erc/erc-button.el index 596f896d9c5..e1c10be53f6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -189,7 +189,7 @@ erc-button-alist PAR is a number of a regexp grouping whose text will be passed to CALLBACK. There can be several PAR arguments." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(repeat (list :tag "Button" (choice :tag "Matches" @@ -713,7 +713,7 @@ erc-nick-popup-alist (format \"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\" nick)))" - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(repeat (cons (string :tag "Op") (choice function sexp)))) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index e8f3f624ff1..e48d5540c86 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -127,7 +127,7 @@ erc-fill-wrap-margin-width \"resolves\" to `left', ERC uses the width of the prompt if it's wider on MOTD's end, which really only matters when `erc-prompt' is a function." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const nil) integer)) (defcustom erc-fill-wrap-margin-side nil @@ -135,14 +135,14 @@ erc-fill-wrap-margin-side A value of nil means ERC should decide based on the value of `erc-insert-timestamp-function', which does not work for user-defined functions." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const nil) (const left) (const right))) (defcustom erc-fill-line-spacing nil "Extra space between messages on graphical displays. Its value should be larger than that of the variable `line-spacing', if set. When unsure, start with 0.5." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const nil) number)) (defvar-local erc-fill--function nil @@ -228,7 +228,7 @@ erc-fill-wrap-use-pixels A value of nil means ERC should use columns, which may happen regardless, depending on the Emacs version. This option only matters when `erc-fill-wrap-mode' is enabled." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type 'boolean) (defcustom erc-fill-wrap-visual-keys 'non-input @@ -240,7 +240,7 @@ erc-fill-wrap-visual-keys value is nil in the input area and t elsewhere. See related option `erc-fill-wrap-force-screen-line-movement' for behavior involving `next-line' and `previous-line'." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const nil) (const t) (const non-input))) (defcustom erc-fill-wrap-force-screen-line-movement '(non-input) @@ -251,14 +251,14 @@ erc-fill-wrap-force-screen-line-movement would normally do otherwise. For example, setting this to \\='(nil non-input) disables logical-line movement regardless of the value of `erc-fill-wrap-visual-keys'." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(set (const nil) (const non-input))) (defcustom erc-fill-wrap-merge t "Whether to consolidate messages from the same speaker. This tells ERC to omit redundant speaker labels for subsequent messages less than a day apart." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type 'boolean) (defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 1482c21e931..6c8ec567bd9 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -73,7 +73,7 @@ erc-scrolltobottom-all Note that users should consider this option's non-nil behavior to be experimental. It currently only works with Emacs 28+." :group 'erc-display - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice boolean (const relaxed))) ;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) @@ -286,7 +286,7 @@ erc-keep-place-indicator-style `face', ERC adds the face `erc-keep-place-indicator-line' to the appropriate line. A value of t does both." :group 'erc - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const :tag "Use arrow" arrow) (const :tag "Use face" face) (const :tag "Use both arrow and face" t))) @@ -295,14 +295,14 @@ erc-keep-place-indicator-buffer-type "ERC buffer type in which to display `keep-place-indicator'. A value of t means \"all\" ERC buffers." :group 'erc - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const t) (const server) (const target))) (defcustom erc-keep-place-indicator-follow nil "Whether to sync visual kept place to window's top when reading. For use with `erc-keep-place-indicator-mode'." :group 'erc - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type 'boolean) (defface erc-keep-place-indicator-line diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index dd047243a3c..f168c90df65 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -478,7 +478,7 @@ erc-server-alist this server corresponds, HOST is the server's hostname, and (TLS-)PORTS is either a number, a list of numbers, or a list of port ranges." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(alist :key-type (string :tag "Name") :value-type (group symbol (string :tag "Hostname") diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index d512455090b..fcd3afdbbc4 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -71,7 +71,7 @@ (defgroup erc-nicks nil "Colorize nicknames in ERC target buffers." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :group 'erc) (defcustom erc-nicks-ignore-chars ",`'_-" diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index bb5fad6f52f..ab06de6a42c 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -54,7 +54,7 @@ erc-speedbar (defcustom erc-speedbar-nicknames-window-width 18 "Default width of the nicknames sidebar (in columns)." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type 'integer) (defcustom erc-speedbar-sort-users-type 'activity @@ -69,7 +69,7 @@ erc-speedbar-sort-users-type (defcustom erc-speedbar-hide-mode-topic 'headerline "Hide mode and topic lines." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const :tag "Always show" nil) (const :tag "Always hide" t) (const :tag "Omit when headerline visible" headerline))) @@ -81,7 +81,7 @@ erc-speedbar-my-nick-face When using the `nicks' module, you can see your nick as it appears to others by coordinating with the option `erc-nicks-skip-faces'." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice face (const :tag "Current nick or own speaker face" t))) (defvar erc-speedbar-key-map nil diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index e23380eb936..6eeb7706a61 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -85,7 +85,7 @@ erc-timestamp-format-right Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if the value of this option is nil, it falls back to using the value of `erc-timestamp-format'." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const nil) (string))) (make-obsolete-variable 'erc-timestamp-format-right @@ -159,7 +159,7 @@ erc-echo-timestamp-zone the ZONE parameter of `format-time-string' for a description of acceptable value types." :type '(choice boolean number (const wall) (list number string)) - :package-version '(ERC . "5.6")) ; FIXME sync on release + :package-version '(ERC . "5.6")) (defcustom erc-timestamp-intangible nil "Whether the timestamps should be intangible, i.e. prevent the point @@ -327,7 +327,7 @@ erc-timestamp-use-align-to doesn't already start with one. And when its value is t, it adds a single space, unconditionally." :type '(choice boolean integer) - :package-version '(ERC . "5.6")) ; FIXME sync on release + :package-version '(ERC . "5.6")) (defvar-local erc-stamp--margin-width nil "Width in columns of margin for `erc-stamp--display-margin-mode'. diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el index cf3d20aeffa..d2ecce94bcd 100644 --- a/lisp/erc/erc-status-sidebar.el +++ b/lisp/erc/erc-status-sidebar.el @@ -102,7 +102,7 @@ erc-status-sidebar-highlight-active-buffer "Whether to highlight the selected window's buffer in the sidebar. ERC uses the same instance across all frames. May not be compatible with all values of `erc-status-sidebar-style'." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type 'boolean) (defcustom erc-status-sidebar-style 'all-queries-first @@ -135,7 +135,7 @@ erc-status-sidebar-style them here as customization choices, but you can still specify them manually. See doc strings for a description of their expected arguments and return values." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const channels-only) (const all-mixed) (const all-queries-first) @@ -150,7 +150,7 @@ erc-status-sidebar-click-display-action "How to display a buffer when clicked. Values can be anything recognized by `display-buffer' for its ACTION parameter." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type '(choice (const :tag "Always use/create other window" t) (const :tag "Let `display-buffer' decide" nil) (const :tag "Same window" (display-buffer-same-window diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index cd1c925a757..edcfcf085e6 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.1")) +;; Package-Requires: ((emacs "27.1") (compat "29.1.4.3")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -1354,13 +1354,13 @@ erc-notice-face (((class color) (min-colors 88)) :foreground "SlateBlue") (t :foreground "blue")) "ERC face for notices." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :group 'erc-faces) (defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold) (t :weight bold)) "ERC face for actions generated by /ME." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :group 'erc-faces) (defface erc-error-face '((t :foreground "red")) @@ -1678,7 +1678,7 @@ erc-interactive-display issuance of a slash command, the clicking of a URL hyperlink, or the invocation of an entry-point command. See Info node `(erc) display-buffer' for more." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :group 'erc-buffers :type erc--buffer-display-choices) @@ -1702,7 +1702,7 @@ erc-auto-reconnect-display-timeout "Duration `erc-auto-reconnect-display' remains active. The countdown starts on MOTD and is canceled early by any \"slash\" command." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type 'integer :group 'erc-buffers) @@ -1713,7 +1713,7 @@ erc-reconnect-display-server-buffers consider `erc-interactive-display' when users issue a /RECONNECT. Enabling this tells ERC to always display server buffers according to those options." - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :type 'boolean :group 'erc-buffers) @@ -2150,7 +2150,7 @@ erc-modules (const :tag "unmorse: Translate morse code in messages" unmorse) (const :tag "xdcc: Act as an XDCC file-server" xdcc) (repeat :tag "Others" :inline t symbol)) - :package-version '(ERC . "5.6") ; FIXME sync on release + :package-version '(ERC . "5.6") :group 'erc) (defun erc-update-modules () diff --git a/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld b/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld index f916fea2374..15bcca2a623 100644 --- a/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld +++ b/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) +((pass 10 "PASS :changeme")) ((nick 1 "NICK tester")) ((user 1 "USER user 0 * :tester") (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") diff --git a/test/lisp/erc/resources/base/display-message/multibuf.eld b/test/lisp/erc/resources/base/display-message/multibuf.eld index e49a654cd06..424a687e749 100644 --- a/test/lisp/erc/resources/base/display-message/multibuf.eld +++ b/test/lisp/erc/resources/base/display-message/multibuf.eld @@ -37,7 +37,7 @@ (0.07 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :Would all themselves laugh mortal.") (0.04 ":dummy!~u@rdjcgiwfuwqmc.irc PRIVMSG tester :hi") (0.06 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: It hath pleased the devil drunkenness to give place to the devil wrath; one unperfectness shows me another, to make me frankly despise myself.") - (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)") + (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)") (0.08 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :You speak of him when he was less furnished than now he is with that which makes him both without and within.")) ((quit 10 "QUIT :\2ERC\2") commit 1d2aa130caeb6494e647db02237cfd414249a3db Author: F. Jason Park Date: Fri Nov 10 13:34:31 2023 -0800 Revive erc-command-indicator as new module * doc/misc/erc.texi: Add entry for `command-indicator' to Modules chapter. * etc/ERC-NEWS: Mention new module `command-indicator'. * lisp/erc/erc-goodies.el (erc-noncommands-list): Replace the nonexistent `erc-cmd-SMV' with function `erc-cmd-SAY'. (erc-noncommands-mode, erc-noncommands-enable, erc-noncommands-disable): Deprecate this module because it's a no-op. (erc-command-indicator-face, erc-command-indicator): Migrate from main library. (erc-command-indicator-mode, erc-command-indicator-enable, erc-command-indicator-disable): New module to take the spiritual place of `noncommands'. (erc-command-indicator): Move function here from main library, along with option namesake mentioned above. (erc-command-indicator-toggle-hidden): New command to toggle echoed command-line visibility. (erc--command-indicator-permit-insertion): New function. (erc--command-indicator-display): New function, a slightly revised version of the old `erc-display-command' from the main library. Its only call site was removed back in d1036d288de "backport: erc bugfixes". However, references were left behind to associated assets, like `erc-command-indicator', etc. The function was later commented out in 0c599ee2e2c "* lisp/erc/erc.el: Use `run-hook-with-args` for `erc-pre-send-functions`", and then removed by a63ed6f78a6 "Remove duplicate ERC prompt on reconnect". * lisp/erc/erc-match.el (erc-match-toggle-hidden-fools): Use new non-module-specific name for `erc-match--toggle-hidden'. (erc-match--toggle-hidden): Move to main library for shared use by other modules. * lisp/erc/erc.el (erc-hide-prompt): Leave note explaining updated role. (erc-command-indicator): Move option and function of same name to erc-goodies. (erc-command-indicator-face): Move to erc-goodies. (erc-modules): Remove module `noncommands' from standard value and Custom set. Add `command-indicator' to set. (erc--toggle-hidden): "New" function, a rebranded version of the utility `erc-match--toggle-hidden' from erc-match. (erc--send-input-lines): Accommodate modules wanting alternate insertion functions. (erc-load-irc-script-lines): Account for `erc-command-indicator' no longer being defined in this library. * test/lisp/erc/erc-scenarios-base-send-message.el (erc-scenarios-base-send-message--command-indicator): New test. * test/lisp/erc/erc-tests.el (erc-tests--modules): Remove deprecated module `noncommands' from manifest. (Bug#67031) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 10902eac33f..44e82084b90 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -450,6 +450,11 @@ Modules @item capab-identify Mark unidentified users on freenode and other servers supporting CAPAB. +@cindex modules, command-indicator +@item command-indicator +Echo command lines for ``slash commands'', like @kbd{/JOIN #erc} and +@kbd{/HELP join} + @cindex modules, completion @cindex modules, pcomplete @item completion (aka pcomplete) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f59023eae62..cd4a283ef1c 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -157,6 +157,19 @@ asking users who've customized this option to switch to that some other solution, like automatic migration, is justified, please make that known on the bug list. +** Module 'noncommands' deprecated, replaced by 'command-indicator'. +Command-line echoing has returned to ERC after a near decade-long +hiatus. This means you can elect to have ERC leave a trail of (most) +slash-command input submitted at the prompt, in a manner resembling +that of a shell or a REPL. The particulars are likely of little +interest to most users, but the gist is that this functionality was +removed in 5.3.x (Emacs 24.5) without mention in this document or a +change log. Everything's mostly been restored, except that the +feature is now opt-in. The only real gotcha is that related faces and +options, like 'erc-command-indicator', have moved to the 'erc-goodies' +library, although their Custom groups remain the same. Add +'command-indicator' to 'erc-modules' to get started. + ** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly. It's no secret that the 'buttons' module treats potential nicknames specially. This is perhaps most evident in its treatment of the diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 4cc81dd9378..1482c21e931 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -471,21 +471,26 @@ erc-noncommands-list erc-cmd-COUNTRY erc-cmd-SV erc-cmd-SM - erc-cmd-SMV + erc-cmd-SAY erc-cmd-LASTLOG) - "List of commands that are aliases for CTCP ACTION or for ERC messages. - -If a command's function symbol is in this list, the typed command -does not appear in the ERC buffer after the user presses ENTER.") + "List of client \"slash commands\" that perform their own buffer I/O. +The `command-indicator' module forgoes echoing these commands, +most of which aren't actual interactive lisp commands.") ;;;###autoload(autoload 'erc-noncommands-mode "erc-goodies" nil t) (define-erc-module noncommands nil - "This mode distinguishes non-commands. -Commands listed in `erc-insert-this' know how to display -themselves." + "Treat commands that display themselves specially. +This module has been a no-op since ERC 5.3 and has likely only +ever made sense in the context of `erc-command-indicator'. It +was deprecated in ERC 5.6." ((add-hook 'erc--input-review-functions #'erc-send-distinguish-noncommands)) ((remove-hook 'erc--input-review-functions #'erc-send-distinguish-noncommands))) +(make-obsolete-variable 'erc-noncommand-mode + 'erc-command-indicator-mode "30.1") +(make-obsolete 'erc-noncommand-mode 'erc-command-indicator-mode "30.1") +(make-obsolete 'erc-noncommand-enable 'erc-command-indicator-enable "30.1") +(make-obsolete 'erc-noncommand-disable 'erc-command-indicator-disable "30.1") (defun erc-send-distinguish-noncommands (state) "If STR is an ERC non-command, set `insertp' in STATE to nil." @@ -499,6 +504,106 @@ erc-send-distinguish-noncommands ;; Inhibit sending this string. (setf (erc-input-insertp state) nil)))) + +;;; Command-indicator + +(defface erc-command-indicator-face + '((t :inherit (erc-input-face fixed-pitch-serif))) + "Face for echoed command lines, including the prompt. +See option `erc-command-indicator'." + :package-version '(ERC . "5.6") ; standard value, from bold + :group 'erc-faces) + +(defcustom erc-command-indicator 'erc-prompt + "Pseudo prompt for echoed command lines. +An analog of the option `erc-prompt' that replaces the \"speaker +label\" for echoed \"slash\" commands submitted at the prompt. A +value of nil means ERC only inserts the command-line portion +alone, without the prompt, which may trick certain modules, like +`fill', into treating the leading slash command itself as the +message's speaker." + :package-version '(ERC . "5.6") + :group 'erc-display + :type '(choice (const :tag "Defer to `erc-prompt'" erc-prompt) + (const :tag "Print command lines without a prompt" nil) + (string :tag "User-provided string") + (function :tag "User-provided function"))) + +;;;###autoload(autoload 'erc-command-indicator-mode "erc-goodies" nil t) +(define-erc-module command-indicator nil + "Echo command lines for \"slash commands,\" like /JOIN, /HELP, etc. +Skip those appearing in `erc-noncommands-list'. + +Users can run \\[erc-command-indicator-toggle-hidden] to hide and +reveal echoed command lines after they've been inserted." + ((add-hook 'erc--input-review-functions + #'erc--command-indicator-permit-insertion 80 t) + (erc-command-indicator-toggle-hidden -1)) + ((remove-hook 'erc--input-review-functions + #'erc--command-indicator-permit-insertion t) + (erc-command-indicator-toggle-hidden +1)) + 'local) + +(defun erc-command-indicator () + "Return the command-indicator prompt as a string. +Do nothing if the variable `erc-command-indicator' is nil." + (and erc-command-indicator + (let ((prompt (if (functionp erc-command-indicator) + (funcall erc-command-indicator) + erc-command-indicator))) + (concat prompt (and (not (string-empty-p prompt)) + (not (string-suffix-p " " prompt)) + " "))))) + +(defun erc-command-indicator-toggle-hidden (arg) + "Toggle whether echoed \"slash commands\" are visible." + (interactive "P") + (erc--toggle-hidden 'command-indicator arg)) + +(defun erc--command-indicator-permit-insertion (state) + "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) + (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) + "Insert command LINE as echoed input resembling that of REPLs and shells." + (when erc-insert-this + (save-excursion + (erc--assert-input-bounds) + (let ((insert-position (marker-position (goto-char erc-insert-marker))) + (erc--msg-props (or erc--msg-props + (let ((ovs erc--msg-prop-overrides)) + (map-into `((erc-msg . slash-cmd) + ,@(reverse ovs)) + 'hash-table))))) + (when-let ((string (erc-command-indicator)) + (erc-input-marker (copy-marker erc-input-marker))) + (erc-display-prompt nil nil string 'erc-command-indicator-face) + (remove-text-properties insert-position (point) + '(field nil erc-prompt nil)) + (set-marker erc-input-marker nil)) + (let ((beg (point))) + (insert line) + (erc-put-text-property beg (point) + 'font-lock-face 'erc-command-indicator-face) + (insert "\n")) + (save-restriction + (narrow-to-region insert-position (point)) + (run-hooks 'erc-send-modify-hook) + (run-hooks 'erc-send-post-hook) + (cl-assert (> (- (point-max) (point-min)) 1)) + (erc--hide-message 'command-indicator) + (add-text-properties (point-min) (1+ (point-min)) + (erc--order-text-properties-from-hash + erc--msg-props)))) + (erc--refresh-prompt)))) + + ;;; IRC control character processing. (defgroup erc-control-characters nil "Dealing with control characters." diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 8644e61106f..6fff54d3cf4 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -695,19 +695,7 @@ erc-match-toggle-hidden-fools Expect the function `erc-hide-fools' or similar to be present in `erc-text-matched-hook'." (interactive "P") - (erc-match--toggle-hidden 'match-fools arg)) - -(defun erc-match--toggle-hidden (prop arg) - "Toggle invisibility for spec member PROP. -Treat ARG in a manner similar to mode toggles defined by -`define-minor-mode'." - (when arg - (setq arg (prefix-numeric-value arg))) - (if (memq prop (ensure-list buffer-invisibility-spec)) - (unless (natnump arg) - (remove-from-invisibility-spec prop)) - (when (or (not arg) (natnump arg)) - (add-to-invisibility-spec prop)))) + (erc--toggle-hidden 'match-fools arg)) (provide 'erc-match) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6a110f7ca77..cd1c925a757 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -346,8 +346,13 @@ erc-hide-prompt "If non-nil, hide input prompt upon disconnecting. To unhide, type something in the input area. Once revealed, a prompt remains unhidden until the next disconnection. Channel -prompts are unhidden upon rejoining. See -`erc-unhide-query-prompt' for behavior concerning query prompts." +prompts are unhidden upon rejoining. For behavior concerning +query prompts, see `erc-unhide-query-prompt'. Longtime ERC users +should note that this option was repurposed in ERC 5.5 because it +had lain dormant for years after being sidelined in 5.3 when its +only use in the interactive client was removed. Before then, its +role was controlling whether `erc-command-indicator' would appear +alongside echoed slash-command lines." :package-version '(ERC . "5.5") :group 'erc-display :type '(choice (const :tag "Always hide prompt" t) @@ -759,28 +764,6 @@ erc-prompt (concat prompt " ") prompt))) -(defcustom erc-command-indicator nil - "Indicator used by ERC for showing commands. - -If non-nil, this will be used in the ERC buffer to indicate -commands (i.e., input starting with a `/'). - -If nil, the prompt will be constructed from the variable `erc-prompt'." - :group 'erc-display - :type '(choice (const nil) string function)) - -(defun erc-command-indicator () - "Return the command indicator prompt as a string. - -This only has any meaning if the variable `erc-command-indicator' is non-nil." - (and erc-command-indicator - (let ((prompt (if (functionp erc-command-indicator) - (funcall erc-command-indicator) - erc-command-indicator))) - (if (> (length prompt) 0) - (concat prompt " ") - prompt)))) - (defcustom erc-notice-prefix "*** " "Prefix for all notices." :group 'erc-display @@ -1364,12 +1347,6 @@ erc-prompt-face "ERC face for the prompt." :group 'erc-faces) -(defface erc-command-indicator-face - '((t :weight bold)) - "ERC face for the command indicator. -See the variable `erc-command-indicator'." - :group 'erc-faces) - (defface erc-notice-face '((default :weight bold) (((class color) (min-colors 88) (supports :weight semi-bold)) @@ -2077,7 +2054,7 @@ erc--sort-modules (defcustom erc-modules '( autojoin button completion fill imenu irccontrols list match menu move-to-prompt netsplit - networks noncommands readonly ring stamp track) + 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 @@ -2127,6 +2104,7 @@ erc-modules (const :tag "button: Buttonize URLs, nicknames, and other text" button) (const :tag "capab: Mark unidentified users on servers supporting CAPAB" capab-identify) + (const :tag "command-indicator: Echo command lines." command-indicator) (const :tag "completion: Complete nicknames and commands (programmable)" completion) (const :tag "dcc: Provide Direct Client-to-Client support" dcc) @@ -2146,7 +2124,7 @@ erc-modules (const :tag "networks: Provide data about IRC networks" networks) (const :tag "nickbar: Show nicknames in a dyamic side window" nickbar) (const :tag "nicks: Uniquely colorize nicknames in target buffers" nicks) - (const :tag "noncommands: Don't display non-IRC commands after evaluation" + (const :tag "noncommands: Deprecated. See module `command-indicator'." noncommands) (const :tag "notifications: Desktop alerts on PRIVMSG or mentions" notifications) @@ -3328,6 +3306,18 @@ erc--hide-message (cl-incf beg)) (erc--merge-prop (1- beg) (1- end) 'invisible value))))) +(defun erc--toggle-hidden (prop arg) + "Toggle invisibility for spec member PROP. +Treat ARG in a manner similar to mode toggles defined by +`define-minor-mode'." + (when arg + (setq arg (prefix-numeric-value arg))) + (if (memq prop (ensure-list buffer-invisibility-spec)) + (unless (natnump arg) + (remove-from-invisibility-spec prop)) + (when (or (not arg) (natnump arg)) + (add-to-invisibility-spec prop)))) + (defun erc--delete-inserted-message (beg-or-point &optional end) "Remove message between BEG and END. Expect BEG and END to match bounds as returned by the macro @@ -7051,7 +7041,9 @@ erc--send-input-lines (when (erc--input-split-sendp lines-obj) (dolist (line (erc--input-split-lines lines-obj)) (when (erc--input-split-insertp lines-obj) - (erc-display-msg line)) + (if (functionp (erc--input-split-insertp lines-obj)) + (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)))))) @@ -7557,7 +7549,10 @@ erc-load-irc-script-lines user input." (let* ((cb (current-buffer)) (s "") - (sp (or (erc-command-indicator) (erc-prompt))) + (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))) diff --git a/test/lisp/erc/erc-scenarios-base-send-message.el b/test/lisp/erc/erc-scenarios-base-send-message.el index 904381abe6a..bf9e0f5ae3a 100644 --- a/test/lisp/erc/erc-scenarios-base-send-message.el +++ b/test/lisp/erc/erc-scenarios-base-send-message.el @@ -69,4 +69,58 @@ erc-scenarios-base-send-message--noncommands (funcall expect 10 " No, not till Thursday;")))))) +;; This asserts that the `command-indicator' module only inserts +;; prompt-like prefixes for normal slash commands, like /JOIN. + +(ert-deftest erc-scenarios-base-send-message--command-indicator () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/send-message") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'noncommands)) + (erc-modules `(command-indicator fill-wrap ,@erc-modules)) + (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" + :full-name "tester") + (funcall expect 5 "debug mode") + (erc-scenarios-common-say "/join #chan") + (funcall expect 10 "ERC> /join #chan"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (ert-info ("Prompt absent for CTCP ACTION") + (funcall expect 10 " alice: For hands, to do Rome") + (erc-scenarios-common-say "/me sad") + (funcall expect -0.1 "ERC> /me sad") + (funcall expect 10 "* tester sad")) + + (ert-info ("Prompt absent for literal command") + (funcall expect 10 " bob: Spotted, detested") + (erc-scenarios-common-say "/say /me sad") + (funcall expect -0.1 "ERC> /say /me sad") + (funcall expect 10 " /me sad")) + + (ert-info ("Prompt absent for /SV") + (funcall expect 10 " Marcus, my brother!") + (erc-scenarios-common-say "/sv") + (funcall expect -0.1 "ERC> /sv") + (funcall expect 10 " I'm using ERC")) + + (ert-info ("Prompt absent module list via /SM") + (funcall expect 10 " alice: You still wrangle") + (erc-scenarios-common-say "/sm") + (funcall expect -0.1 "ERC> /sm") + (funcall expect 10 " I'm using the following modules: ") + (funcall expect 10 " No, not till Thursday;")) + + (ert-info ("Prompt present for /QUIT in issuing buffer") + (erc-scenarios-common-say "/quit") + (funcall expect 10 "ERC> /quit")) + + (with-current-buffer "foonet" + (funcall expect 10 "ERC finished"))))) + ;;; erc-scenarios-base-send-message.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2898ca7be75..e7422d330c0 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2543,7 +2543,8 @@ erc-handle-irc-url (kill-buffer "#chan"))) (defconst erc-tests--modules - '( autoaway autojoin bufbar button capab-identify completion dcc fill identd + '( autoaway autojoin bufbar button capab-identify + command-indicator completion dcc fill identd imenu irccontrols keep-place list log match menu move-to-prompt netsplit networks nickbar nicks noncommands notifications notify page readonly replace ring sasl scrolltobottom services smiley sound commit 583d73e9a0edb8cb79c4a821b39685aa220bbefa Author: F. Jason Park Date: Wed Nov 8 21:20:54 2023 -0800 Simplify default text props for ERC input * lisp/erc/erc.el (erc--msg-props): Reformat doc string to improve readability. (erc-send-current-line): Don't bind `erc--msg-prop-overrides' because doing so affects all scoped calls to `erc-display-message' made by slash commands, etc. and makes handling overly complex and error prone. (erc-display-msg): Set `erc-msg' property to `msg' instead of `self' because the only legitimate use of this function is for inserting "echoed" prompt input. (Bug#60936 and Bug#67031) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6d7251f0677..6a110f7ca77 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -155,31 +155,28 @@ erc--msg-props as of ERC 5.6: - `erc-msg': a symbol, guaranteed present; values include: - - - `msg', signifying a `PRIVMSG' or an incoming `NOTICE' - - `self', a fallback used by `erc-display-msg' for callers - that don't specify an `erc-msg' - - `unknown', a similar fallback for `erc-display-message' - - a catalog key, such as `s401' or `finished' - - an `erc-display-message' TYPE parameter, like `notice' + `msg', signifying a `PRIVMSG' or an incoming `NOTICE'; + `unknown', a fallback for `erc-display-message'; a catalog + key, such as `s401' or `finished'; an `erc-display-message' + TYPE parameter, like `notice' - `erc-cmd': a message's associated IRC command, as read by `erc--get-eq-comparable-cmd'; currently either a symbol, like `PRIVMSG', or a number, like 5, which represents the numeric - \"005\"; absent on \"local\" messages, such as simple warnings - and help text, and on outgoing messages unless echoed back by - the server (assuming future support) + \"005\"; absent on \"local\" messages, such as simple warnings + and help text, and on outgoing messages unless echoed back by + the server (assuming future support) - `erc-ctcp': a CTCP command, like `ACTION' - `erc-ts': a timestamp, possibly provided by the server; as of - 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\" - type otherwise; managed by the `stamp' module + 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\" + type otherwise; managed by the `stamp' module - `erc-ephemeral': a symbol prefixed by or matching a module - name; indicates to other modules and members of modification - hooks that the current message should not affect stateful - operations, such as recording a channel's most recent speaker + name; indicates to other modules and members of modification + hooks that the current message should not affect stateful + operations, such as recording a channel's most recent speaker This is an internal API, and the selection of related helper utilities is fluid and provisional. As of ERC 5.6, see the @@ -6966,8 +6963,7 @@ erc-send-current-line (inhibit-read-only t) (erc--current-line-input-split state) (old-buf (current-buffer))) - (let ((erc--msg-prop-overrides `((erc-msg . msg) - ,@erc--msg-prop-overrides))) + (progn ; unprogn this during next major surgery (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt (delete-region erc-input-marker (erc-end-of-input-line)) @@ -7114,16 +7110,15 @@ erc-send-input (defun erc-display-msg (line) "Insert LINE into current buffer and run \"send\" hooks. -Expect LINE to originate from input submitted interactively at -the prompt, such as outgoing chat messages or echoed slash -commands." +Treat LINE as input submitted interactively at the prompt, such +as outgoing chat messages and echoed slash commands." (when erc-insert-this (save-excursion (erc--assert-input-bounds) (let ((insert-position (marker-position (goto-char erc-insert-marker))) - (erc--msg-props (or erc--msg-props ; prefer `self' to `unknown' + (erc--msg-props (or erc--msg-props (let ((ovs erc--msg-prop-overrides)) - (map-into `((erc-msg . self) ,@(reverse ovs)) + (map-into `((erc-msg . msg) ,@(reverse ovs)) 'hash-table)))) beg) (insert (erc-format-my-nick)) commit 4ed6ba90e7c4d2148a7bb1d2ff1027ebc765f606 Author: F. Jason Park Date: Mon Sep 18 03:39:57 2023 -0700 Allow opting out of empty message padding in ERC * lisp/erc/erc.el (erc--allow-empty-outgoing-lines-p): New internal variable. (erc-send-input-line, erc--run-send-hooks): Don't pad output when `erc--allow-empty-outgoing-lines-p' is non-nil. (Bug#67031) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index c9c24f2642f..6d7251f0677 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3684,6 +3684,11 @@ erc--current-line-input-split details about the input it's handling or needs to detect whether it's been dispatched by `erc-send-current-line'.") +(defvar erc--allow-empty-outgoing-lines-p nil + "Flag to opt out of last-minute padding of empty lines. +Useful to extensions, like `multiline', and for interop with +IRC-adjacent protocols.") + (defvar-local erc-send-input-line-function #'erc-send-input-line "Function for sending lines lacking a leading \"slash\" command. When prompt input starts with a \"slash\" command, like \"/MSG\", @@ -3697,7 +3702,7 @@ erc-send-input-line-function (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET." - (when (string= line "\n") + (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) @@ -7033,9 +7038,11 @@ erc--run-send-hooks (erc--input-split-insertp lines-obj) (erc-input-insertp state) ;; See note in test of same name re trailing newlines. (erc--input-split-lines lines-obj) - (cl-nsubst " " "" (split-string (erc-input-string state) - erc--input-line-delim-regexp) - :test #'equal)) + (let ((lines (split-string (erc-input-string state) + erc--input-line-delim-regexp))) + (if erc--allow-empty-outgoing-lines-p + lines + (cl-nsubst " " "" lines :test #'equal)))) (when (erc-input-refoldp state) (erc--split-lines lines-obj))))) (when (and (erc--input-split-cmdp lines-obj) commit 174b3dd9bd78c662ce9fff78404dcfa02259d21b Author: F. Jason Park Date: Fri Jun 9 21:00:03 2023 -0700 Make nested input handling more robust in ERC * lisp/erc/erc.el (erc--send-action-function): New function-valued variable for locally advising `erc-send-action' so that built-in modules can elect to handle insertion and sending themselves. (erc-send-action): Defer to `erc--send-action-function'. (erc--send-action-perform-ctcp): Isolate the message-sending business for CTCP ACTIONs that used to reside in `erc-send-action'. (erc--send-action-display): Isolate the message-insertion business formerly residing in `erc-send-action' for more granular use. Fix a minor bug involving inserted representations of CTCP ACTIONs not having `erc-my-nick-face' applied to the speaker. (erc--send-action): Perform the same displaying and sending of CTCP ACTION messages formerly handled by `erc-send-action', but display messages before sending them. (erc--current-line-input-split): New variable bound to the post-review `erc--input-split' object for the extent of display processing. This mainly benefits slash-command handlers and the utility functions they employ, such as `erc-send-message'. (erc-cmd-SAY): Defer to `erc--send-message'. (erc--send-message-nested-function): New function-valued variable supporting an internal interface for influencing how `erc-send-message' inserts and sends prompt input. Some handlers for slash commands, like /SV, use `erc-send-message' to perform their own insertion and sending, which is normally the domain of `erc-send-current-line'. When this happens, modules can't easily leverage the normal hook-based API to do things like suppress insertion but allow sending or vice-versa. This variable provides an internal seam for modules to exert such influence. (erc-send-message): Behave specially when called by the default interactive client via `erc-send-current-line' and friends. (erc--send-message-external): New function to house the former body of `erc-send-message', for third-party code needing to apply the traditional behavior. (erc--send-message-nested): New function for turning arbitrary text, such as replacement prompt input, into outgoing message text by doing things like ensuring "send" hooks run and invariants for prompt markers are preserved. (erc--make-input-split): New helper function for creating a standard `erc--input-split' object from a string. This is arguably less confusing than adding another constructor to the struct definition. (erc-send-current-line): Bind `erc--current-line-input-split' when dispatching prompt-input handlers. Use helper `erc--make-input-split' to initialize working `erc--input-split' state object. (erc--run-send-hooks): Honor existing `refoldp' slot from `erc--input-split' object. (erc--send-input-lines): Convert to generic function to allow modules control over fundamental insertion and sending operations, which is necessary for next-generation features, like multiline messages. (erc-modes): Don't output non-modules. That is, only list actual modules created via `define-erc-module', and `quote' members of the resulting list. * test/lisp/erc/erc-scenarios-base-send-message.el: New test file. * test/lisp/erc/resources/base/send-message/noncommands.eld: New data file. (Bug#67031) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2d8f388328d..c9c24f2642f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2948,17 +2948,40 @@ erc-toggle-debug-irc-protocol ;; send interface +(defvar erc--send-action-function #'erc--send-action + "Function to display and send an outgoing CTCP ACTION message. +Called with three arguments: the submitted input, the current +target, and an `erc-server-send' FORCE flag.") + (defun erc-send-action (tgt str &optional force) "Send CTCP ACTION information described by STR to TGT." - (erc-send-ctcp-message tgt (format "ACTION %s" str) force) - ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us. + (funcall erc--send-action-function tgt str force)) + +;; Sending and displaying are provided separately to afford modules +;; more flexibility, e.g., to forgo displaying on the way out when +;; expecting the server to echo messages back and/or to associate +;; outgoing messages with IDs generated for `erc-ephemeral' +;; placeholders. +(defun erc--send-action-perform-ctcp (target string force) + "Send STRING to TARGET, possibly immediately, with FORCE." + (erc-send-ctcp-message target (format "ACTION %s" string) force)) + +(defun erc--send-action-display (string) + "Display STRING as an outgoing \"CTCP ACTION\" message." + ;; Allow hooks acting on inserted PRIVMSG and NOTICES to process us. (let ((erc--msg-prop-overrides `((erc-msg . msg) (erc-ctcp . ACTION) ,@erc--msg-prop-overrides)) (nick (erc-current-nick))) - (setq nick (propertize nick 'erc-speaker nick)) + (setq nick (propertize nick 'erc-speaker nick + 'font-lock-face 'erc-my-nick-face)) (erc-display-message nil '(t action input) (current-buffer) - 'ACTION ?n nick ?a str ?u "" ?h ""))) + 'ACTION ?n nick ?a string ?u "" ?h ""))) + +(defun erc--send-action (target string force) + "Display STRING, then send to TARGET as a \"CTCP ACTION\" message." + (erc--send-action-display string) + (erc--send-action-perform-ctcp target string force)) ;; Display interface @@ -3655,6 +3678,12 @@ erc--called-as-input-p "Non-nil when a user types a \"/slash\" command. Remains bound until `erc-cmd-SLASH' returns.") +(defvar erc--current-line-input-split nil + "Current `erc--input-split' instance when processing user input. +This is for special cases in which a \"slash\" command needs +details about the input it's handling or needs to detect whether +it's been dispatched by `erc-send-current-line'.") + (defvar-local erc-send-input-line-function #'erc-send-input-line "Function for sending lines lacking a leading \"slash\" command. When prompt input starts with a \"slash\" command, like \"/MSG\", @@ -3791,9 +3820,7 @@ erc-cmd-SAY (if (string-match "^\\s-*$" line) nil (string-match "^ ?\\(.*\\)" line) - (let ((msg (match-string 1 line))) - (erc-display-msg msg) - (erc-process-input-line msg nil t)))) + (erc-send-message (match-string 1 line) nil))) (put 'erc-cmd-SAY 'do-not-parse-args t) (defun erc-cmd-SET (line) @@ -4489,10 +4516,25 @@ erc-cmd-LASTLOG (put 'erc-cmd-LASTLOG 'do-not-parse-args t) (put 'erc-cmd-LASTLOG 'process-not-needed t) +(defvar erc--send-message-nested-function #'erc--send-message-nested + "Function for inserting and sending slash-command generated text. +When a command like /SV or /SAY modifies or replaces command-line +input originally submitted at the prompt, `erc-send-message' +performs additional processing to ensure said input is fit for +inserting and sending given this \"nested\" meta context. This +interface variable exists because modules extending fundamental +insertion and sending operations need a say in this processing as +well.") + (defun erc-send-message (line &optional force) "Send LINE to the current channel or user and display it. See also `erc-message' and `erc-display-line'." + (if (erc--input-split-p erc--current-line-input-split) + (funcall erc--send-message-nested-function line force) + (erc--send-message-external line force))) + +(defun erc--send-message-external (line force) (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force) (erc-display-line (concat (erc-format-my-nick) line) @@ -4500,6 +4542,24 @@ erc-send-message ;; FIXME - treat multiline, run hooks, or remove me? t) +(defun erc--send-message-nested (input-line force) + "Process string INPUT-LINE almost as if it's normal chat input. +Expect INPUT-LINE to differ from the `string' slot of the calling +context's `erc--current-line-input-split' object because the +latter is likely a slash command invocation whose handler +generated INPUT-LINE. Before inserting INPUT-LINE, split it and +run `erc-send-modify-hook' and `erc-send-post-hook' on each +actual outgoing line. Forgo input validation because this isn't +interactive input, and skip `erc-send-completed-hook' because it +will run just before the outer `erc-send-current-line' call +returns." + (let* ((erc-flood-protect (not force)) + (lines-obj (erc--make-input-split input-line))) + (setf (erc--input-split-refoldp lines-obj) t + (erc--input-split-cmdp lines-obj) nil) + (erc--send-input-lines (erc--run-send-hooks lines-obj))) + t) + (defun erc-cmd-MODE (line) "Change or display the mode value of a channel or user. The first word specifies the target. The rest is the mode string @@ -6873,6 +6933,14 @@ erc--inhibit-slash-cmd-insertion (when (erc--input-split-cmdp state) (setf (erc--input-split-insertp state) nil))) +(defun erc--make-input-split (string) + (make-erc--input-split + :string string + :insertp erc-insert-this + :sendp erc-send-this + :lines (split-string string erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp string))) + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) @@ -6887,16 +6955,11 @@ erc-send-current-line (expand-abbrev)) (widen) (let* ((str (erc-user-input)) - (state (make-erc--input-split - :string str - :insertp erc-insert-this - :sendp erc-send-this - :lines (split-string - str erc--input-line-delim-regexp) - :cmdp (string-match erc-command-regexp str)))) + (state (erc--make-input-split str))) (run-hook-with-args 'erc--input-review-functions state) (when-let (((not (erc--input-split-abortp state))) (inhibit-read-only t) + (erc--current-line-input-split state) (old-buf (current-buffer))) (let ((erc--msg-prop-overrides `((erc-msg . msg) ,@erc--msg-prop-overrides))) @@ -6962,6 +7025,8 @@ erc--run-send-hooks (run-hook-with-args 'erc-send-pre-hook str) (make-erc-input :string str :insertp erc-insert-this + :refoldp (erc--input-split-refoldp + lines-obj) :sendp erc-send-this)))) (run-hook-with-args 'erc-pre-send-functions state) (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state) @@ -6978,7 +7043,7 @@ erc--run-send-hooks (user-error "Multiline command detected" )) lines-obj) -(defun erc--send-input-lines (lines-obj) +(cl-defmethod 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)) @@ -8103,10 +8168,11 @@ erc-modes (let (modes (case-fold-search nil)) (dolist (var (apropos-internal "^erc-.*mode$")) (when (and (boundp var) + (get var 'erc-module) (symbol-value var)) - (setq modes (cons (symbol-name var) + (setq modes (cons (concat "`" (symbol-name var) "'") modes)))) - modes) + (sort modes #'string<)) ", "))) (if here (insert string) diff --git a/test/lisp/erc/erc-scenarios-base-send-message.el b/test/lisp/erc/erc-scenarios-base-send-message.el new file mode 100644 index 00000000000..904381abe6a --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-send-message.el @@ -0,0 +1,72 @@ +;;; erc-scenarios-base-send-message.el --- `send-message' scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2022-2023 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-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +;; So-called "noncommands" are those that massage input submitted at +;; the prompt and send it on behalf of the user. + +(ert-deftest erc-scenarios-base-send-message--noncommands () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/send-message") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'noncommands)) + (erc-modules (cons 'fill-wrap erc-modules)) + (erc-autojoin-channels-alist '((foonet "#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" + :full-name "tester") + (funcall expect 5 "debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (ert-info ("Send CTCP ACTION") + (funcall expect 10 " alice: For hands, to do Rome") + (erc-scenarios-common-say "/me sad") + (funcall expect 10 "* tester sad")) + + (ert-info ("Send literal command") + (funcall expect 10 " bob: Spotted, detested") + (erc-scenarios-common-say "/say /me sad") + (funcall expect 10 " /me sad")) + + (ert-info ("\"Nested\" `noncommands'") + + (ert-info ("Send version via /SV") + (funcall expect 10 " Marcus, my brother!") + (erc-scenarios-common-say "/sv") + (funcall expect 10 " I'm using ERC")) + + (ert-info ("Send module list via /SM") + (funcall expect 10 " alice: You still wrangle") + (erc-scenarios-common-say "/sm") + (funcall expect 10 " I'm using the following modules: ") + (funcall expect 10 " No, not till Thursday;")))))) + + +;;; erc-scenarios-base-send-message.el ends here diff --git a/test/lisp/erc/resources/base/send-message/noncommands.eld b/test/lisp/erc/resources/base/send-message/noncommands.eld new file mode 100644 index 00000000000..ba210bfff6f --- /dev/null +++ b/test/lisp/erc/resources/base/send-message/noncommands.eld @@ -0,0 +1,52 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":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 Sun, 12 Nov 2023 17:40:20 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.02 ":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.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.01 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.01 ":irc.foonet.org 254 tester 2 :channels formed") + (0.01 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.01 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.02 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":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.")) + +((mode-tester 10 "MODE tester +i")) + +((join-chan 10 "JOIN #chan") + (0.00 ":irc.foonet.org 221 tester +i") + (0.01 ":tester!~u@ggpg6r3a68wak.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.02 ":irc.foonet.org 329 tester #chan 1699810829") + (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: To prove him false that says I love thee not.") + (0.02 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: For hands, to do Rome service, are but vain.")) + +((privmsg-action 10 "PRIVMSG #chan :\1ACTION sad\1") + (0.07 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: Spotted, detested, and abominable.")) + +((privmsg-me 10 "PRIVMSG #chan :/me sad") + (0.03 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :Marcus, my brother! 'tis sad Titus calls.")) + +((privmsg-sv 10 "PRIVMSG #chan :I'm using ERC " (+ (not " ")) " with GNU Emacs") + (0.07 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: You still wrangle with her, Boyet, and she strikes at the brow.")) + +((privmsg-sm 10 "PRIVMSG #chan :I'm using the following modules: `erc-autojoin-mode', ") + (0.04 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :No, not till Thursday; there is time enough.")) + +((quit 10 "QUIT :\2ERC\2") + (0.05 ":tester!~u@ggpg6r3a68wak.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)") + (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")) commit e2130fe9272b6fdc3d32f19734570347a8d580fd Author: F. Jason Park Date: Fri Jul 15 05:02:35 2022 -0700 Always run erc-server-send-queue via timer * lisp/erc/erc-backend.el (erc--server-send, erc-server-send): Convert the latter into a wrapper that calls the former, a "new" internal generic function, so that built-in modules can do things like prepend tags to outgoing messages and send messages over other transports or proxy protocols. Extend the `no-penalty' parameter to mean ERC will schedule an imminent send via a timer. And always run the function `erc-server-send-queue' on a timer. (Bug#67031) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 32d891cd1c6..9281c107d06 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1171,7 +1171,7 @@ erc-server-send When FORCE is non-nil, bypass flood protection so that STRING is sent directly without modifying the queue. When FORCE is the symbol `no-penalty', exempt this round from accumulating a -timeout penalty. +timeout penalty and schedule it to run ASAP instead of blocking. If TARGET is specified, look up encoding information for that channel in `erc-encoding-coding-alist' or @@ -1179,6 +1179,11 @@ erc-server-send See `erc-server-flood-margin' for an explanation of the flood protection algorithm." + (erc--server-send string force target)) + +(cl-defmethod erc--server-send (string force target) + "Encode and send STRING to `erc-server-process'. +Expect STRING, FORCE, and TARGET to originate from `erc-server-send'." (erc-log (concat "erc-server-send: " string "(" (buffer-name) ")")) (setq erc-server-last-sent-time (erc-current-time)) (let ((encoding (erc-coding-system-for-target target))) @@ -1199,14 +1204,17 @@ erc-server-send (when (fboundp 'set-process-coding-system) (set-process-coding-system erc-server-process 'raw-text encoding)) - (process-send-string erc-server-process str)) + (if (and (eq force 'no-penalty)) + (run-at-time nil nil #'process-send-string + erc-server-process str) + (process-send-string erc-server-process str))) ;; See `erc-server-send-queue' for full ;; explanation of why we need this condition-case (error nil))) (setq erc-server-flood-queue (append erc-server-flood-queue (list (cons str encoding)))) - (erc-server-send-queue (current-buffer)))) + (run-at-time nil nil #'erc-server-send-queue (current-buffer)))) t) (message "ERC: No process running") nil))) commit beb60a9027ce61b4fa5b003804a46fefc4916c6f Author: F. Jason Park Date: Wed Nov 8 19:14:55 2023 -0800 Make ERC's error-notice formatting more consistent * lisp/erc/erc-backend.el (erc--server-propagate-failed-connection): Include leading three-asterisk notice prefix when reporting process exit status, and set the `erc-msg' text property to `notice-error'. (erc-schedule-reconnect): Include leading notice prefix when inserting `reconnecting' message. * lisp/erc/erc.el (erc-process-input-line, erc-cmd-PART, erc-cmd-TOPIC): Display `no-target' messages as "error notices". (erc-message-english-disconnected, erc-message-english-disconnected-noreconnect): Hard-code standard value of `erc-notice-prefix' into message text for consistency during formatting and insertion. * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Expect notice prefix before `no-target' message. (Bug#67031) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4b5edaa77d2..32d891cd1c6 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -728,7 +728,7 @@ erc--server-propagate-failed-connection the server buffer in any case." (when (eq (process-status process) 'failed) (erc-display-message - nil 'error (process-buffer process) + nil '(notice error) (process-buffer process) (format "Process exit status: %S" (process-exit-status process))) (pcase (process-exit-status process) (111 @@ -995,7 +995,7 @@ erc-schedule-reconnect (- erc-server-reconnect-attempts (cl-incf erc-server-reconnect-count (or incr 1))))) (proc (buffer-local-value 'erc-server-process buffer))) - (erc-display-message nil 'error buffer 'reconnecting + (erc-display-message nil '(notice error) buffer 'reconnecting ?m erc-server-reconnect-timeout ?i (if count erc-server-reconnect-count "N") ?n (if count erc-server-reconnect-attempts "A")) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fd57cb9d6a0..2d8f388328d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3729,7 +3729,7 @@ erc-process-input-line (let ((r (erc-default-target))) (if r (funcall erc-send-input-line-function r line force) - (erc-display-message nil 'error (current-buffer) 'no-target) + (erc-display-message nil '(notice error) (current-buffer) 'no-target) nil))))) (defconst erc--shell-parse-regexp @@ -4581,7 +4581,7 @@ erc-cmd-PART (format "PART %s" ch) (format "PART %s :%s" ch reason)) nil ch)) - (erc-display-message nil 'error (current-buffer) 'no-target))) + (erc-display-message nil '(notice error) (current-buffer) 'no-target))) t) (t nil))) (put 'erc-cmd-PART 'do-not-parse-args t) @@ -4921,7 +4921,7 @@ erc-cmd-TOPIC (progn (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) - (erc-display-message nil 'error (current-buffer) 'no-target))) + (erc-display-message nil '(notice error) (current-buffer) 'no-target))) t) (t nil))) (defalias 'erc-cmd-T #'erc-cmd-TOPIC) @@ -8194,9 +8194,10 @@ erc-define-catalog (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.") (flood-strict-mode . "FLOOD PROTECTION: Switched to Strict Flood Control mode.") - (disconnected . "\n\nConnection failed! Re-establishing connection...\n") + (disconnected + . "\n\n*** Connection failed! Re-establishing connection...\n") (disconnected-noreconnect - . "\n\nConnection failed! Not re-establishing connection.\n") + . "\n\n*** Connection failed! Not re-establishing connection.\n") (reconnecting . "Reconnecting in %ms: attempt %i/%n ...") (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...") (finished . "\n\n*** ERC finished ***\n") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 916b394c8ff..2898ca7be75 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -317,7 +317,7 @@ erc--refresh-prompt (insert "Howdy") (erc-send-current-line) (save-excursion (forward-line -1) - (should (looking-at "No target")) + (should (looking-at (rx "*** No target"))) (forward-line -1) (should (looking-at " Howdy"))) (should (looking-back "ServNet 6> ")) commit 5baa0f61f8dc65ec45e3fe49c8179e4ae6830a84 Author: F. Jason Park Date: Sun Sep 3 16:05:59 2023 -0700 Offer alternate pool-creation strategies in erc-nicks * lisp/erc/erc-nicks.el (erc-nicks-bg-color): Expand doc string. (erc-nicks-colors): Add new choices `font-lock' and `ansi-color'. (erc-nicks--adjust-contrast): Add assertion to prevent dependency bug from resurfacing when hacking on module activation code. (erc-nicks--create-pool-function): New function-valued variable to specify a pool creation strategy. Note in doc string that this could form the basis for a possible user option should the need arise. (erc-nicks--create-coerced-pool): New function for filtering user-provided `erc-nicks-color' values. (erc-nicks--create-pool, erc-nicks--create-culled-pool): Rename former to latter. (erc-nicks--init-pool): Call `erc-nicks--create-pool-function' to actually create pool. Account for new `erc-nicks-colors' values. (erc-nicks-enable, erc-nicks-mode): Set `erc-nicks--fg-rgb' before `erc-nicks--init-pool' to prevent type error in filters that depend on that variable being initialized. This is a bug fix. (erc-nicks-refresh): Provide helpful user error instead of letting `arith-error' propagate due to an empty pool. (erc-nicks--colors-from-faces): New helper function. * test/lisp/erc/erc-nicks-tests.el (erc-nicks--create-pool, erc-nicks--create-culled-pool): Rename test from former to latter and update function invocations to reflect that. (erc-nicks--create-coerced-pool): New test. (Bug#63569) diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index a7d0b0769f2..d512455090b 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -102,7 +102,10 @@ erc-nicks-bg-color (frame-parameter (selected-frame) 'background-color) "Background color for calculating contrast. Set this explicitly when the background color isn't discoverable, -which may be the case in terminal Emacs." +which may be the case in terminal Emacs. Even when automatically +initialized, this value may need adjustment mid-session, such as +after loading a new theme. Remember to run \\[erc-nicks-refresh] +after doing so." :type 'string) (defcustom erc-nicks-color-adjustments @@ -153,9 +156,13 @@ erc-nicks-colors single symbol representing a set of colors, like that produced by the function `defined-colors', which ERC associates with the symbol `defined'. Similarly, `all' tells ERC to use any 24-bit -color. When specifying a list, users may want to set the option -`erc-nicks-color-adjustments' to nil to prevent unwanted culling." - :type '(choice (const all) (const defined) (repeat string))) +color. To change the value mid-session, try +\\[erc-nicks-refresh]." + :type `(choice (const :tag "All 24-bit colors" all) + (const :tag "Defined terminal colors" defined) + (const :tag "Font Lock faces" font-lock) + (const :tag "ANSI color faces" ansi-color) + (repeat :tag "User-provided list" string))) (defcustom erc-nicks-key-suffix-format "@%n" "Template for latter portion of keys to generate colors from. @@ -227,6 +234,7 @@ erc-nicks--bg-mode ;; https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html (defun erc-nicks--adjust-contrast (color target &optional decrease) + (cl-assert erc-nicks--fg-rgb) (let* ((lum-bg (or erc-nicks--bg-luminance (setq erc-nicks--bg-luminance (erc-nicks--get-luminance erc-nicks-bg-color)))) @@ -356,7 +364,40 @@ erc-nicks--reduce erc-nicks-color-adjustments (if (stringp color) (color-name-to-rgb color) color)))) -(defun erc-nicks--create-pool (adjustments colors) +(defvar erc-nicks--create-pool-function #'erc-nicks--create-coerced-pool + "Filter function for initializing the pool of colors. +Takes a list of adjustment functions, such as those named in +`erc-nicks-color-adjustments', and a list of colors. Returns +another list whose members need not be among the original +candidates. Users should note that this variable, along with its +predefined function values, `erc-nicks--create-coerced-pool' and +`erc-nicks--create-culled-pool', can be made public in a future +version of this module, perhaps as a single user option, given +sufficient demand.") + +(defun erc-nicks--create-coerced-pool (adjustments colors) + "Return COLORS that fall within parameters heeded by ADJUSTMENTS. +Apply ADJUSTMENTS and dedupe after replacing adjusted values with +those nearest defined for the terminal. Only perform one pass. +That is, accept the nearest initially found as \"close enough,\" +knowing that values may fall outside desired parameters and thus +yield a larger pool than simple culling might produce. When +debugging, add candidates to `erc-nicks--colors-rejects' that map +to the same output color as some prior candidate." + (let* ((seen (make-hash-table :test #'equal)) + (erc-nicks-color-adjustments adjustments) + pool) + (dolist (color colors) + (let ((quantized (car (tty-color-approximate + (color-values (erc-nicks--reduce color)))))) + (if (gethash quantized seen) + (when erc-nicks--colors-rejects + (push color erc-nicks--colors-rejects)) + (push quantized pool) + (puthash quantized color seen)))) + (nreverse pool))) + +(defun erc-nicks--create-culled-pool (adjustments colors) "Return COLORS that fall within parameters indicated by ADJUSTMENTS." (let (addp capp satp pool) (dolist (adjustment adjustments) @@ -382,8 +423,12 @@ erc-nicks--init-pool "Initialize colors and optionally display faces or color palette." (unless (eq erc-nicks-colors 'all) (let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors) + (and (memq erc-nicks-colors '(font-lock ansi-color)) + (erc-nicks--colors-from-faces + (format "%s-" erc-nicks-colors))) (defined-colors))) - (pool (erc-nicks--create-pool erc-nicks-color-adjustments colors))) + (pool (funcall erc-nicks--create-pool-function + erc-nicks-color-adjustments colors))) (setq erc-nicks--colors-pool pool erc-nicks--colors-len (length pool))))) @@ -487,7 +532,8 @@ nicks " Toggling it in individual target buffers is unsupported.") (erc-nicks-mode +1))) ; but do it anyway (setq erc-nicks--downcased-skip-nicks - (mapcar #'erc-downcase erc-nicks-skip-nicks)) + (mapcar #'erc-downcase erc-nicks-skip-nicks) + erc-nicks--fg-rgb (erc-with-server-buffer erc-nicks--fg-rgb)) (add-function :filter-return (local 'erc-button--modify-nick-function) #'erc-nicks--highlight-button '((depth . 80))) (erc-button--phantom-users-mode +1)) @@ -505,14 +551,14 @@ nicks "Module `nicks' unable to determine background color. Setting to \"" temp "\" globally. Please see `erc-nicks-bg-color'.") (custom-set-variables (list 'erc-nicks-bg-color temp)))) + (setq erc-nicks--fg-rgb + (or (color-name-to-rgb + (face-foreground 'erc-default-face nil 'default)) + (color-name-to-rgb + (readable-foreground-color erc-nicks-bg-color)))) (erc-nicks--init-pool) (erc--restore-initialize-priors erc-nicks-mode erc-nicks--face-table (make-hash-table :test #'equal))) - (setq erc-nicks--fg-rgb - (or (color-name-to-rgb - (face-foreground 'erc-default-face nil 'default)) - (color-name-to-rgb - (readable-foreground-color erc-nicks-bg-color)))) (setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal) #'erc-nicks-customize-face) (advice-add 'widget-create-child-and-convert :filter-args @@ -599,8 +645,10 @@ erc-nicks-list-faces (defun erc-nicks-refresh (debug) "Recompute faces for all nicks on current network. -With DEBUG, review affected faces or colors. Which one depends -on the value of `erc-nicks-colors'." +With DEBUG, review affected faces or colors. Exactly which of +the two depends on the value of `erc-nicks-colors'. Note that +the list of rejected faces may include duplicates of accepted +ones." (interactive "P") (unless (derived-mode-p 'erc-mode) (user-error "Not an ERC buffer")) @@ -608,6 +656,8 @@ erc-nicks-refresh (unless erc-nicks-mode (user-error "Module `nicks' disabled")) (let ((erc-nicks--colors-rejects (and debug (list t)))) (erc-nicks--init-pool) + (unless erc-nicks--colors-pool + (user-error "Pool empty: all colors rejected")) (dolist (nick (hash-table-keys erc-nicks--face-table)) ;; User-tuned faces do not have an `erc-nicks--key' property. (when-let ((face (gethash nick erc-nicks--face-table)) @@ -634,6 +684,15 @@ erc-nicks-refresh (cadr (apply #'color-rgb-to-hsl (color-name-to-rgb c)))))))))))))) +(defun erc-nicks--colors-from-faces (prefix) + "Extract foregrounds from faces with PREFIX +Expect PREFIX to be something like \"ansi-color-\" or \"font-lock-\"." + (let (out) + (dolist (face (face-list) (nreverse out)) + (when-let (((string-prefix-p prefix (symbol-name face))) + (color (face-foreground face))) + (push color out))))) + (provide 'erc-nicks) ;;; erc-nicks.el ends here diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el index 3e5804734ec..35264a23caa 100644 --- a/test/lisp/erc/erc-nicks-tests.el +++ b/test/lisp/erc/erc-nicks-tests.el @@ -493,7 +493,7 @@ erc-nicks--gen-key-from-format-spec (should (equal (erc-nicks--gen-key-from-format-spec "bob") "bob@Libera.Chat/tester")))) -(ert-deftest erc-nicks--create-pool () +(ert-deftest erc-nicks--create-culled-pool () (let ((erc-nicks--bg-luminance 1.0) (erc-nicks--bg-mode-value 'light) (erc-nicks--fg-rgb '(0.0 0.0 0.0)) @@ -502,37 +502,70 @@ erc-nicks--create-pool (erc-nicks--colors-rejects '(t))) ;; Reject - (should-not (erc-nicks--create-pool '(erc-nicks-invert) '("white"))) + (should-not (erc-nicks--create-culled-pool '(erc-nicks-invert) '("white"))) (should (equal (pop erc-nicks--colors-rejects) "white")) ; too close - (should-not (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("black"))) + (should-not + (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast) '("black"))) (should (equal (pop erc-nicks--colors-rejects) "black")) ; too far - (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("white"))) + (should-not + (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("white"))) (should (equal (pop erc-nicks--colors-rejects) "white")) ; lacks color - (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("red"))) + (should-not + (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("red"))) (should (equal (pop erc-nicks--colors-rejects) "red")) ; too much color ;; Safe - (should - (equal (erc-nicks--create-pool '(erc-nicks-invert) '("black")) - '("black"))) - (should - (equal (erc-nicks--create-pool '(erc-nicks-add-contrast) '("black")) - '("black"))) - (should - (equal (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("white")) - '("white"))) + (should (equal (erc-nicks--create-culled-pool '(erc-nicks-invert) + '("black")) + '("black"))) + (should (equal (erc-nicks--create-culled-pool '(erc-nicks-add-contrast) + '("black")) + '("black"))) + (should (equal (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast) + '("white")) + '("white"))) (let ((erc-nicks-saturation-range '(0.5 . 1.0))) - (should - (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("green")) - '("green")))) + (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) + '("green")) + '("green")))) (let ((erc-nicks-saturation-range '(0.0 . 0.5))) - (should - (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("gray")) - '("gray")))) + (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) + '("gray")) + '("gray")))) (unless noninteractive - (should - (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("firebrick")) - '("firebrick")))) + (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) + '("firebrick")) + '("firebrick")))) + (should (equal erc-nicks--colors-rejects '(t))))) + +(ert-deftest erc-nicks--create-coerced-pool () + (let ((erc-nicks--bg-luminance 1.0) + (erc-nicks--bg-mode-value 'light) + (erc-nicks--fg-rgb '(0.0 0.0 0.0)) + (erc-nicks-bg-color "white") + (num-colors (length (defined-colors))) + ;; + (erc-nicks--colors-rejects '(t))) + + ;; Deduplication. + (when (= 8 num-colors) + (should (equal (erc-nicks--create-coerced-pool '(erc-nicks-ensaturate) + '("#ee0000" "#f80000")) + '("red"))) + (should (equal (pop erc-nicks--colors-rejects) "#f80000"))) + + ;; "Coercion" in Xterm. + (unless noninteractive + (when (= 665 num-colors) + (pcase-dolist (`(,adjustments ,candidates ,result) + '(((erc-nicks-invert) ("white") ("gray10")) + ((erc-nicks-cap-contrast) ("black") ("gray20")) + ((erc-nicks-ensaturate) ("white") ("lavenderblush2")) + ((erc-nicks-ensaturate) ("red") ("firebrick")))) + (should (equal (erc-nicks--create-coerced-pool adjustments + candidates) + result))))) + (should (equal erc-nicks--colors-rejects '(t))))) ;;; erc-nicks-tests.el ends here commit 29029529cb21960fc48e35ffbd24cbccaeb499a7 Author: F. Jason Park Date: Sun Nov 5 16:03:15 2023 -0800 Don't use func-arity to trigger API warning in url-irc * lisp/url/url-irc.el (url-irc): Use more robust `condition-case' pattern instead, which will still fail when met with various edge cases. The old way was only useful for non-variadic lambda lists consisting entirely of named positional parameters. (Bug#56514) diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 1463335d40f..e11b4a6a58e 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -83,18 +83,20 @@ url-irc (pass (url-password url)) (user (url-user url)) (chan (url-filename url)) - (type (url-type url)) - (compatp (eql 5 (cdr (func-arity url-irc-function))))) + (type (url-type url))) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) (setq chan (substring chan 1 nil))) (if (= (length chan) 0) (setq chan nil)) - (when compatp - (lwarn 'url :error "Obsolete value for `url-irc-function'")) - (apply url-irc-function - host port chan user pass (unless compatp (list type))) + (condition-case nil + (funcall url-irc-function host port chan user pass type) + (wrong-number-of-arguments + (display-warning 'url + (concat "Incompatible value for `url-irc-function'." + " Likely not expecting a 6th (SCHEME) arg.")) + (funcall url-irc-function host port chan user pass))) nil)) ;;;; ircs:// commit cf00f1526d04c0798a6a38c005b5704cf3b825f0 (refs/remotes/origin/scratch/derived-mode-add-parents) Author: Stefan Monnier Date: Sun Nov 12 17:08:46 2023 -0500 Subject: (derived-mode-add-parents): Add documentation and one more test * doc/lispref/modes.texi (Derived Modes): Document new derived-modes API. * test/lisp/subr-tests.el (subt-tests--merge-ordered-lists): New test. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index f365d88fade..22ff07f9641 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -937,6 +937,31 @@ Derived Modes derived from any of the major modes given by the symbols @var{modes}. @end defun +The graph of major modes is accessed with the following lower-level +functions: + +@defun derived-mode-set-parent mode parent +This function declares that @var{mode} inherits from @code{parent}. +This is the function that @code{define-derived-mode} calls after +defining @var{mode} to register the fact that @var{mode} was defined +by reusing @code{parent}. +@end defun + +@defun derived-mode-add-parents mode extra-parents +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. +@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. +@end defun + + @node Basic Major Modes @subsection Basic Major Modes diff --git a/etc/NEWS b/etc/NEWS index 767e4c27b43..1db22c4f2f5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1181,6 +1181,18 @@ values. * Lisp Changes in Emacs 30.1 +** New function 'merge-ordered-lists'. +Mostly used internally to do a kind of topological sort of +inheritance hierarchies. + +** New API to control the graph of major modes. +While 'define-derived-mode' still only support single inheritance, +modes can declare additional parents (for tests like 'derived-mode-p') +with `derived-mode-add-parents`. +Accessing the 'derived-mode-parent' property directly is now +deprecated in favor of the new functions 'derived-mode-set-parent' +and 'derived-mode-all-parents'. + +++ ** Drag-and-drop functions can now be called once for compound drops. It is now possible for drag-and-drop handler functions to respond to diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 03eb0d5bf8c..f67ac70046a 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -381,6 +381,16 @@ subt-tests--derived-mode-add-parents '(subr-tests--mode-A subr-tests--mode-B prog-mode subr-tests--mode-C subr-tests--derived-mode-1)))))) +(ert-deftest subt-tests--merge-ordered-lists () + (should (equal (merge-ordered-lists + '((B A) (C A) (D B) (E D C))) + '(E D B C A))) + (should (equal (merge-ordered-lists + '((E D C) (B A) (C A) (D B))) + '(E D C B A))) + (should-error (merge-ordered-lists + '((E C D) (B A) (A C) (D B)) + (lambda (_) (error "cycle"))))) (ert-deftest number-sequence-test () (should (= (length commit 5bebd292c63c9a54430854d7d63d01e6f6727e53 Author: Xiaoyue Chen Date: Sun Nov 12 12:04:02 2023 -0800 Pass only the local parts of Eshell's $PATH to 'tramp-remote-path' * lisp/eshell/esh-proc.el (eshell-gather-process-output): Get the local part of the $PATH (bug#67126). Do not merge to master. Copyright-paperwork-exempt: yes diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index a6defe03761..fd63c2f1155 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -293,7 +293,7 @@ eshell-gather-process-output ;; future, remember to remove `tramp-remote-path' above, too.) (when (file-remote-p default-directory) (push (concat "PATH=" real-path) process-environment) - (setq tramp-remote-path (eshell-get-path))) + (setq tramp-remote-path (eshell-get-path t))) ;; MS-Windows needs special setting of encoding/decoding, because ;; (a) non-ASCII text in command-line arguments needs to be ;; encoded in the system's codepage; and (b) because many Windows commit 52afc64bad7f5af3d4bce48c5ac6e8e9bffbb933 Author: Xiaoyue Chen Date: Sun Nov 12 12:04:02 2023 -0800 Pass only the local parts of Eshell's $PATH to 'tramp-remote-path' * lisp/eshell/esh-proc.el (eshell-gather-process-output): Get the local part of the $PATH (bug#67126). Copyright-paperwork-exempt: yes diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 6561561440e..e7e91f08741 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -304,7 +304,7 @@ eshell-gather-process-output ;; future, remember to remove `tramp-remote-path' above, too.) (when (file-remote-p default-directory) (push (concat "PATH=" real-path) process-environment) - (setq tramp-remote-path (eshell-get-path))) + (setq tramp-remote-path (eshell-get-path t))) ;; MS-Windows needs special setting of encoding/decoding, because ;; (a) non-ASCII text in command-line arguments needs to be ;; encoded in the system's codepage; and (b) because many Windows commit 5612fd21a05e80e5cc29d01ec2b8b9217941c4de Author: Jeremy Bryant Date: Sun Nov 12 15:07:23 2023 +0000 Add two doc strings to cl-extra.el * lisp/emacs-lisp/cl-extra.el (cl--random-time) (cl-find-class): Add docstrings. (Bug#66949) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index de5eb9c2d92..8ba320cdfb6 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -440,7 +440,10 @@ cl-parse-integer ;; Random numbers. (defun cl--random-time () - (car (time-convert nil t))) + "Return high-precision timestamp from `time-convert'. + +For example, suitable for use as seed by `cl-make-random-state'." + (car (time-convert nil t))) ;;;###autoload (autoload 'cl-random-state-p "cl-extra") (cl-defstruct (cl--random-state @@ -733,7 +736,11 @@ 'cl-type-definition (declare-function help-fns-short-filename "help-fns" (filename)) ;;;###autoload -(defun cl-find-class (type) (cl--find-class type)) +(defun cl-find-class (type) + "Return CL class of TYPE. + +Call `cl--find-class' to get TYPE's propname `cl--class'" + (cl--find-class type)) ;;;###autoload (defun cl-describe-type (type) commit 835181390319c0cb8f13fb00a3be0469c49b1d35 Author: Jim Porter Date: Sun Nov 12 11:08:40 2023 -0800 ; Fix docstring typo in Eshell tests * test/lisp/eshell/em-hist-tests.el (em-hist-test/check-history-file): Fix typo. diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el index e90ce141a81..466d19cc6f7 100644 --- a/test/lisp/eshell/em-hist-tests.el +++ b/test/lisp/eshell/em-hist-tests.el @@ -37,7 +37,7 @@ em-hist-test/check-history-file "Check that the contents of FILE-NAME match the EXPECTED history entries. Additonally, check that after loading the file, the history ring matches too. If EXPECTED-RING is a list, compare the ring -elements against that; if t (the default), check again EXPECTED." +elements against that; if t (the default), check against EXPECTED." (when (eq expected-ring t) (setq expected-ring expected)) ;; First check the actual file. (should (equal (with-temp-buffer commit b86dcea37c86a3b9cb9fc6c4656b481b2ad1c1e5 Author: Stefan Monnier Date: Sun Nov 12 11:37:38 2023 -0500 (derived-mode-all-parents): Fix handling of cycles * lisp/subr.el (derived-mode-all-parents): Fix the handling of cycles so that it doesn't fill the cache with incorrect results. (merge-ordered-lists): Improve docstring. (provided-mode-derived-p): Swap the loops since `modes` is usually shorter than `ps`. * test/lisp/subr-tests.el (subr-tests--parent-mode): Simplify. (subr-tests--mode-A, subr-tests--mode-B, subr-tests--mode-C): New funs. (subt-tests--derived-mode-add-parents): New test. diff --git a/lisp/subr.el b/lisp/subr.el index 75614f3c674..abc937531ad 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2682,14 +2682,18 @@ merge-ordered-lists "Merge LISTS in a consistent order. LISTS is a list of lists of elements. Merge them into a single list containing the same elements (removing -duplicates) using the C3 linearization, so as to obeying their relative -positions in each list. Equality of elements is tested with `eql'. +duplicates), obeying their relative positions in each list. +The order of the (sub)lists determines the final order in those cases where +the order within the sublists does not impose a unique choice. +Equality of elements is tested with `eql'. If a consistent order does not exist, call ERROR-FUNCTION with a remaining list of lists that we do not know how to merge. It should return the candidate to use to continue the merge, which has to be the head of one of the lists. By default we choose the head of the first list." + ;; Algorithm inspired from + ;; [C3](https://en.wikipedia.org/wiki/C3_linearization) (let ((result '())) (while (cdr (setq lists (delq nil lists))) ;; Try to find the next element of the result. This @@ -2737,16 +2741,17 @@ derived-mode-all-parents ((memq mode known-children) ;; These things happen, better not get all worked up about it. ;;(error "Cycle in the major mode hierarchy: %S" mode) - nil) + ;; But do try to return something meaningful. + (memq mode (reverse known-children))) (t - (push mode known-children) ;; The mode hierarchy (or DAG, actually), is very static, but we ;; need to react to changes because `parent' may not be defined ;; yet (e.g. it's still just an autoload), so the recursive call ;; to `derived-mode-all-parents' may return an ;; invalid/incomplete result which we'll need to update when the ;; mode actually gets loaded. - (let* ((all-parents + (let* ((new-children (cons mode known-children)) + (get-all-parents (lambda (parent) ;; Can't use `cl-lib' here (nor `gv') :-( ;;(cl-assert (not (equal parent mode))) @@ -2755,27 +2760,31 @@ derived-mode-all-parents (unless (memq mode followers) (put parent 'derived-mode--followers (cons mode followers)))) - (derived-mode-all-parents parent known-children))) + (derived-mode-all-parents parent new-children))) (parent (or (get mode 'derived-mode-parent) ;; If MODE is an alias, then follow the alias. (let ((alias (symbol-function mode))) (and (symbolp alias) alias)))) - (extras (get mode 'derived-mode-extra-parents))) - (put mode 'derived-mode--all-parents - (cons mode - (merge-ordered-lists - (cons (if (and parent (not (memq parent extras))) - (funcall all-parents parent)) - (mapcar all-parents extras)))))))))) + (extras (get mode 'derived-mode-extra-parents)) + (all-parents + (merge-ordered-lists + (cons (if (and parent (not (memq parent extras))) + (funcall get-all-parents parent)) + (mapcar get-all-parents extras))))) + ;; Cache the result unless it was affected by `known-children' + ;; because of a cycle. + (if (and (memq mode all-parents) known-children) + (cons mode (remq mode all-parents)) + (put mode 'derived-mode--all-parents (cons mode all-parents)))))))) (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. If you just want to check `major-mode', use `derived-mode-p'." (declare (side-effect-free t)) (let ((ps (derived-mode-all-parents mode))) - (while (and ps (not (memq (car ps) modes))) - (setq ps (cdr ps))) - (car ps))) + (while (and modes (not (memq (car modes) ps))) + (setq modes (cdr modes))) + (car modes))) (defun derived-mode-p (&rest modes) "Non-nil if the current major mode is derived from one of MODES." diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index db327056533..03eb0d5bf8c 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -345,8 +345,7 @@ subr-test-global-key-binding ;;;; Mode hooks. -(defalias 'subr-tests--parent-mode - (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) +(defalias 'subr-tests--parent-mode #'prog-mode) (define-derived-mode subr-tests--derived-mode-1 prog-mode "test") (define-derived-mode subr-tests--derived-mode-2 subr-tests--parent-mode "test") @@ -360,6 +359,29 @@ provided-mode-derived-p 'subr-tests--parent-mode)) (should (provided-mode-derived-p 'subr-tests--derived-mode-2 'prog-mode))) + +(define-derived-mode subr-tests--mode-A subr-tests--derived-mode-1 "t") +(define-derived-mode subr-tests--mode-B subr-tests--mode-A "t") +(defalias 'subr-tests--mode-C #'subr-tests--mode-B) +(derived-mode-add-parents 'subr-tests--mode-A '(subr-tests--mode-C)) + +(ert-deftest subt-tests--derived-mode-add-parents () + ;; The Right Answer is somewhat unclear in the presence of cycles, + ;; but let's make sure we get tolerable answers. + ;; FIXME: Currently `prog-mode' doesn't always end up at the end :-( + (let ((set-equal (lambda (a b) + (not (or (cl-set-difference a b) + (cl-set-difference b a)))))) + (dolist (mode '(subr-tests--mode-A subr-tests--mode-B subr-tests--mode-C)) + (should (eq (derived-mode-all-parents mode) + (derived-mode-all-parents mode))) + (should (eq mode (car (derived-mode-all-parents mode)))) + (should (funcall set-equal + (derived-mode-all-parents mode) + '(subr-tests--mode-A subr-tests--mode-B prog-mode + subr-tests--mode-C subr-tests--derived-mode-1)))))) + + (ert-deftest number-sequence-test () (should (= (length (number-sequence (1- most-positive-fixnum) most-positive-fixnum)) commit 0bfe764fe5691a76c1c12557b6b0b5bfa9cbc012 Author: Stephen Berman Date: Sun Nov 12 14:58:58 2023 +0100 Add support in todo-mode.el for ISO date format * lisp/calendar/todo-mode.el (todo--date-pattern-groups): New defconst. (todo-date-pattern): Use it to extend pattern matching of `calendar-date-display-form' to support the ISO date format in todo item date headers (bug#66395, bug#55284). (todo-edit-item--header): Make it work with ISO date strings. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index c27bae8439e..dbd1388848e 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -189,20 +189,53 @@ todo-month-abbrev-array "Array of abbreviated month names, in order. The final element is \"*\", indicating an unspecified month.") +(defconst todo--date-pattern-groups + (pcase calendar-date-style + ('american '((monthname . "6") (month . "7") (day . "8") (year . "9"))) + ('european '((day . "6") (monthname . "7") (month . "8") (year . "9"))) + ('iso '((year . "6") (monthname . "7") (month . "8") (day . "9")))) + "Alist for grouping date components in `todo-date-pattern'.") + (defconst todo-date-pattern - (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) - (concat "\\(?4:\\(?5:" dayname "\\)\\|" - (calendar-dlet - ((dayname) - (monthname (format "\\(?6:%s\\)" (diary-name-pattern - todo-month-name-array - todo-month-abbrev-array))) - (month "\\(?7:[0-9]+\\|\\*\\)") - (day "\\(?8:[0-9]+\\|\\*\\)") - (year "-?\\(?9:[0-9]+\\|\\*\\)")) - (mapconcat #'eval calendar-date-display-form)) - "\\)")) - "Regular expression matching a todo item date header.") + (let* ((dayname (diary-name-pattern calendar-day-name-array nil t)) + (d (concat "\\(?" (alist-get 'day todo--date-pattern-groups) + ":[0-9]+\\|\\*\\)")) + (mn (format (concat "\\(?" (alist-get 'monthname + todo--date-pattern-groups) + ":%s\\)") + (diary-name-pattern todo-month-name-array + todo-month-abbrev-array))) + (m (concat "\\(?" (alist-get 'month todo--date-pattern-groups) + ":[0-9]+\\|\\*\\)")) + (y (concat "\\(?" (alist-get 'year todo--date-pattern-groups) + ":[0-9]+\\|\\*\\)")) + (dd "1111111") + (mm "2222222") + (yy "3333333") + (s (concat "\\(?4:\\(?5:" dayname "\\)\\|" + (calendar-dlet + ((dayname) + (monthname mn) + (year yy) + (month mm) + (day dd)) + (mapconcat #'eval calendar-date-display-form)) + "\\)"))) + ;; The default value of calendar-iso-date-display-form calls + ;; `string-to-number' on the values of `month' and `day', so we + ;; gave them placeholder values above and now replace these with + ;; the necessary regexps with appropriately numbered groups, because + ;; `todo-edit-item--header' uses these groups. + (when (string-match dd s nil t) + (setq s (string-replace dd d s))) + (when (string-match mm s nil t) + (setq s (string-replace mm m s))) + (when (string-match yy s nil t) + (setq s (string-replace yy y s))) + s) + "Regular expression matching a todo item date header. +The value of `calendar-date-display-form' determines the form of +the date header.") ;; By itself this matches anything, because of the `?'; however, it's only ;; used in the context of `todo-date-pattern' (but Emacs Lisp lacks @@ -2350,10 +2383,18 @@ todo-edit-item--header (line-end-position) t) (let* ((otime (match-string-no-properties 2)) (odayname (match-string-no-properties 5)) - (omonthname (match-string-no-properties 6)) - (omonth (match-string-no-properties 7)) - (oday (match-string-no-properties 8)) - (oyear (match-string-no-properties 9)) + (mngroup (string-to-number + (alist-get 'monthname todo--date-pattern-groups))) + (omonthname (match-string-no-properties mngroup)) + (mgroup (string-to-number + (alist-get 'month todo--date-pattern-groups))) + (omonth (match-string-no-properties mgroup)) + (dgroup (string-to-number + (alist-get 'day todo--date-pattern-groups))) + (oday (match-string-no-properties dgroup)) + (ygroup (string-to-number + (alist-get 'year todo--date-pattern-groups))) + (oyear (match-string-no-properties ygroup)) (tmn-array todo-month-name-array) (mlist (append tmn-array nil)) (tma-array todo-month-abbrev-array) @@ -2399,11 +2440,23 @@ todo-edit-item--header ((eq what 'month) (setf day oday year oyear - (if (memq 'month calendar-date-display-form) + ;; With default ISO style, 'month is in a + ;; sublist of c-d-d-f, so we flatten it. + (if (memq 'month (flatten-tree + calendar-date-display-form)) month monthname) (cond ((not current-prefix-arg) - (todo-read-date 'month)) + (let ((nmonth (todo-read-date 'month))) + ;; If old month is given as a number, + ;; have to convert new month name to + ;; the corresponding number. + (when omonth + (setq nmonth + (number-to-string + (1+ (seq-position tma-array + nmonth))))) + nmonth)) ((or (string= omonth "*") (= mm 13)) (user-error "Cannot increment *")) (t commit e5ba52ad72d0e44b905d6dc321f1e6234491df53 Author: Jim Porter Date: Wed Oct 25 15:24:28 2023 -0700 Hook 'bug-reference-mode' up to 'thing-at-point' * lisp/progmodes/bug-reference.el (bug-reference--url-at-point): New function. (bug-reference-mode, bug-reference-prog-mode): Factor initialization code out to... (bug-reference--init): ... here. * test/lisp/progmodes/bug-reference-tests.el (test-thing-at-point): New test. * etc/NEWS: Announce this change (bug#66752). diff --git a/etc/NEWS b/etc/NEWS index 767e4c27b43..8324eb7da1e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -978,6 +978,11 @@ For links in 'webjump-sites' without an explicit URI scheme, it was previously assumed that they should be prefixed with "http://". Such URIs are now prefixed with "https://" instead. +--- +*** 'bug-reference-mode' now supports 'thing-at-point'. +Now, calling '(thing-at-point 'url)' when point is on a bug reference +will return the URL for that bug. + ** Customize +++ diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index bc280284588..3f6e1e68e5b 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -35,6 +35,8 @@ ;;; Code: +(require 'thingatpt) + (defgroup bug-reference nil "Hyperlinking references to bug reports." ;; Somewhat arbitrary, by analogy with eg goto-address. @@ -654,17 +656,31 @@ bug-reference--run-auto-setup (run-hook-with-args-until-success 'bug-reference-auto-setup-functions))))) -;;;###autoload -(define-minor-mode bug-reference-mode - "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." - :after-hook (bug-reference--run-auto-setup) - (if bug-reference-mode - (jit-lock-register #'bug-reference-fontify) +(defun bug-reference--url-at-point () + "`thing-at-point' provider function." + (get-char-property (point) 'bug-reference-url)) + +(defun bug-reference--init (enable) + (if enable + (progn + (jit-lock-register #'bug-reference-fontify) + (setq-local thing-at-point-provider-alist + (append thing-at-point-provider-alist + '((url . bug-reference--url-at-point))))) (jit-lock-unregister #'bug-reference-fontify) + (setq thing-at-point-provider-alist + (delete '((url . bug-reference--url-at-point)) + thing-at-point-provider-alist)) (save-restriction (widen) (bug-reference-unfontify (point-min) (point-max))))) +;;;###autoload +(define-minor-mode bug-reference-mode + "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." + :after-hook (bug-reference--run-auto-setup) + (bug-reference--init bug-reference-mode)) + (defun bug-reference-mode-force-auto-setup () "Enable `bug-reference-mode' and force auto-setup. Enabling `bug-reference-mode' runs its auto-setup only if @@ -681,12 +697,7 @@ bug-reference-mode-force-auto-setup (define-minor-mode bug-reference-prog-mode "Like `bug-reference-mode', but only buttonize in comments and strings." :after-hook (bug-reference--run-auto-setup) - (if bug-reference-prog-mode - (jit-lock-register #'bug-reference-fontify) - (jit-lock-unregister #'bug-reference-fontify) - (save-restriction - (widen) - (bug-reference-unfontify (point-min) (point-max))))) + (bug-reference--init bug-reference-prog-mode)) (provide 'bug-reference) ;;; bug-reference.el ends here diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el index 790582aed4c..e5b207748bf 100644 --- a/test/lisp/progmodes/bug-reference-tests.el +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -25,6 +25,7 @@ (require 'bug-reference) (require 'ert) +(require 'ert-x) (defun test--get-github-entry (url) (and (string-match @@ -125,4 +126,18 @@ test-gitea-entry (test--get-gitea-entry "https://gitea.com/magit/magit/") "magit/magit"))) +(ert-deftest test-thing-at-point () + "Ensure that (thing-at-point 'url) returns the bug URL." + (ert-with-test-buffer (:name "thingatpt") + (setq-local bug-reference-url-format "https://debbugs.gnu.org/%s") + (insert "bug#1234") + (bug-reference-mode) + (jit-lock-fontify-now (point-min) (point-max)) + (goto-char (point-min)) + ;; Make sure we get the URL when `bug-reference-mode' is active... + (should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234")) + (bug-reference-mode -1) + ;; ... and get nil when `bug-reference-mode' is inactive. + (should-not (thing-at-point 'url)))) + ;;; bug-reference-tests.el ends here commit e56e9c19545f43c35dec85fa650f3799c6e9c308 Author: Po Lu Date: Sun Nov 12 11:44:58 2023 +0800 Adjust dump file location under Android * java/org/gnu/emacs/EmacsApplication.java (EmacsApplication) : New field. (getApkFile): Move from EmacsService.java. (findDumpFile): If the dump file is older than the APK, delete it irrespective of whether the checksums agree. (onCreate): Initialize apkFileName. * java/org/gnu/emacs/EmacsService.java (onCreate): Use EmacsApplication.apkFileName. * src/android.c (android_on_low_memory): Correct arguments to Fclear_image_cache. * src/image.c (Fclear_image_cache): Check that animation_cache is always a cons. diff --git a/java/org/gnu/emacs/EmacsApplication.java b/java/org/gnu/emacs/EmacsApplication.java index 8afa5bcedb4..d70f16346e5 100644 --- a/java/org/gnu/emacs/EmacsApplication.java +++ b/java/org/gnu/emacs/EmacsApplication.java @@ -25,19 +25,61 @@ import android.content.Context; import android.app.Application; + +import android.content.pm.ApplicationInfo; +import android.content.pm.PackageManager.ApplicationInfoFlags; +import android.content.pm.PackageManager; + +import android.os.Build; + import android.util.Log; public final class EmacsApplication extends Application { private static final String TAG = "EmacsApplication"; - /* The name of the dump file to use. */ + /* The name of the dump file to use, or NULL if this Emacs binary + has yet to be dumped. */ public static String dumpFileName; + /* The name of the APK file housing Emacs, or NULL if it could not + be ascertained. */ + public static String apkFileName; + + @SuppressWarnings ("deprecation") + private String + getApkFile () + { + PackageManager manager; + ApplicationInfo info; + + manager = getPackageManager (); + + try + { + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.TIRAMISU) + info = manager.getApplicationInfo ("org.gnu.emacs", 0); + else + info = manager.getApplicationInfo ("org.gnu.emacs", + ApplicationInfoFlags.of (0)); + + /* Return an empty string upon failure. */ + + if (info.sourceDir != null) + return info.sourceDir; + + return null; + } + catch (Exception e) + { + return null; + } + } + public static void findDumpFile (Context context) { - File filesDirectory; + File filesDirectory, apk; File[] allFiles; String wantedDumpFile; int i; @@ -67,7 +109,29 @@ public final class EmacsApplication extends Application for (i = 0; i < allFiles.length; ++i) { if (allFiles[i].getName ().equals (wantedDumpFile)) - dumpFileName = allFiles[i].getAbsolutePath (); + { + /* Compare the last modified time of the dumpfile with + that of apkFileName, the time at which Emacs was + installed. Delete it if the dump file was created + before Emacs was installed, even if the C signature + (representing libemacs.so) remains identical. */ + + if (apkFileName != null) + { + apk = new File (apkFileName); + + if (apk.lastModified () + > allFiles[i].lastModified ()) + { + allFiles[i].delete (); + + /* Don't set the dump file name in this case. */ + continue; + } + } + + dumpFileName = allFiles[i].getAbsolutePath (); + } else /* Delete this outdated dump file. */ allFiles[i].delete (); @@ -83,6 +147,9 @@ public final class EmacsApplication extends Application will be restored for the Emacs thread in `initEmacs'. */ EmacsNative.setupSystemThread (); + /* Establish the name of the APK. */ + apkFileName = getApkFile (); + /* Locate a suitable dump file. */ findDumpFile (this); diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 1aac1a6c4dd..5bd1dcc5a88 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -53,8 +53,6 @@ import android.content.IntentFilter; import android.content.UriPermission; -import android.content.pm.ApplicationInfo; -import android.content.pm.PackageManager.ApplicationInfoFlags; import android.content.pm.PackageManager; import android.content.res.AssetManager; @@ -193,36 +191,6 @@ public final class EmacsService extends Service return null; } - @SuppressWarnings ("deprecation") - private String - getApkFile () - { - PackageManager manager; - ApplicationInfo info; - - manager = getPackageManager (); - - try - { - if (Build.VERSION.SDK_INT < Build.VERSION_CODES.TIRAMISU) - info = manager.getApplicationInfo ("org.gnu.emacs", 0); - else - info = manager.getApplicationInfo ("org.gnu.emacs", - ApplicationInfoFlags.of (0)); - - /* Return an empty string upon failure. */ - - if (info.sourceDir != null) - return info.sourceDir; - - return ""; - } - catch (Exception e) - { - return ""; - } - } - /* Return the display density, adjusted in accord with the user's text scaling preferences. */ @@ -288,7 +256,7 @@ public final class EmacsService extends Service /* Now provide this application's apk file, so a recursive invocation of app_process (through android-emacs) can find EmacsNoninteractive. */ - classPath = getApkFile (); + classPath = EmacsApplication.apkFileName; Log.d (TAG, "Initializing Emacs, where filesDir = " + filesDir + ", libDir = " + libDir + ", and classPath = " + classPath diff --git a/src/android.c b/src/android.c index 7a670cb507f..e116426ca05 100644 --- a/src/android.c +++ b/src/android.c @@ -1965,7 +1965,7 @@ NATIVE_NAME (shutDownEmacs) (JNIEnv *env, jobject object) static void android_on_low_memory (void *closure) { - Fclear_image_cache (Qt, Qt); + Fclear_image_cache (Qt, Qnil); garbage_collect (); } diff --git a/src/image.c b/src/image.c index 9a465f0b180..9c0f5f0fb37 100644 --- a/src/image.c +++ b/src/image.c @@ -2342,6 +2342,7 @@ DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache, { if (!NILP (animation_cache)) { + CHECK_CONS (animation_cache); #if defined (HAVE_WEBP) || defined (HAVE_GIF) anim_prune_animation_cache (XCDR (animation_cache)); #endif commit fbb897b7af53cdb43e18322c5cdfbfef7cdda1ee Author: Stefan Monnier Date: Tue Nov 7 18:57:03 2023 -0500 Move EIEIO's C3 linearization code to `subr.el` The code was used to linearize the EIEIO class hierarchy, since it results in saner results than things like BFS or DFS. By moving it to `subr.el` we get to benefit from that same advantage both in `cl--class-allparents` and in `derived-mode-all-parents`. * lisp/subr.el (merge-ordered-lists): New function. (derived-mode-all-parents): Use it to improve parent ordering. * lisp/emacs-lisp/eieio-core.el (eieio--c3-candidate) (eieio--c3-merge-lists): Delete functions, replaced by `merge-ordered-lists`. (eieio--class-precedence-c3): Use `merge-ordered-lists`. * lisp/emacs-lisp/cl-preloaded.el (cl--class-allparents): Use `merge-ordered-lists` to improve parent ordering. * lisp/emacs-lisp/cl-macs.el (cl--struct-all-parents): Delete function. (cl--pcase-mutually-exclusive-p): Use `cl--class-allparents` instead. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index e2c13534054..2431e658368 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3337,19 +3337,6 @@ cl-defstruct ;;; Add cl-struct support to pcase -;;In use by comp.el -(defun cl--struct-all-parents (class) ;FIXME: Merge with `cl--class-allparents' - (when (cl--struct-class-p class) - (let ((res ()) - (classes (list class))) - ;; BFS precedence. - (while (let ((class (pop classes))) - (push class res) - (setq classes - (append classes - (cl--class-parents class))))) - (nreverse res)))) - ;;;###autoload (pcase-defmacro cl-struct (type &rest fields) "Pcase patterns that match cl-struct EXPVAL of type TYPE. @@ -3395,8 +3382,8 @@ cl--pcase-mutually-exclusive-p (let ((c1 (cl--find-class t1)) (c2 (cl--find-class t2))) (and c1 c2 - (not (or (memq c1 (cl--struct-all-parents c2)) - (memq c2 (cl--struct-all-parents c1))))))) + (not (or (memq t1 (cl--class-allparents c2)) + (memq t2 (cl--class-allparents c1))))))) (let ((c1 (and (symbolp t1) (cl--find-class t1)))) (and c1 (cl--struct-class-p c1) (funcall orig (cl--defstruct-predicate t1) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 03068639575..3d0c2b54785 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -323,15 +323,9 @@ cl--copy-slot-descriptor (cl-assert (cl--class-p (cl--find-class 'cl-structure-object))) (defun cl--class-allparents (class) - (let ((parents ()) - (classes (list class))) - ;; BFS precedence. FIXME: Use a topological sort. - (while (let ((class (pop classes))) - (cl-pushnew (cl--class-name class) parents) - (setq classes - (append classes - (cl--class-parents class))))) - (nreverse parents))) + (cons (cl--class-name class) + (merge-ordered-lists (mapcar #'cl--class-allparents + (cl--class-parents class))))) (eval-and-compile (cl-assert (null (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 f5ff04ff372..a394156c93a 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -964,49 +964,6 @@ eieio--initarg-to-attribute (cdr tuple) nil))) -;;; -;; Method Invocation order: C3 -(defun eieio--c3-candidate (class remaining-inputs) - "Return CLASS if it can go in the result now, otherwise nil." - ;; Ensure CLASS is not in any position but the first in any of the - ;; element lists of REMAINING-INPUTS. - (and (not (let ((found nil)) - (while (and remaining-inputs (not found)) - (setq found (member class (cdr (car remaining-inputs))) - remaining-inputs (cdr remaining-inputs))) - found)) - class)) - -(defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs) - "Try to merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order. -If a consistent order does not exist, signal an error." - (setq remaining-inputs (delq nil remaining-inputs)) - (if (null remaining-inputs) - ;; If all remaining inputs are empty lists, we are done. - (nreverse reversed-partial-result) - ;; Otherwise, we try to find the next element of the result. This - ;; is achieved by considering the first element of each - ;; (non-empty) input list and accepting a candidate if it is - ;; consistent with the rests of the input lists. - (let* ((found nil) - (tail remaining-inputs) - (next (progn - (while (and tail (not found)) - (setq found (eieio--c3-candidate (caar tail) - remaining-inputs) - tail (cdr tail))) - found))) - (if next - ;; The graph is consistent so far, add NEXT to result and - ;; merge input lists, dropping NEXT from their heads where - ;; applicable. - (eieio--c3-merge-lists - (cons next reversed-partial-result) - (mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l)) - remaining-inputs)) - ;; The graph is inconsistent, give up - (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) - (defsubst eieio--class/struct-parents (class) (or (eieio--class-parents class) `(,eieio-default-superclass))) @@ -1014,14 +971,16 @@ eieio--class/struct-parents (defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." (let ((parents (eieio--class-parents class))) - (eieio--c3-merge-lists - (list class) - (append - (or - (mapcar #'eieio--class-precedence-c3 parents) - `((,eieio-default-superclass))) - (list parents)))) - ) + (cons class + (merge-ordered-lists + (append + (or + (mapcar #'eieio--class-precedence-c3 parents) + `((,eieio-default-superclass))) + (list parents)) + (lambda (remaining-inputs) + (signal 'inconsistent-class-hierarchy + (list remaining-inputs))))))) ;;; ;; Method Invocation Order: Depth First diff --git a/lisp/simple.el b/lisp/simple.el index 266a66500cb..f79f1013669 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1029,7 +1029,7 @@ quoted-insert this function to insert characters when necessary. In binary overwrite mode, this function does overwrite, and octal -(or decimal or hex) digits are interpreted as a character code. This +\(or decimal or hex) digits are interpreted as a character code. This is intended to be useful for editing binary files." (interactive "*p") (let* ((char diff --git a/lisp/subr.el b/lisp/subr.el index b000787a5d6..75614f3c674 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2678,16 +2678,68 @@ while-let ;; PUBLIC: find if the current mode derives from another. +(defun merge-ordered-lists (lists &optional error-function) + "Merge LISTS in a consistent order. +LISTS is a list of lists of elements. +Merge them into a single list containing the same elements (removing +duplicates) using the C3 linearization, so as to obeying their relative +positions in each list. Equality of elements is tested with `eql'. + +If a consistent order does not exist, call ERROR-FUNCTION with +a remaining list of lists that we do not know how to merge. +It should return the candidate to use to continue the merge, which +has to be the head of one of the lists. +By default we choose the head of the first list." + (let ((result '())) + (while (cdr (setq lists (delq nil lists))) + ;; Try to find the next element of the result. This + ;; is achieved by considering the first element of each + ;; (non-empty) input list and accepting a candidate if it is + ;; consistent with the rests of the input lists. + (let* ((next nil) + (tail lists)) + (while tail + (let ((candidate (caar tail)) + (other-lists lists)) + ;; Ensure CANDIDATE is not in any position but the first + ;; in any of the element lists of LISTS. + (while other-lists + (if (not (memql candidate (cdr (car other-lists)))) + (setq other-lists (cdr other-lists)) + (setq candidate nil) + (setq other-lists nil))) + (if (not candidate) + (setq tail (cdr tail)) + (setq next candidate) + (setq tail nil)))) + (unless next ;; The graph is inconsistent. + (setq next (funcall (or error-function #'caar) lists)) + (unless (assoc next lists #'eql) + (error "Invalid candidate returned by error-function: %S" next))) + ;; The graph is consistent so far, add NEXT to result and + ;; merge input lists, dropping NEXT from their heads where + ;; applicable. + (push next result) + (setq lists + (mapcar (lambda (l) (if (eql (car l) next) (cdr l) l)) + lists)))) + (if (null result) (car lists) ;; Common case. + (append (nreverse result) (car lists))))) + (defun derived-mode-all-parents (mode &optional known-children) "Return all the parents of MODE, starting with MODE. 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' :-( (let ((ps (get mode 'derived-mode--all-parents))) - (if ps ps - (if (memq mode known-children) - (error "Cycle in the major mode hierarchy: %S" mode) - (push mode known-children)) + (cond + (ps ps) + ((memq mode known-children) + ;; These things happen, better not get all worked up about it. + ;;(error "Cycle in the major mode hierarchy: %S" mode) + nil) + (t + (push mode known-children) ;; The mode hierarchy (or DAG, actually), is very static, but we ;; need to react to changes because `parent' may not be defined ;; yet (e.g. it's still just an autoload), so the recursive call @@ -2708,17 +2760,13 @@ derived-mode-all-parents ;; If MODE is an alias, then follow the alias. (let ((alias (symbol-function mode))) (and (symbolp alias) alias)))) - (parents (cons mode (if parent (funcall all-parents parent)))) (extras (get mode 'derived-mode-extra-parents))) (put mode 'derived-mode--all-parents - (if (null extras) ;; Common case. - parents - (delete-dups - (apply #'append - parents (mapcar (lambda (extra) - (copy-sequence - (funcall all-parents extra))) - extras))))))))) + (cons mode + (merge-ordered-lists + (cons (if (and parent (not (memq parent extras))) + (funcall all-parents parent)) + (mapcar all-parents extras)))))))))) (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. commit fff9b6e37aaf7da22cf803441b96f47ddd92a027 Author: João Távora Date: Sat Nov 11 15:29:46 2023 +0000 Fix test failures in test/lisp/minibuffer-tests.el bug#48841, bug#47711 In some instances the test code needed to be updated to make different assumptions about implementation details. In others, like the ones about the completions-first-difference face, minor parts of the actual user-visible behaviour were broken. * test/lisp/minibuffer-tests.el (completion-test1): Robustify test. (completion--pcm-score): Don't assume completion-score is stored in string as a property. * lisp/minibuffer.el (completion--hilit-from-re): Take new parameter. (completion-pcm--hilit-commonality): Use it. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3e2e3b6c6f2..07a284134d6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3838,17 +3838,26 @@ completion-lazy-hilit (funcall completion-lazy-hilit-fn (copy-sequence str)) str)) -(defun completion--hilit-from-re (string regexp) - "Fontify STRING with `completions-common-part' using REGEXP." - (let* ((md (and regexp (string-match regexp string) (cddr (match-data t)))) - (me (and md (match-end 0))) - (from 0)) - (while md - (add-face-text-property from (pop md) 'completions-common-part nil string) - (setq from (pop md))) - (unless (or (not me) (= from me)) - (add-face-text-property from me 'completions-common-part nil string)) - string)) +(defun completion--hilit-from-re (string regexp &optional point-idx) + "Fontify STRING using REGEXP POINT-IDX. +`completions-common-part' and `completions-first-difference' are +used. POINT-IDX is the position of point in the presumed \"PCM\" +pattern that was used to generate derive REGEXP from." +(let* ((md (and regexp (string-match regexp string) (cddr (match-data t)))) + (pos (if point-idx (match-beginning point-idx) (match-end 0))) + (me (and md (match-end 0))) + (from 0)) + (while md + (add-face-text-property from (pop md) 'completions-common-part nil string) + (setq from (pop md))) + (if (> (length string) pos) + (add-face-text-property + pos (1+ pos) + 'completions-first-difference + nil string)) + (unless (or (not me) (= from me)) + (add-face-text-property from me 'completions-common-part nil string)) + string)) (defun completion--flex-score-1 (md-groups match-end len) "Compute matching score of completion. @@ -3973,16 +3982,17 @@ completion-pcm--hilit-commonality completion-lazy-hilit-fn nil) (cond ((and completions (cl-loop for e in pattern thereis (stringp e))) - (let* ((re (completion-pcm--pattern->regex pattern 'group))) + (let* ((re (completion-pcm--pattern->regex pattern 'group)) + (point-idx (completion-pcm--pattern-point-idx pattern))) (setq completion-pcm--regexp re) (cond (completion-lazy-hilit (setq completion-lazy-hilit-fn - (lambda (str) (completion--hilit-from-re str re))) + (lambda (str) (completion--hilit-from-re str re point-idx))) completions) (t (mapcar (lambda (str) - (completion--hilit-from-re (copy-sequence str) re)) + (completion--hilit-from-re (copy-sequence str) re point-idx)) completions))))) (t completions))) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 27d71805502..28bca60b189 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -33,14 +33,13 @@ (ert-deftest completion-test1 () (with-temp-buffer - (cl-flet* ((test/completion-table (_string _pred action) - (if (eq action 'lambda) - nil - "test: ")) + (cl-flet* ((test/completion-table (string pred action) + (let ((completion-ignore-case t)) + (complete-with-action action '("test: ") string pred))) (test/completion-at-point () - (list (copy-marker (point-min)) - (copy-marker (point)) - #'test/completion-table))) + (list (copy-marker (point-min)) + (copy-marker (point)) + #'test/completion-table))) (let ((completion-at-point-functions (list #'test/completion-at-point))) (insert "TEST") (completion-at-point) @@ -190,7 +189,8 @@ completion-all-sorted-completions (defun completion--pcm-score (comp) "Get `completion-score' from COMP." - (get-text-property 0 'completion-score comp)) + ;; FIXME, uses minibuffer.el implementation details + (completion--flex-score comp completion-pcm--regexp)) (defun completion--pcm-first-difference-pos (comp) "Get `completions-first-difference' from COMP." commit c9d7740574758d47c8864cbada5fd2a2b2ee8911 Merge: 45942508141 ce0ebb91f25 Author: Eli Zaretskii Date: Sat Nov 11 05:31:52 2023 -0500 Merge from origin/emacs-29 ce0ebb91f25 Improve documentation of read syntax and printed represen... 81f84b00a5d ; * doc/lispref/modes.texi (Other Font Lock Variables): A... 434592b0746 ; * lisp/dired.el (dired-use-ls-dired): Doc fix (bug#67053). fe000236cf2 Improve documentation of signaling errors in batch mode 103ca678ac1 Fix treesit-simple-indent-presets docstring (bug#67007) b7871cefe7b Prevent an infinite loop in todo-mode (bug#66994) fa8cc4c9ee2 Fix cmake-ts-mode indentation (Bug#66845) 5bdc61bc0ef Update to Org 9.6.11 18e2de1bec9 ; * lisp/bindings.el (right-word, left-word): Doc fix. 4f0fc3bfda3 ; Document core input events problems with XInput2 commit 45942508141bbeacd00479599e21592af42253bd Author: Po Lu Date: Sat Nov 11 18:05:35 2023 +0800 ; * lisp/touch-screen.el (touch-screen-track-tap): Fix typo. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index f838e3bff3d..2e5a88da071 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1550,10 +1550,10 @@ touch-screen-track-tap 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 touch -point moves beyond that threshold EVENT on any axis, return nil -immediately, and further resume mouse event translation for the -touch point at hand. +either itself or 10 pixels when it is not a number. If the +aformentioned 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." commit 68b8df57c720bb1a9fdde2c31afac9602e7491ed Author: Po Lu Date: Sat Nov 11 18:03:33 2023 +0800 Enable canceling tap gestures * doc/lispref/commands.texi (Touchscreen Events): Relate new THRESHOLD argument to touch-screen-track-tap. * lisp/button.el (push-button): * lisp/wid-edit.el (widget-button--check-and-call-button): Provide a threshold to enable canceling button presses. * lisp/touch-screen.el (touch-screen-track-tap): Enable canceling tap gestures and resuming touch sequence translation if the touch point exceeds a set threshold. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 41c30437dce..2518740ad3b 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2207,7 +2207,7 @@ Touchscreen Events events; they allow responding to commonly used touch screen gestures separately from mouse event translation. -@defun touch-screen-track-tap event &optional update data +@defun touch-screen-track-tap event &optional update data threshold This function is used to track a single ``tap'' gesture originating from the @code{touchscreen-begin} event @var{event}, often used to set the point or to activate a button. It waits for a @@ -2220,6 +2220,14 @@ Touchscreen Events the list of touchpoints in that @code{touchscreen-update} event, and @var{data}. +If @var{threshold} is non-@code{nil} and such an event indicates that +the touchpoint represented by @var{event} has moved beyond a threshold +of either @var{threshold} or 10 pixels if it is not a number from the +position of @var{event}, @code{nil} is returned and mouse event +translation is resumed for that touchpoint, so as not to impede the +recognition of any subsequent touchscreen gesture arising from its +sequence. + If any other event arrives in the mean time, @code{nil} is returned. The caller should not perform any action in that case. @end defun diff --git a/lisp/button.el b/lisp/button.el index bfe6ccc8d1f..ed11c9583d8 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -495,7 +495,7 @@ push-button (if (eq (car-safe pos) 'touchscreen-down) ;; If touch-screen-track tap returns nil, then the ;; tap was cancelled. - (when (touch-screen-track-tap pos) + (when (touch-screen-track-tap pos nil nil t) (push-button (posn-point posn) t)) (push-button (posn-point posn) t)))))) ;; POS is just normal position diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index ea1e27a263b..f838e3bff3d 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1539,7 +1539,7 @@ function-key-map ;; Exports. These functions are intended for use externally. -(defun touch-screen-track-tap (event &optional update data) +(defun touch-screen-track-tap (event &optional update data threshold) "Track a single tap starting from EVENT. EVENT should be a `touchscreen-begin' event. @@ -1549,16 +1549,45 @@ touch-screen-track-tap 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 touch +point moves beyond that threshold EVENT 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." - (let ((disable-inhibit-text-conversion t)) + (let ((disable-inhibit-text-conversion t) + (threshold (and threshold (or (and (numberp threshold) + threshold) + 10))) + (original-x-y (posn-x-y (cdadr event))) + (original-window (posn-window (cdadr event)))) (catch 'finish (while t - (let ((new-event (read-event nil))) + (let ((new-event (read-event nil)) + touch-point) (cond ((eq (car-safe new-event) 'touchscreen-update) - (when (and update (assq (caadr event) (cadr new-event))) - (funcall update new-event data))) + (when (setq touch-point (assq (caadr event) (cadr new-event))) + (when update + (funcall update new-event data)) + (when threshold + (setq touch-point (cdr touch-point)) + ;; Detect the touch point moving past the threshold. + (let* ((x-y (touch-screen-relative-xy touch-point + original-window)) + (x (car x-y)) (y (cdr x-y))) + (when (or (> (abs (- x (car original-x-y))) threshold) + (> (abs (- y (cdr original-x-y))) threshold)) + ;; Resume normal touch-screen to mouse event + ;; translation for this touch sequence by + ;; supplying both the event starting it and the + ;; motion event that overstepped the threshold to + ;; touch-screen-handle-touch. + (touch-screen-handle-touch event nil t) + (touch-screen-handle-touch new-event nil t) + (throw 'finish nil)))))) ((eq (car-safe new-event) 'touchscreen-end) (throw 'finish ;; Now determine whether or not the `touchscreen-end' diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 74412414113..6ae00171d84 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1127,7 +1127,7 @@ widget-button--check-and-call-button ;; This a touchscreen event and must be handled ;; specially through `touch-screen-track-tap'. (progn - (unless (touch-screen-track-tap event) + (unless (touch-screen-track-tap event nil nil t) (throw 'button-press-cancelled t))) (unless (widget-apply button :mouse-down-action event) (let ((track-mouse t)) commit ce0ebb91f25847ebaa2745f47413df24a60f051c Author: Eli Zaretskii Date: Sat Nov 11 12:02:24 2023 +0200 Improve documentation of read syntax and printed representation * doc/lispref/objects.texi (Syntax for Strings): Describe in more detail how to specify special characters in string literals. (Printed Representation, Character Type, Nonprinting Characters): Improve information and add cross-references about printed representation and read syntax. (Bug#67033) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 3cca892826e..ad5cd6d39c4 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -96,6 +96,12 @@ Printed Representation error @code{invalid-read-syntax} whenever it encounters @samp{#<}. @kindex invalid-read-syntax + We describe the read syntax and the printed representation of each +Lisp data type where we describe that data type, in the following +sections of this chapter. For example, see @ref{String Type}, and its +subsections for the read syntax and printed representation of strings; +see @ref{Vector Type} for the same information about vectors; etc. + In other languages, an expression is text; it has no other form. In Lisp, an expression is primarily a Lisp object and only secondarily the text that is the object's read syntax. Often there is no need to @@ -321,6 +327,8 @@ Character Type A @dfn{character} in Emacs Lisp is nothing more than an integer. In other words, characters are represented by their character codes. For example, the character @kbd{A} is represented as the @w{integer 65}. +That is also their usual printed representation; see @ref{Basic Char +Syntax}. Individual characters are used occasionally in programs, but it is more common to work with @emph{strings}, which are sequences composed @@ -1106,6 +1114,22 @@ Syntax for Strings another backslash, like this: @code{"this \\ is a single embedded backslash"}. + Since a string is an array of characters, you can specify the string +characters using the read syntax of characters, but without the +leading question mark. This is useful for including in string +constants characters that don't stand for themselves. Thus, control +characters can be specified as escape sequences that start with a +backslash; for example, @code{"foo\r"} yields @samp{foo} followed by +the carriage return character. @xref{Basic Char Syntax}, for escape +sequences of other control characters. Similarly, you can use the +special read syntax for control characters (@pxref{Ctl-Char Syntax}), +as in @code{"foo\^Ibar"}, which produces a tab character embedded +within a string. You can also use the escape sequences for non-ASCII +characters described in @ref{General Escape Syntax}, as in +@w{@code{"\N@{LATIN SMALL LETTER A WITH GRAVE@}"}} and @code{"\u00e0"} +(however, see a caveat with non-ASCII characters in @ref{Non-ASCII in +Strings}). + @cindex newline in strings The newline character is not special in the read syntax for strings; if you write a new line between the double-quotes, it becomes a @@ -1182,8 +1206,9 @@ Nonprinting Characters as in character literals (but do not use the question mark that begins a character constant). For example, you can write a string containing the nonprinting characters tab and @kbd{C-a}, with commas and spaces between -them, like this: @code{"\t, \C-a"}. @xref{Character Type}, for a -description of the read syntax for characters. +them, like this: @code{"\t, \C-a"}. @xref{Character Type}, and its +subsections for a description of the various kinds of read syntax for +characters. However, not all of the characters you can write with backslash escape-sequences are valid in strings. The only control characters that commit 81f84b00a5d2f1f714537c375c2102c512e522b1 Author: Eli Zaretskii Date: Sat Nov 11 11:05:58 2023 +0200 ; * doc/lispref/modes.texi (Other Font Lock Variables): Add link. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 8cdbe1149ca..78e73359b6d 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3607,7 +3607,9 @@ Other Font Lock Variables allows using debugging aids such as @code{debug-on-error} (@pxref{Error Debugging}) and Edebug (@pxref{Edebug}) for finding and fixing problems in font-lock code and any other code run by JIT -font-lock. +font-lock. Another command that could be useful when developing and +debugging font-lock is @code{font-lock-debug-fontify}, see @ref{Font +Lock Basics}. @end deffn @node Levels of Font Lock commit 434592b07466901bbe85f906ce25f2584d30bc4d Author: Eli Zaretskii Date: Sat Nov 11 08:47:22 2023 +0200 ; * lisp/dired.el (dired-use-ls-dired): Doc fix (bug#67053). diff --git a/lisp/dired.el b/lisp/dired.el index f81e49a6b00..cc548baf080 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -122,7 +122,9 @@ dired-use-ls-dired The special value of `unspecified' means to check whether \"ls\" supports the \"--dired\" option, and save the result in this variable. This is performed the first time `dired-insert-directory' -is invoked. +is invoked. (If `ls-lisp' is used by default, the test is performed +only if `ls-lisp-use-insert-directory-program' is non-nil, i.e., if +Dired actually uses \"ls\".) Note that if you set this option to nil, either through choice or because your \"ls\" program does not support \"--dired\", Dired commit f2b162f8ee5d93dafd87be34acef746e67d9ab26 Author: Jim Porter Date: Fri Nov 10 17:53:02 2023 -0800 Add some more Eshell history tests * test/lisp/eshell/em-hist-tests.el (em-hist-test/check-history-file): New function. Use it throughout this file. (em-hist-test/history-append): Rename to... (em-hist-test/write-history/append): ... this. (em-hist-test/history-read): Rename to... (em-hist-test/write-history/overwrite): ... this. (em-hist-test/write-history/append-multiple-eshells) (em-hist-test/write-history/overwrite-multiple-shells): New tests. (em-hist-test/write-history/read-only): Check the resulting history. diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el index 4851bdc50b2..e90ce141a81 100644 --- a/test/lisp/eshell/em-hist-tests.el +++ b/test/lisp/eshell/em-hist-tests.el @@ -19,6 +19,9 @@ ;;; Code: +(eval-when-compile + (require 'cl-lib)) + (require 'ert) (require 'ert-x) (require 'em-hist) @@ -29,9 +32,94 @@ (file-name-directory (or load-file-name default-directory)))) +(cl-defun em-hist-test/check-history-file (file-name expected &optional + (expected-ring t)) + "Check that the contents of FILE-NAME match the EXPECTED history entries. +Additonally, check that after loading the file, the history ring +matches too. If EXPECTED-RING is a list, compare the ring +elements against that; if t (the default), check again EXPECTED." + (when (eq expected-ring t) (setq expected-ring expected)) + ;; First check the actual file. + (should (equal (with-temp-buffer + (insert-file-contents file-name) + (buffer-string)) + (mapconcat (lambda (i) (concat i "\n")) expected))) + ;; Now read the history ring and check that too. + (let (eshell-history-ring eshell-history-index eshell-hist--new-items) + (eshell-read-history file-name) + (should (equal (nreverse (ring-elements eshell-history-ring)) + expected-ring)))) + ;;; Tests: -(ert-deftest em-hist-test/write-readonly-history () +(ert-deftest em-hist-test/write-history/append () + "Test appending new history to history file." + (ert-with-temp-file histfile + (with-temp-eshell + (em-hist-test/check-history-file histfile nil) + (eshell-insert-command "echo hi") + (eshell-write-history histfile 'append) + (em-hist-test/check-history-file histfile '("echo hi")) + (eshell-insert-command "echo bye") + (eshell-write-history histfile 'append) + (em-hist-test/check-history-file histfile '("echo hi" "echo bye"))))) + +(ert-deftest em-hist-test/write-history/append-multiple-eshells () + "Test appending new history to history file from multiple Eshells." + (ert-with-temp-file histfile + (with-temp-eshell + (with-temp-eshell + ;; Enter some commands and save them. + (eshell-insert-command "echo foo") + (eshell-insert-command "echo bar") + (eshell-write-history histfile 'append) + (em-hist-test/check-history-file histfile '("echo foo" "echo bar"))) + ;; Now do the same in the first Eshell buffer. + (eshell-insert-command "echo goat") + (eshell-insert-command "echo panda") + (eshell-write-history histfile 'append) + (em-hist-test/check-history-file + histfile '("echo foo" "echo bar" "echo goat" "echo panda"))))) + +(ert-deftest em-hist-test/write-history/overwrite () + "Test overwriting history file." + (ert-with-temp-file histfile + (with-temp-eshell + (em-hist-test/check-history-file histfile nil) + (eshell-insert-command "echo hi") + (eshell-insert-command "echo bye") + (eshell-insert-command "echo bye") + (eshell-insert-command "echo hi") + (eshell-write-history histfile) + (em-hist-test/check-history-file + histfile '("echo hi" "echo bye" "echo bye" "echo hi")) + (let ((eshell-hist-ignoredups t)) + (em-hist-test/check-history-file + histfile '("echo hi" "echo bye" "echo bye" "echo hi") + '("echo hi" "echo bye" "echo hi"))) + (let ((eshell-hist-ignoredups 'erase)) + (em-hist-test/check-history-file + histfile '("echo hi" "echo bye" "echo bye" "echo hi") + '("echo bye" "echo hi")))))) + +(ert-deftest em-hist-test/write-history/overwrite-multiple-shells () + "Test overwriting history file from multiple Eshells." + (ert-with-temp-file histfile + (with-temp-eshell + (with-temp-eshell + ;; Enter some commands and save them. + (eshell-insert-command "echo foo") + (eshell-insert-command "echo bar") + (eshell-write-history histfile) + (em-hist-test/check-history-file histfile '("echo foo" "echo bar"))) + ;; Now do the same in the first Eshell buffer. + (eshell-insert-command "echo goat") + (eshell-insert-command "echo panda") + (eshell-write-history histfile) + (em-hist-test/check-history-file + histfile '("echo goat" "echo panda"))))) + +(ert-deftest em-hist-test/write-history/read-only () "Test that having read-only strings in history is okay." (ert-with-temp-file histfile (let ((eshell-history-ring (make-ring 2))) @@ -39,41 +127,8 @@ em-hist-test/write-readonly-history (propertize "echo foo" 'read-only t)) (ring-insert eshell-history-ring (propertize "echo bar" 'read-only t)) - (eshell-write-history histfile)))) - -(ert-deftest em-hist-test/history-append () - "Test 'history -a'." - (ert-with-temp-file histfile - (with-temp-eshell - (let ((eshell-history-file-name histfile)) - (eshell-insert-command "echo hi") - (eshell-insert-command "history -w") - (eshell-insert-command "history -a") - (eshell-insert-command "echo bye") - (eshell-insert-command "history -a") - (eshell-insert-command "history -r") - (should (equal (ring-elements eshell-history-ring) - '("history -a" "echo bye" - "history -a" "history -w" "echo hi"))))))) - -(ert-deftest em-hist-test/history-read () - "Test 'history -r'." - (ert-with-temp-file histfile - (with-temp-eshell - (let ((eshell-history-file-name histfile)) - (eshell-insert-command "echo hi") - (eshell-insert-command "echo bye") - (eshell-insert-command "echo bye") - (eshell-insert-command "echo hi") - (eshell-insert-command "history -w") - (let ((eshell-hist-ignoredups t)) - (eshell-insert-command "history -r") - (should (equal (ring-elements eshell-history-ring) - '("history -w" "echo hi" "echo bye" "echo hi")))) - (let ((eshell-hist-ignoredups 'erase)) - (eshell-insert-command "history -r") - (should (equal (ring-elements eshell-history-ring) - '("history -w" "echo hi" "echo bye")))))))) + (eshell-write-history histfile) + (em-hist-test/check-history-file histfile '("echo foo" "echo bar"))))) (ert-deftest em-hist-test/add-to-history/allow-dups () "Test adding to history, allowing dups." commit 8b3969006fe6095178eea38df096d73bdd460a15 Author: Liu Hui Date: Tue Nov 7 09:10:59 2023 +0800 Improve read/append behavior of eshell history command * lisp/eshell/em-hist.el (eshell-hist--new-items): New variable. (eshell-hist-initialize): Initialize 'eshell-hist--new-items' to 0. (eshell/history): Change the behavior of 'history -a' to "append new history in current buffer to history file". Clarify the help text of 'history -r'. (eshell-add-input-to-history): Increase counter of new history items. (eshell-read-history): Respect 'eshell-hist-ignoredups' option. (eshell-write-history): If the optional argument APPEND is non-nil, appending new history items rather than the whole history. * test/lisp/eshell/em-hist-tests.el (em-hist-test/history-append) (em-hist-test/history-read): New tests (bug#66768). diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 9d4b72b01df..cf03f8399a6 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -195,6 +195,9 @@ eshell-history-ring (defvar eshell-history-index nil) (defvar eshell-matching-input-from-input-string "") (defvar eshell-save-history-index nil) +(defvar eshell-hist--new-items nil + "The number of new history items that have not been written to +file. This variable is local in each eshell buffer.") (defvar-keymap eshell-isearch-map :doc "Keymap used in isearch in Eshell." @@ -283,6 +286,7 @@ eshell-hist-initialize (make-local-variable 'eshell-history-index) (make-local-variable 'eshell-save-history-index) + (setq-local eshell-hist--new-items 0) (if (minibuffer-window-active-p (selected-window)) (setq-local eshell-save-history-on-exit nil) @@ -323,11 +327,11 @@ eshell/history (eshell-eval-using-options "history" args '((?r "read" nil read-history - "read from history file to current history list") + "clear current history list and read from history file to it") (?w "write" nil write-history "write current history list to history file") (?a "append" nil append-history - "append current history list to history file") + "append new history in current buffer to history file") (?h "help" nil nil "display this usage message") :usage "[n] [-rwa [filename]]" :post-usage @@ -394,6 +398,8 @@ eshell-add-input-to-history (_ ; Add if not already the latest entry (or (ring-empty-p eshell-history-ring) (not (string-equal (eshell-get-history 0) input)))))) + (setq eshell-hist--new-items + (min eshell-history-size (1+ eshell-hist--new-items))) (eshell-put-history input)) (setq eshell-save-history-index eshell-history-index) (setq eshell-history-index nil)) @@ -455,21 +461,30 @@ eshell-read-history (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$" nil t)) (let ((history (match-string 1))) - (if (or (null ignore-dups) - (ring-empty-p ring) - (not (string-equal (ring-ref ring 0) history))) - (ring-insert-at-beginning - ring (subst-char-in-string ?\177 ?\n history)))) - (setq count (1+ count)))) + (when (or (ring-empty-p ring) + (null ignore-dups) + (and (not (string-equal + (ring-ref ring (1- (ring-length ring))) + history)) + (not (and (eq ignore-dups 'erase) + (ring-member ring history))))) + (ring-insert-at-beginning + ring (subst-char-in-string ?\177 ?\n history)) + (setq count (1+ count)))))) (setq eshell-history-ring ring - eshell-history-index nil)))))) + eshell-history-index nil + eshell-hist--new-items 0)))))) (defun eshell-write-history (&optional filename append) "Writes the buffer's `eshell-history-ring' to a history file. -The name of the file is given by the variable -`eshell-history-file-name'. The original contents of the file are -lost if `eshell-history-ring' is not empty. If -`eshell-history-file-name' is nil this function does nothing. +If the optional argument FILENAME is nil, the value of +`eshell-history-file-name' is used. This function does nothing +if the value resolves to nil. + +If the optional argument APPEND is non-nil, then append new +history items to the history file. Otherwise, overwrite the +contents of the file with `eshell-history-ring' (so long as it is +not empty). Useful within process sentinels. @@ -480,13 +495,14 @@ eshell-write-history ((or (null file) (equal file "") (null eshell-history-ring) - (ring-empty-p eshell-history-ring)) + (ring-empty-p eshell-history-ring) + (and append (= eshell-hist--new-items 0))) nil) ((not (file-writable-p resolved-file)) (message "Cannot write history file %s" resolved-file)) (t (let* ((ring eshell-history-ring) - (index (ring-length ring))) + (index (if append eshell-hist--new-items (ring-length ring)))) ;; Write it all out into a buffer first. Much faster, but ;; messier, than writing it one line at a time. (with-temp-buffer @@ -499,7 +515,8 @@ eshell-write-history (subst-char-in-region start (1- (point)) ?\n ?\177))) (eshell-with-private-file-modes (write-region (point-min) (point-max) resolved-file append - 'no-message)))))))) + 'no-message))) + (setq eshell-hist--new-items 0)))))) (defun eshell-list-history () "List in help buffer the buffer's input history." diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el index 0f143355115..4851bdc50b2 100644 --- a/test/lisp/eshell/em-hist-tests.el +++ b/test/lisp/eshell/em-hist-tests.el @@ -41,6 +41,40 @@ em-hist-test/write-readonly-history (propertize "echo bar" 'read-only t)) (eshell-write-history histfile)))) +(ert-deftest em-hist-test/history-append () + "Test 'history -a'." + (ert-with-temp-file histfile + (with-temp-eshell + (let ((eshell-history-file-name histfile)) + (eshell-insert-command "echo hi") + (eshell-insert-command "history -w") + (eshell-insert-command "history -a") + (eshell-insert-command "echo bye") + (eshell-insert-command "history -a") + (eshell-insert-command "history -r") + (should (equal (ring-elements eshell-history-ring) + '("history -a" "echo bye" + "history -a" "history -w" "echo hi"))))))) + +(ert-deftest em-hist-test/history-read () + "Test 'history -r'." + (ert-with-temp-file histfile + (with-temp-eshell + (let ((eshell-history-file-name histfile)) + (eshell-insert-command "echo hi") + (eshell-insert-command "echo bye") + (eshell-insert-command "echo bye") + (eshell-insert-command "echo hi") + (eshell-insert-command "history -w") + (let ((eshell-hist-ignoredups t)) + (eshell-insert-command "history -r") + (should (equal (ring-elements eshell-history-ring) + '("history -w" "echo hi" "echo bye" "echo hi")))) + (let ((eshell-hist-ignoredups 'erase)) + (eshell-insert-command "history -r") + (should (equal (ring-elements eshell-history-ring) + '("history -w" "echo hi" "echo bye")))))))) + (ert-deftest em-hist-test/add-to-history/allow-dups () "Test adding to history, allowing dups." (let ((eshell-hist-ignoredups nil)) commit 400a71b8f2c5a49dce4f542adfd2fdb59eb34243 Author: Eli Zaretskii Date: Fri Nov 10 21:54:35 2023 +0200 Fix mode-line after switching from WDired back to Dired * lisp/wdired.el (wdired-change-to-dired-mode): Call 'dired-sort-set-mode-line' to set the mode name in the mode line, so as to restore the display before switching to WDired. (Bug#67028) diff --git a/lisp/wdired.el b/lisp/wdired.el index 7b9c75d36b1..079d93d6011 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -453,7 +453,7 @@ wdired-change-to-dired-mode (force-mode-line-update) (setq buffer-read-only t) (setq major-mode 'dired-mode) - (setq mode-name "Dired") + (dired-sort-set-mode-line) (dired-advertise) (dired-hide-details-update-invisibility-spec) (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t) commit 02f57d0e1596d569292a1edd6b6cbabb2992a95a Author: Eric Abrahamsen Date: Fri Nov 10 17:35:04 2023 +0100 Add some headers to message-ignored-bounced-headers * lisp/gnus/message.el (message-ignored-bounced-headers): These are headers that a) are derived from the exact text of the message and thus are now invalid and b) either will be automatically regenerated when the message is sent or shouldn't be present on the message copy at all. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 0f5d253bc96..9e60c21e3d4 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -154,7 +154,7 @@ message-courtesy-message :type '(radio string (const nil))) (defcustom message-ignored-bounced-headers - "^\\(Received\\|Return-Path\\|Delivered-To\\):" + "^\\(Received\\|Return-Path\\|Delivered-To\\|DKIM-Signature\\|X-Hashcash\\):" "Regexp that matches headers to be removed in resent bounced mail." :group 'message-interface :type 'regexp) @@ -9008,7 +9008,7 @@ message-mailto-1 (message-goto-body) (dolist (body (cdr (assoc "body" args))) (insert body "\n"))) - + (setq need-body t)) (if (assoc "subject" args) (message-goto-body) commit 7f3ee93e0ccb9ffd4fdb23ad13b0fbf4b1353779 Author: Mattias Engdegård Date: Fri Nov 10 16:57:15 2023 +0100 Use BASE_EQ instead of EQ for some uninterned symbols * src/editfns.c (labeled_restrictions_pop, Fwiden): * src/eval.c (lexbound_p, Fbacktrace__locals): * src/fileio.c (Finsert_file_contents): * src/fns.c (Fyes_or_no_p): * src/keyboard.c (command_loop_1): Use BASE_EQ for comparing with Qoutermost_restriction, Qinternal_interpreter_environment and Qunbound as uninterned symbols won't be EQ to a symbol-with-pos. diff --git a/src/editfns.c b/src/editfns.c index 02fca3f5714..1ea7931a3a7 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2780,7 +2780,7 @@ labeled_restrictions_pop (Lisp_Object buf) Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions); if (NILP (restrictions)) return; - if (EQ (labeled_restrictions_peek_label (buf), Qoutermost_restriction)) + if (BASE_EQ (labeled_restrictions_peek_label (buf), Qoutermost_restriction)) labeled_restrictions_remove (buf); else XSETCDR (restrictions, list1 (XCDR (XCAR (XCDR (restrictions))))); @@ -2920,7 +2920,7 @@ DEFUN ("widen", Fwiden, Swiden, 0, 0, "", current_buffer are the bounds that were set by the user, no labeled restriction is in effect in current_buffer anymore: remove it from the labeled_restrictions alist. */ - if (EQ (label, Qoutermost_restriction)) + if (BASE_EQ (label, Qoutermost_restriction)) labeled_restrictions_pop (buf); } /* Changing the buffer bounds invalidates any recorded current column. */ diff --git a/src/eval.c b/src/eval.c index f5397e9fb72..d66bcdae6ce 100644 --- a/src/eval.c +++ b/src/eval.c @@ -689,7 +689,7 @@ lexbound_p (Lisp_Object symbol) { case SPECPDL_LET_DEFAULT: case SPECPDL_LET: - if (EQ (specpdl_symbol (pdl), Qinternal_interpreter_environment)) + if (BASE_EQ (specpdl_symbol (pdl), Qinternal_interpreter_environment)) { Lisp_Object env = specpdl_old_value (pdl); if (CONSP (env) && !NILP (Fassq (symbol, env))) @@ -4107,7 +4107,7 @@ DEFUN ("backtrace--locals", Fbacktrace__locals, Sbacktrace__locals, 1, 2, NULL, { Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object val = specpdl_old_value (tmp); - if (EQ (sym, Qinternal_interpreter_environment)) + if (BASE_EQ (sym, Qinternal_interpreter_environment)) { Lisp_Object env = val; for (; CONSP (env); env = XCDR (env)) diff --git a/src/fileio.c b/src/fileio.c index 8919e08e1fd..51937e6d765 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -4778,7 +4778,7 @@ DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, make_gap (total - GAP_SIZE + 1); if (beg_offset != 0 || (!NILP (replace) - && !EQ (replace, Qunbound))) + && !BASE_EQ (replace, Qunbound))) { if (emacs_fd_lseek (fd, beg_offset, SEEK_SET) < 0) report_file_error ("Setting file position", orig_filename); diff --git a/src/fns.c b/src/fns.c index a3f89637dfd..84aa86d9eb6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3239,7 +3239,7 @@ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, && (CONSP (last_nonmenu_event) || (NILP (last_nonmenu_event) && CONSP (last_input_event)) || (val = find_symbol_value (Qfrom__tty_menu_p), - (!NILP (val) && !EQ (val, Qunbound)))) + (!NILP (val) && !BASE_EQ (val, Qunbound)))) && use_dialog_box) { Lisp_Object pane, menu, obj; diff --git a/src/keyboard.c b/src/keyboard.c index 13cb7835dff..81605e75ba2 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1601,7 +1601,7 @@ command_loop_1 (void) if ((!NILP (Fwindow_system (Qnil)) || ((symval = find_symbol_value (Qtty_select_active_regions), - (!EQ (symval, Qunbound) && !NILP (symval))) + (!BASE_EQ (symval, Qunbound) && !NILP (symval))) && !NILP (Fterminal_parameter (Qnil, Qxterm__set_selection)))) /* Even if mark_active is non-nil, the actual buffer commit dfcc9a0f4d63444bac8c3cf6610379c912251d3c Author: Michael Albinus Date: Fri Nov 10 11:16:22 2023 +0100 * test/infra/gitlab-ci.yml (.native-comp-template): Adapt "changes". diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 6884c32848e..f106ea4d8de 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -193,10 +193,10 @@ default: - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - "**.in" - - lisp/emacs-lisp/comp.el - - lisp/emacs-lisp/comp-cstr.el + - lisp/emacs-lisp/comp*.el - src/comp.{h,m} - test/infra/* + - test/lisp/emacs-lisp/comp*-tests.el - test/src/comp-resources/*.el - test/src/comp-tests.el timeout: 8 hours commit d1da4af93e10b9e7be49e67c232a870f0a75b86a Author: Michael Albinus Date: Fri Nov 10 11:15:30 2023 +0100 Don't expand file names for non-existing remote connections * lisp/saveplace.el (save-place-abbreviate-file-names) [:set]: * lisp/bookmark.el (bookmark--remove-fringe-mark): Don't expand file names for non-existing remote connections. (Bug#66982) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 10ff2f5ebbf..71d76cb4291 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -511,6 +511,8 @@ bookmark--remove-fringe-mark See user option `bookmark-fringe-mark'." (let ((filename (cdr (assq 'filename bm))) (pos (cdr (assq 'position bm))) + ;; Don't expand file names for non-existing remote connections. + (non-essential t) overlays found temp) (when (and pos filename) (setq filename (expand-file-name filename)) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 590c55d2609..1330d00f10a 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -156,7 +156,9 @@ save-place-abbreviate-file-names :set (lambda (sym val) (set-default sym val) (or save-place-loaded (save-place-load-alist-from-file)) - (let ((fun (if val #'abbreviate-file-name #'expand-file-name))) + (let ((fun (if val #'abbreviate-file-name #'expand-file-name)) + ;; Don't expand file names for non-existing remote connections. + (non-essential t)) (setq save-place-alist (cl-delete-duplicates (cl-loop for (k . v) in save-place-alist commit 5324723c2bcab7062f393a5057e51733a1715788 Author: Po Lu Date: Fri Nov 10 14:57:24 2023 +0800 Clear image caches in reaction to system VM warnings * java/org/gnu/emacs/EmacsNative.java (onLowMemory): * java/org/gnu/emacs/EmacsService.java (onLowMemory): New function. * src/android.c (android_on_low_memory, onLowMemory): New functions called when a VM caution is registered. Clear the image cache and run garbage collection. diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 946a38f7f84..78176dd0e47 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -96,6 +96,9 @@ public static native void setEmacsParams (AssetManager assetManager, thread, then return. */ public static native void shutDownEmacs (); + /* Garbage collect and clear each frame's image cache. */ + public static native void onLowMemory (); + /* Abort and generate a native core dump. */ public static native void emacsAbort (); diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index ab6d57b9c4f..1aac1a6c4dd 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -321,6 +321,10 @@ invocation of app_process (through android-emacs) can } } + /* The native functions the subsequent two functions call do nothing + in the infrequent case the Emacs thread is awaiting a response + for the main thread. Caveat emptor! */ + @Override public void onDestroy () @@ -333,6 +337,14 @@ invocation of app_process (through android-emacs) can super.onDestroy (); } + @Override + public void + onLowMemory () + { + EmacsNative.onLowMemory (); + super.onLowMemory (); + } + /* Functions from here on must only be called from the Emacs diff --git a/src/android.c b/src/android.c index f5af742b422..7a670cb507f 100644 --- a/src/android.c +++ b/src/android.c @@ -1957,6 +1957,26 @@ NATIVE_NAME (shutDownEmacs) (JNIEnv *env, jobject object) android_run_in_emacs_thread (android_shut_down_emacs, NULL); } +/* Carry out garbage collection and clear all image caches on the + Android terminal. Called when the system has depleted most of its + memory and desires that background processes release unused + core. */ + +static void +android_on_low_memory (void *closure) +{ + Fclear_image_cache (Qt, Qt); + garbage_collect (); +} + +JNIEXPORT void JNICALL +NATIVE_NAME (onLowMemory) (JNIEnv *env, jobject object) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + android_run_in_emacs_thread (android_on_low_memory, NULL); +} + JNIEXPORT jlong JNICALL NATIVE_NAME (sendConfigureNotify) (JNIEnv *env, jobject object, jshort window, jlong time, commit 5dc3c9f4eca2e3c4b4059cc5b52b56c98eb3d961 Author: Yuan Fu Date: Thu Nov 9 21:19:12 2023 -0800 Mark treesit--things-around obsolete * lisp/treesit.el (treesit--things-around): Mark obsolete. diff --git a/lisp/treesit.el b/lisp/treesit.el index 962b957b80c..45c5f313a8e 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2359,17 +2359,7 @@ treesit-default-defun-skipper (line-beginning-position)) (beginning-of-line)))) -;; prev-sibling: -;; 1. end-of-node before pos -;; 2. highest such node -;; -;; next-sibling: -;; 1. beg-of-node after pos -;; 2. highest such node -;; -;; parent: -;; 1. node covers pos -;; 2. smallest such node +(make-obsolete 'treesit--things-around "`treesit--things-around' will be removed in a few months, use `treesit--thing-prev', `treesit--thing-next', `treesit--thing-at' instead." "30.0.5") (defun treesit--things-around (pos thing) "Return the previous, next, and parent thing around POS. commit e147128f46018199b18c4b4d7919f7f616edb25c Author: Yuan Fu Date: Thu Nov 9 21:09:48 2023 -0800 Replace treesit--things-around with new functions (bug#66989) * lisp/treesit.el (treesit-forward-sexp): Replace things-around with thing-at. (treesit--navigate-thing): Replace things-around with thing-prev/next/at. Also this should fix the problem described in bug#66989. (treesit-thing-at-point): Replace things-around with thing-at. diff --git a/lisp/treesit.el b/lisp/treesit.el index ec3739bd73d..962b957b80c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2061,7 +2061,7 @@ treesit-forward-sexp ;; the obstacle, like `forward-sexp' does. If we couldn't ;; find a parent, we simply return nil without moving point, ;; then functions like `up-list' will signal "at top level". - (when-let* ((parent (nth 2 (treesit--things-around (point) pred))) + (when-let* ((parent (treesit--thing-at (point) pred t)) (boundary (if (> arg 0) (treesit-node-child parent -1) (treesit-node-child parent 0)))) @@ -2115,7 +2115,8 @@ treesit-transpose-sexps ;; - treesit-thing/defun-at-point ;; ;; And more generic functions like: -;; - treesit--things-around +;; - treesit--thing-prev/next +;; - treesit--thing-at ;; - treesit--top-level-thing ;; - treesit--navigate-thing ;; @@ -2124,11 +2125,13 @@ treesit-transpose-sexps ;; ;; TODO: I'm not entirely sure how would this go, so I only documented ;; the "defun" functions and didn't document any "thing" functions. -;; We should also document `treesit-block-type-regexp' and support it -;; in major modes if we can meaningfully integrate hideshow: I tried -;; and failed, we need SomeOne that understands hideshow to look at -;; it. (BTW, hideshow should use its own -;; `treesit-hideshow-block-type-regexp'.) +;; We should also document `treesit-thing-settings'. + +;; TODO: Integration with thing-at-point: once our thing interface is +;; stable. +;; +;; TODO: Integration with hideshow: I tried and failed, we need +;; SomeOne that understands hideshow to look at it. (defvar-local treesit-defun-type-regexp nil "A regexp that matches the node type of defun nodes. @@ -2564,9 +2567,15 @@ treesit--navigate-thing dest))))) (catch 'term (while (> counter 0) - (pcase-let - ((`(,prev ,next ,parent) - (treesit--things-around pos thing))) + (let ((prev (treesit--thing-prev pos thing)) + (next (treesit--thing-next pos thing)) + (parent (treesit--thing-at pos thing t))) + (when (and parent prev + (not (treesit-node-enclosed-p prev parent))) + (setq prev nil)) + (when (and parent next + (not (treesit-node-enclosed-p next parent))) + (setq next nil)) ;; When PARENT is nil, nested and top-level are the same, if ;; there is a PARENT, make PARENT to be the top-level parent ;; and pretend there is no nested PREV and NEXT. @@ -2627,22 +2636,15 @@ treesit--navigate-thing ;; TODO: In corporate into thing-at-point. (defun treesit-thing-at-point (thing tactic) - "Return the thing node at point or nil if none is found. - -\"Thing\" is defined by THING, which can be a regexp, a -predication function, and more, see `treesit-thing-settings' -for details. - -Return the top-level defun if TACTIC is `top-level', return the -immediate parent thing if TACTIC is `nested'." - (pcase-let* ((`(,_ ,next ,parent) - (treesit--things-around (point) thing)) - ;; If point is at the beginning of a thing, we - ;; prioritize that thing over the parent in nested - ;; mode. - (node (or (and (eq (treesit-node-start next) (point)) - next) - parent))) + "Return the THING at point or nil if none is found. + +THING can be a symbol, regexp, a predicate function, and more, +see `treesit-thing-settings' for details. + +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))) (if (eq tactic 'top-level) (treesit-node-top-level node thing t) node))) commit 3ad06ed4f0e6a69ed31ffa7e6aba26b0594763be Author: Yuan Fu Date: Thu Nov 9 20:50:44 2023 -0800 Add treesit thing-at-point functions * lisp/treesit.el (treesit--thing-sibling): (treesit--thing-prev): (treesit--thing-next): (treesit--thing-at): New functions. diff --git a/lisp/treesit.el b/lisp/treesit.el index 826e719172d..ec3739bd73d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2427,6 +2427,77 @@ treesit--things-around (treesit-parent-until cursor iter-pred))) result)) +(defun treesit--thing-sibling (pos thing prev) + "Return the next or previous THING at POS. + +If PREV is non-nil, return the previous THING. It's guaranteed +that returned previous sibling's end <= POS, and returned next +sibling's beginning >= POS. + +Return nil if no THING can be found. THING should be a thing +defined in `treesit-thing-settings', or a predicate as described +in `treesit-thing-settings'." + (let* ((cursor (treesit-node-at pos)) + (pos-pred (if prev + (lambda (n) (<= (treesit-node-end n) pos)) + (lambda (n) (>= (treesit-node-start n) pos)))) + (iter-pred (lambda (node) + (and (treesit-node-match-p node thing t) + (funcall pos-pred node)))) + (sibling nil)) + (when cursor + ;; Find the node just before/after POS to start searching. + (save-excursion + (while (and cursor (not (funcall pos-pred cursor))) + (setq cursor (treesit-search-forward-goto + cursor "" prev prev t)))) + ;; Keep searching until we run out of candidates or found a + ;; return value. + (while (and cursor + (funcall pos-pred cursor) + (null sibling)) + (setq sibling (treesit-node-top-level cursor iter-pred t)) + (setq cursor (treesit-search-forward cursor thing prev prev))) + sibling))) + +(defun treesit--thing-prev (pos thing) + "Return the previous THING at POS. + +The returned node, if non-nil, must be before POS, i.e., its end +<= POS. + +THING should be a thing defined in `treesit-thing-settings', or a +predicate as described in `treesit-thing-settings'." + (treesit--thing-sibling pos thing t)) + +(defun treesit--thing-next (pos thing) + "Return the next THING at POS. + +The returned node, if non-nil, must be after POS, i.e., its +start >= POS. + +THING should be a thing defined in `treesit-thing-settings', or a +predicate as described in `treesit-thing-settings'." + (treesit--thing-sibling pos thing nil)) + +(defun treesit--thing-at (pos thing &optional strict) + "Return the smallest THING enclosing POS. + +The returned node, if non-nil, must enclose POS, i.e., its start +<= POS, its end > POS. If STRICT is non-nil, the returned node's +start must < POS rather than <= POS. + +THING should be a thing defined in `treesit-thing-settings', or +it can be a predicate described in `treesit-thing-settings'." + (let* ((cursor (treesit-node-at pos)) + (iter-pred (lambda (node) + (and (treesit-node-match-p node thing t) + (if strict + (< (treesit-node-start node) pos) + (<= (treesit-node-start node) pos)) + (< pos (treesit-node-end node)))))) + (treesit-parent-until cursor iter-pred t))) + ;; The basic idea for nested defun navigation is that we first try to ;; move across sibling defuns in the same level, if no more siblings ;; exist, we move to parents's beg/end, rinse and repeat. We never commit 0db75b80e1ce54f3597f7d19468157fd5ec2bd71 Author: Yuan Fu Date: Thu Nov 9 20:49:30 2023 -0800 Add treesit-node-enclosed-p * doc/lispref/parsing.texi (Accessing Node Information): Add manual entry. * lisp/treesit.el (treesit-node-enclosed-p): New function. (treesit): Add shortdoc entry. * test/src/treesit-tests.el (treesit-node-api): Add tests. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index bac5a864bf8..df81a805e67 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -705,7 +705,7 @@ Retrieving Nodes To make the syntax tree easier to analyze, many language grammars assign @dfn{field names} to child nodes (@pxref{tree-sitter node field name, field name}). For example, a @code{function_definition} node -could have a @code{declarator} node and a @code{body} node. +could have a @code{declarator} child and a @code{body} child. @defun treesit-node-child-by-field-name node field-name This function finds the child of @var{node} whose field name is @@ -1081,6 +1081,22 @@ Accessing Node Information (@pxref{tree-sitter named node, named node}). @end defun +@heading Convenience functions + +@defun treesit-node-enclosed-p smaller larger &optional strict +This function returns non-@code{nil} if @var{smaller} is enclosed in +@var{larger}. @var{smaller} and @var{larger} can be either a cons +@code{(@var{beg} . @var{end})} or a node. + +Return non-@code{nil} if @var{larger}'s start <= @var{smaller}'s start +and @var{larger}'s end <= @var{smaller}'s end. + +If @var{strict} is @code{t}, compare with < rather than <=. + +If @var{strict} is @code{partial}, consider @var{larger} encloses +@var{smaller} when at least one side is strictly enclosing. +@end defun + @node Pattern Matching @section Pattern Matching Tree-sitter Nodes @cindex pattern matching with tree-sitter nodes diff --git a/lisp/treesit.el b/lisp/treesit.el index e1fcf1a8b04..826e719172d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -439,6 +439,41 @@ treesit-node-get (treesit-node-prev-sibling node named))))))) node) +(defun treesit-node-enclosed-p (smaller larger &optional strict) + "Return non-nil if SMALLER is enclosed in LARGER. +SMALLER and LARGER can be either (BEG . END) or a node. + +Return non-nil if LARGER's start <= SMALLER's start and LARGER's +end <= SMALLER's end. + +If STRICT is t, compare with < rather than <=. + +If STRICT is \\='partial, consider LARGER encloses SMALLER when +at least one side is strictly enclosing." + (unless (and (or (consp larger) (treesit-node-p larger)) + (or (consp smaller) (treesit-node-p smaller))) + (signal 'wrong-type-argument '((or cons treesit-node)))) + (let ((larger-start (if (consp larger) + (car larger) + (treesit-node-start larger))) + (larger-end (if (consp larger) + (cdr larger) + (treesit-node-end larger))) + (smaller-start (if (consp smaller) + (car smaller) + (treesit-node-start smaller))) + (smaller-end (if (consp smaller) + (cdr smaller) + (treesit-node-end smaller)))) + (pcase strict + ('t (and (< larger-start smaller-start) + (< smaller-end larger-end))) + ('partial (and (or (not (eq larger-start smaller-start)) + (not (eq larger-end smaller-end))) + (<= larger-start smaller-start + smaller-end larger-end))) + (_ (<= larger-start smaller-start smaller-end larger-end))))) + ;;; Query API supplement (defun treesit-query-string (string query language) @@ -3523,7 +3558,6 @@ treesit--generate-shortdoc-examples (define-short-documentation-group treesit - "Parsers" (treesit-parser-create :no-eval (treesit-parser-create 'c) @@ -3669,7 +3703,9 @@ treesit (treesit-node-check :no-eval (treesit-node-check node 'named) :eg-result t) - + (treesit-node-enclosed-p + :no-eval (treesit-node-enclosed-p node1 node2) + :no-eval (treesit-node-enclosed-p node1 '(12 . 18))) (treesit-node-field-name-for-child :no-eval (treesit-node-field-name-for-child node) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 4308e4048f6..791e902bd0a 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -166,6 +166,13 @@ treesit-node-api ;; `treesit-node-eq'. (should (treesit-node-eq root-node root-node)) (should (not (treesit-node-eq root-node doc-node))) + ;; `treesit-node-enclosed-p' + (should (treesit-node-enclosed-p '(1 . 3) '(1 . 4))) + (should (treesit-node-enclosed-p '(1 . 3) '(1 . 3))) + (should (not (treesit-node-enclosed-p '(1 . 3) '(1 . 4) t))) + (should (treesit-node-enclosed-p '(1 . 3) '(1 . 4) 'partial)) + (should (treesit-node-enclosed-p '(2 . 3) '(1 . 4) t)) + (should (treesit-node-enclosed-p object-node root-node)) ;; Further test for `treesit-node-check'. (treesit-parser-delete parser) commit 1653389b5744606e04838cdede310ea76fba31f9 Author: Yuan Fu Date: Thu Nov 9 20:09:06 2023 -0800 Add shortdoc for treesit-node-get diff --git a/lisp/treesit.el b/lisp/treesit.el index 3555396390d..e1fcf1a8b04 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3573,6 +3573,9 @@ treesit "Retrieving a node from another node" + (treesit-node-get + :no-eval (treesit-node-get node '((parent 1) (sibling 1) (text))) + :eg-result-string "#") (treesit-node-parent :no-eval (treesit-node-parent node) :eg-result-string "#") commit 9c9b87639f919169eed956e9e7cce472d3a2f719 Author: Andrea Corallo Date: Thu Nov 9 19:12:14 2023 +0100 Clean-up warnings for non native builds (this time for real) * lisp/emacs-lisp/comp.el (comp-native-version-dir) (comp-subr-arities-h, native-comp-eln-load-path) (native-comp-enable-subr-trampolines): Remove warning. (comp--compile-ctxt-to-file, comp--init-ctxt, comp--release-ctxt) (comp-el-to-eln-filename) (comp-el-to-eln-rel-filename, native-elisp-load): Declare. * lisp/emacs-lisp/comp-run.el (comp--no-native-compile) (comp-deferred-pending-h, comp-installed-trampolines-h) (native-comp-enable-subr-trampolines): Remove warning. (comp--install-trampoline, comp-el-to-eln-filename) (native-elisp-load): Declare. * lisp/emacs-lisp/comp-common.el: Update. diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 678f62b60df..6318f2a22e5 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -30,21 +30,8 @@ (eval-when-compile (require 'cl-lib)) ;; These variables and functions are defined in comp.c -(defvar native-comp-enable-subr-trampolines) -(defvar comp-installed-trampolines-h) -(defvar comp-subr-arities-h) -(defvar native-comp-eln-load-path) (defvar comp-native-version-dir) -(defvar comp-deferred-pending-h) -(defvar comp--no-native-compile) - -(declare-function comp-el-to-eln-rel-filename "comp.c") -(declare-function native-elisp-load "comp.c") -(declare-function comp--release-ctxt "comp.c") -(declare-function comp--init-ctxt "comp.c") -(declare-function comp--compile-ctxt-to-file "comp.c") -(declare-function comp-el-to-eln-filename "comp.c") -(declare-function comp--install-trampoline "comp.c") +(defvar native-comp-eln-load-path) (defgroup comp-common nil "Emacs Lisp native compiler common code." diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 87fb46d9aa9..5335003e25b 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -115,6 +115,16 @@ comp-no-spawn (defvar comp-async-compilations (make-hash-table :test #'equal) "Hash table file-name -> async compilation process.") +;; These variables and functions are defined in comp.c +(defvar comp--no-native-compile) +(defvar comp-deferred-pending-h) +(defvar comp-installed-trampolines-h) +(defvar native-comp-enable-subr-trampolines) + +(declare-function comp--install-trampoline "comp.c") +(declare-function comp-el-to-eln-filename "comp.c") +(declare-function native-elisp-load "comp.c") + (defun native-compile-async-skip-p (file load selector) "Return non-nil if FILE's compilation should be skipped. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 81906f3d0e8..73764eb1d79 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -37,6 +37,19 @@ (require 'comp-common) (require 'comp-cstr) +;; These variables and functions are defined in comp.c +(defvar comp-native-version-dir) +(defvar comp-subr-arities-h) +(defvar native-comp-eln-load-path) +(defvar native-comp-enable-subr-trampolines) + +(declare-function comp--compile-ctxt-to-file "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") +(declare-function comp-el-to-eln-rel-filename "comp.c") +(declare-function native-elisp-load "comp.c") + (defgroup comp nil "Emacs Lisp native compiler." :group 'lisp) commit 978ebe8a19914977f3a2d31e9f07a94242d677e6 Author: Juri Linkov Date: Thu Nov 9 18:24:48 2023 +0200 * lisp/minibuffer.el (minibuffer-choose-completion-or-exit): Improve. Use minibuffer-complete-and-exit instead of exit-minibuffer since this is what it's used in the completion minibuffer. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d84e92fc013..3e2e3b6c6f2 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4695,7 +4695,7 @@ minibuffer-choose-completion-or-exit (interactive "P") (condition-case nil (minibuffer-choose-completion no-exit no-quit) - (error (exit-minibuffer)))) + (error (minibuffer-complete-and-exit)))) (defun minibuffer-complete-history () "Complete the minibuffer history as far as possible. commit 6eafdd855948e0e39fcb33fba97c5a2788ac1b07 Author: Juri Linkov Date: Thu Nov 9 18:20:14 2023 +0200 Improve 'next-line-completion' and add more tests * lisp/simple.el (next-line-completion): Improve (bug#59486). Better handle the case when completion-auto-wrap is nil. * test/lisp/minibuffer-tests.el (completion-auto-wrap-test) (completions-header-format-test) (completions-affixation-navigation-test): Add calls to 'next-line-completion' and 'previous-line-completion'. (completions-group-navigation-test): New test. diff --git a/lisp/simple.el b/lisp/simple.el index 266a66500cb..f86b3f9e208 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10051,18 +10051,20 @@ next-line-completion (eq (move-to-column column) column)) (when (get-text-property (point) 'mouse-face) (setq found t))) - (when (and (not found) completion-auto-wrap) - (save-excursion - (goto-char (point-min)) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))) - (while (and (not pos) (> line (line-number-at-pos))) - (forward-line 1) + (when (not found) + (if (not completion-auto-wrap) + (last-completion) + (save-excursion + (goto-char (point-min)) (when (and (eq (move-to-column column) column) (get-text-property (point) 'mouse-face)) - (setq pos (point))))) - (if pos (goto-char pos))) + (setq pos (point))) + (while (and (not pos) (> line (line-number-at-pos))) + (forward-line 1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos)))) (setq n (1- n))) (while (< n 0) @@ -10072,18 +10074,20 @@ next-line-completion (eq (move-to-column column) column)) (when (get-text-property (point) 'mouse-face) (setq found t))) - (when (and (not found) completion-auto-wrap) - (save-excursion - (goto-char (point-max)) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))) - (while (and (not pos) (< line (line-number-at-pos))) - (forward-line -1) + (when (not found) + (if (not completion-auto-wrap) + (first-completion) + (save-excursion + (goto-char (point-max)) (when (and (eq (move-to-column column) column) (get-text-property (point) 'mouse-face)) - (setq pos (point))))) - (if pos (goto-char pos))) + (setq pos (point))) + (while (and (not pos) (< line (line-number-at-pos))) + (forward-line -1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos)))) (setq n (1+ n))))) (defun choose-completion (&optional event no-exit no-quit) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 4f92d7f841c..27d71805502 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -420,6 +420,21 @@ completion-auto-wrap-test (next-completion 5) (should (equal "ac" (get-text-property (point) 'completion--string))) (previous-completion 5) + (should (equal "aa" (get-text-property (point) 'completion--string))) + + (first-completion) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-line-completion 2) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-line-completion 5) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (previous-line-completion 5) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (next-line-completion 5) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (previous-line-completion 5) (should (equal "aa" (get-text-property (point) 'completion--string))))) (let ((completion-auto-wrap t)) (completing-read-with-minibuffer-setup @@ -433,6 +448,21 @@ completion-auto-wrap-test (next-completion 1) (should (equal "aa" (get-text-property (point) 'completion--string))) (previous-completion 1) + (should (equal "ac" (get-text-property (point) 'completion--string))) + + (first-completion) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-line-completion 2) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (next-line-completion 4) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (previous-line-completion 4) (should (equal "ac" (get-text-property (point) 'completion--string)))))) (ert-deftest completions-header-format-test () @@ -454,6 +484,16 @@ completions-header-format-test (should (equal "ac" (get-text-property (point) 'completion--string))) (next-completion 1) (should (equal "aa" (get-text-property (point) 'completion--string))) + + (next-line-completion 2) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (previous-line-completion 2) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa" (get-text-property (point) 'completion--string))) + ;; Fixed in bug#55430 (execute-kbd-macro (kbd "C-u RET")) (should (equal (minibuffer-contents) "aa"))) @@ -488,8 +528,58 @@ completions-affixation-navigation-test ;; Fixed in bug#54374 (goto-char (1- (point-max))) (should-not (equal 'highlight (get-text-property (point) 'mouse-face))) + + (first-completion) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap t)) + (next-line-completion 3)) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap nil)) + (next-line-completion 3)) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (execute-kbd-macro (kbd "C-u RET")) (should (equal (minibuffer-contents) "ac"))))) +(ert-deftest completions-group-navigation-test () + (completing-read-with-minibuffer-setup + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata + (group-function + . ,(lambda (name transform) + (if transform + name + (pcase name + (`"aa" "Group 1") + (`"ab" "Group 2") + (`"ac" "Group 3"))))) + (category . unicode-name)) + (complete-with-action action '("aa" "ab" "ac") string pred))) + (insert "a") + (minibuffer-completion-help) + (switch-to-completions) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap t)) + (next-completion 3)) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap nil)) + (next-completion 3)) + (should (equal "ac" (get-text-property (point) 'completion--string))) + + (first-completion) + (let ((completion-auto-wrap t)) + (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))) + (previous-line-completion 2) + (should (equal "ab" (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)))))) + (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here commit 13a1797d5b69224e97295d85d0c098c96142d238 Author: Andrea Corallo Date: Thu Nov 9 17:00:22 2023 +0100 Clean-up warnings for non native builds * lisp/emacs-lisp/comp-common.el (native-comp-enable-subr-trampolines) (comp-installed-trampolines-h, comp-subr-arities-h) (native-comp-eln-load-path, comp-native-version-dir) (comp-deferred-pending-h, comp--no-native-compile): Silence warning. (comp-el-to-eln-rel-filename, native-elisp-load) (comp--release-ctxt, comp--init-ctxt) (comp--compile-ctxt-to-file, comp-el-to-eln-filename) (comp--install-trampoline): Declare function. * lisp/emacs-lisp/comp.el : Update. diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 32b5d6ba270..678f62b60df 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -29,6 +29,23 @@ (eval-when-compile (require 'cl-lib)) +;; These variables and functions are defined in comp.c +(defvar native-comp-enable-subr-trampolines) +(defvar comp-installed-trampolines-h) +(defvar comp-subr-arities-h) +(defvar native-comp-eln-load-path) +(defvar comp-native-version-dir) +(defvar comp-deferred-pending-h) +(defvar comp--no-native-compile) + +(declare-function comp-el-to-eln-rel-filename "comp.c") +(declare-function native-elisp-load "comp.c") +(declare-function comp--release-ctxt "comp.c") +(declare-function comp--init-ctxt "comp.c") +(declare-function comp--compile-ctxt-to-file "comp.c") +(declare-function comp-el-to-eln-filename "comp.c") +(declare-function comp--install-trampoline "comp.c") + (defgroup comp-common nil "Emacs Lisp native compiler common code." :group 'lisp) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index c0181aa5cf6..81906f3d0e8 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -37,23 +37,6 @@ (require 'comp-common) (require 'comp-cstr) -;; These variables and functions are defined in comp.c -(defvar native-comp-enable-subr-trampolines) -(defvar comp-installed-trampolines-h) -(defvar comp-subr-arities-h) -(defvar native-comp-eln-load-path) -(defvar comp-native-version-dir) -(defvar comp-deferred-pending-h) -(defvar comp--no-native-compile) - -(declare-function comp-el-to-eln-rel-filename "comp.c") -(declare-function native-elisp-load "comp.c") -(declare-function comp--release-ctxt "comp.c") -(declare-function comp--init-ctxt "comp.c") -(declare-function comp--compile-ctxt-to-file "comp.c") -(declare-function comp-el-to-eln-filename "comp.c") -(declare-function comp--install-trampoline "comp.c") - (defgroup comp nil "Emacs Lisp native compiler." :group 'lisp) commit 5d171d26c00aefaef1496dede69337946a1edb14 Author: Andrea Corallo Date: Wed Nov 8 16:36:24 2023 +0100 comp: Don't load.el comp when C-h f * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers) (comp-function-type-spec): Move here. diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 6da2a98c617..32b5d6ba270 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -64,6 +64,345 @@ native-comp-async-env-modifier-form :risky t :version "28.1") +(defconst comp-known-type-specifiers + `( + ;; Functions we can trust not to be redefined, or, if redefined, + ;; to expose the same type. The vast majority of these are + ;; either pure or primitive; the original list is the union of + ;; pure + side-effect-free-fns + side-effect-and-error-free-fns: + (% (function ((or number marker) (or number marker)) number)) + (* (function (&rest (or number marker)) number)) + (+ (function (&rest (or number marker)) number)) + (- (function (&rest (or number marker)) number)) + (/ (function ((or number marker) &rest (or number marker)) number)) + (/= (function ((or number marker) (or number marker)) boolean)) + (1+ (function ((or number marker)) number)) + (1- (function ((or number marker)) number)) + (< (function ((or number marker) &rest (or number marker)) boolean)) + (<= (function ((or number marker) &rest (or number marker)) boolean)) + (= (function ((or number marker) &rest (or number marker)) boolean)) + (> (function ((or number marker) &rest (or number marker)) boolean)) + (>= (function ((or number marker) &rest (or number marker)) boolean)) + (abs (function (number) number)) + (acos (function (number) float)) + (append (function (&rest t) t)) + (aref (function (t fixnum) t)) + (arrayp (function (t) boolean)) + (ash (function (integer integer) integer)) + (asin (function (number) float)) + (assq (function (t list) list)) + (atan (function (number &optional number) float)) + (atom (function (t) boolean)) + (bignump (function (t) boolean)) + (bobp (function () boolean)) + (bolp (function () boolean)) + (bool-vector-count-consecutive + (function (bool-vector boolean integer) fixnum)) + (bool-vector-count-population (function (bool-vector) fixnum)) + (bool-vector-not (function (bool-vector &optional bool-vector) bool-vector)) + (bool-vector-p (function (t) boolean)) + (bool-vector-subsetp (function (bool-vector bool-vector) boolean)) + (boundp (function (symbol) boolean)) + (buffer-end (function ((or number marker)) integer)) + (buffer-file-name (function (&optional buffer) (or string null))) + (buffer-list (function (&optional frame) list)) + (buffer-local-variables (function (&optional buffer) list)) + (buffer-modified-p + (function (&optional buffer) (or boolean (member autosaved)))) + (buffer-size (function (&optional buffer) integer)) + (buffer-string (function () string)) + (buffer-substring + (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))) + (car (function (list) t)) + (car-less-than-car (function (list list) boolean)) + (car-safe (function (t) t)) + (case-table-p (function (t) boolean)) + (cdr (function (list) t)) + (cdr-safe (function (t) t)) + (ceiling (function (number &optional number) integer)) + (char-after (function (&optional (or marker integer)) (or fixnum null))) + (char-before (function (&optional (or marker integer)) (or fixnum null))) + (char-equal (function (integer integer) boolean)) + (char-or-string-p (function (t) boolean)) + (char-to-string (function (fixnum) string)) + (char-width (function (fixnum) fixnum)) + (characterp (function (t &optional t) boolean)) + (charsetp (function (t) boolean)) + (commandp (function (t &optional t) boolean)) + (compare-strings + (function (string (or integer marker null) (or integer marker null) string + (or integer marker null) (or integer marker null) + &optional t) + (or (member t) fixnum))) + (concat (function (&rest sequence) string)) + (cons (function (t t) cons)) + (consp (function (t) boolean)) + (coordinates-in-window-p + (function (cons window) + (or cons null + (member bottom-divider right-divider mode-line header-line + tab-line left-fringe right-fringe vertical-line + left-margin right-margin)))) + (copy-alist (function (list) list)) + (copy-marker (function (&optional (or integer marker) boolean) marker)) + (copy-sequence (function (sequence) sequence)) + (copysign (function (float float) float)) + (cos (function (number) float)) + (count-lines + (function ((or integer marker) (or integer marker) &optional t) integer)) + (current-buffer (function () buffer)) + (current-global-map (function () cons)) + (current-indentation (function () integer)) + (current-local-map (function () (or cons null))) + (current-minor-mode-maps (function () (or cons null))) + (current-time (function () cons)) + (current-time-string (function (&optional (or number list) + (or symbol string cons integer)) + string)) + (current-time-zone (function (&optional (or number list) + (or symbol string cons integer)) + cons)) + (custom-variable-p (function (symbol) t)) + (decode-char (function (cons t) (or fixnum null))) + (decode-time (function (&optional (or number list) + (or symbol string cons integer) + symbol) + cons)) + (default-boundp (function (symbol) boolean)) + (default-value (function (symbol) t)) + (degrees-to-radians (function (number) float)) + (documentation + (function ((or function symbol subr) &optional t) (or null string))) + (downcase (function ((or fixnum string)) (or fixnum string))) + (elt (function (sequence integer) t)) + (encode-char (function (fixnum symbol) (or fixnum null))) + (encode-time (function (cons &rest t) cons)) + (eobp (function () boolean)) + (eolp (function () boolean)) + (eq (function (t t) boolean)) + (eql (function (t t) boolean)) + (equal (function (t t) boolean)) + (error-message-string (function (list) string)) + (eventp (function (t) boolean)) + (exp (function (number) float)) + (expt (function (number number) number)) + (fboundp (function (symbol) boolean)) + (fceiling (function (float) float)) + (featurep (function (symbol &optional symbol) boolean)) + (ffloor (function (float) float)) + (file-directory-p (function (string) boolean)) + (file-exists-p (function (string) boolean)) + (file-locked-p (function (string) (or boolean string))) + (file-name-absolute-p (function (string) boolean)) + (file-newer-than-file-p (function (string string) boolean)) + (file-readable-p (function (string) boolean)) + (file-symlink-p (function (string) (or boolean string))) + (file-writable-p (function (string) boolean)) + (fixnump (function (t) boolean)) + (float (function (number) float)) + (float-time (function (&optional (or number list)) float)) + (floatp (function (t) boolean)) + (floor (function (number &optional number) integer)) + (following-char (function () fixnum)) + (format (function (string &rest t) string)) + (format-time-string (function (string &optional (or number list) + (or symbol string cons integer)) + string)) + (frame-first-window (function ((or frame window)) window)) + (frame-root-window (function (&optional (or frame window)) window)) + (frame-selected-window (function (&optional (or frame window)) window)) + (frame-visible-p (function (frame) (or boolean (member icon)))) + (framep (function (t) symbol)) + (fround (function (float) float)) + (ftruncate (function (float) float)) + (get (function (symbol symbol) t)) + (get-buffer (function ((or buffer string)) (or buffer null))) + (get-buffer-window + (function (&optional (or buffer string) (or symbol (integer 0 0))) + (or null window))) + (get-file-buffer (function (string) (or null buffer))) + (get-largest-window (function (&optional t t t) (or window null))) + (get-lru-window (function (&optional t t t) (or window null))) + (getenv (function (string &optional frame) (or null string))) + (gethash (function (t hash-table &optional t) t)) + (hash-table-count (function (hash-table) integer)) + (hash-table-p (function (t) boolean)) + (identity (function (t) t)) + (ignore (function (&rest t) null)) + (int-to-string (function (number) string)) + (integer-or-marker-p (function (t) boolean)) + (integerp (function (t) boolean)) + (interactive-p (function () boolean)) + (intern-soft (function ((or string symbol) &optional vector) symbol)) + (invocation-directory (function () string)) + (invocation-name (function () string)) + (isnan (function (float) boolean)) + (keymap-parent (function (cons) (or cons null))) + (keymapp (function (t) boolean)) + (keywordp (function (t) boolean)) + (last (function (list &optional integer) list)) + (lax-plist-get (function (list t) t)) + (ldexp (function (number integer) float)) + (length (function (t) (integer 0 *))) + (length< (function (sequence fixnum) boolean)) + (length= (function (sequence fixnum) boolean)) + (length> (function (sequence fixnum) boolean)) + (line-beginning-position (function (&optional integer) integer)) + (line-end-position (function (&optional integer) integer)) + (list (function (&rest t) list)) + (listp (function (t) boolean)) + (local-variable-if-set-p (function (symbol &optional buffer) boolean)) + (local-variable-p (function (symbol &optional buffer) boolean)) + (locale-info (function ((member codeset days months paper)) (or null string))) + (log (function (number number) float)) + (log10 (function (number) float)) + (logand (function (&rest (or integer marker)) integer)) + (logb (function (number) integer)) + (logcount (function (integer) integer)) + (logior (function (&rest (or integer marker)) integer)) + (lognot (function (integer) integer)) + (logxor (function (&rest (or integer marker)) integer)) + ;; (lsh (function ((integer ,most-negative-fixnum *) integer) integer)) ? + (lsh (function (integer integer) integer)) + (make-byte-code + (function ((or fixnum list) string vector integer &optional string t + &rest t) + vector)) + (make-list (function (integer t) list)) + (make-marker (function () marker)) + (make-string (function (integer fixnum &optional t) string)) + (make-symbol (function (string) symbol)) + (mark (function (&optional t) (or integer null))) + (mark-marker (function () marker)) + (marker-buffer (function (marker) (or buffer null))) + (markerp (function (t) boolean)) + (max (function ((or number marker) &rest (or number marker)) number)) + (max-char (function (&optional t) fixnum)) + (member (function (t list) list)) + (memory-limit (function () integer)) + (memq (function (t list) list)) + (memql (function (t list) list)) + (min (function ((or number marker) &rest (or number marker)) number)) + (minibuffer-selected-window (function () (or window null))) + (minibuffer-window (function (&optional frame) window)) + (mod + (function ((or number marker) (or number marker)) + (or (integer 0 *) (float 0 *)))) + (mouse-movement-p (function (t) boolean)) + (multibyte-char-to-unibyte (function (fixnum) fixnum)) + (natnump (function (t) boolean)) + (next-window (function (&optional window t t) window)) + (nlistp (function (t) boolean)) + (not (function (t) boolean)) + (nth (function (integer list) t)) + (nthcdr (function (integer t) t)) + (null (function (t) boolean)) + (number-or-marker-p (function (t) boolean)) + (number-to-string (function (number) string)) + (numberp (function (t) boolean)) + (one-window-p (function (&optional t t) boolean)) + (overlayp (function (t) boolean)) + (parse-colon-path (function (string) cons)) + (plist-get (function (list t &optional t) t)) + (plist-member (function (list t &optional t) list)) + (point (function () integer)) + (point-marker (function () marker)) + (point-max (function () integer)) + (point-min (function () integer)) + (preceding-char (function () fixnum)) + (previous-window (function (&optional window t t) window)) + (prin1-to-string (function (t &optional t t) string)) + (processp (function (t) boolean)) + (proper-list-p (function (t) (or fixnum null))) + (propertize (function (string &rest t) string)) + (radians-to-degrees (function (number) float)) + (rassoc (function (t list) list)) + (rassq (function (t list) list)) + (read-from-string (function (string &optional integer integer) cons)) + (recent-keys (function (&optional (or cons null)) vector)) + (recursion-depth (function () integer)) + (regexp-opt (function (list) string)) + (regexp-quote (function (string) string)) + (region-beginning (function () integer)) + (region-end (function () integer)) + (reverse (function (sequence) sequence)) + (round (function (number &optional number) integer)) + (safe-length (function (t) integer)) + (selected-frame (function () frame)) + (selected-window (function () window)) + (sequencep (function (t) boolean)) + (sin (function (number) float)) + (sqrt (function (number) float)) + (standard-case-table (function () char-table)) + (standard-syntax-table (function () char-table)) + (string (function (&rest fixnum) string)) + (string-as-multibyte (function (string) string)) + (string-as-unibyte (function (string) string)) + (string-equal (function ((or string symbol) (or string symbol)) boolean)) + (string-lessp (function ((or string symbol) (or string symbol)) boolean)) + (string-make-multibyte (function (string) string)) + (string-make-unibyte (function (string) string)) + (string-search (function (string string &optional integer) (or integer null))) + (string-to-char (function (string) fixnum)) + (string-to-multibyte (function (string) string)) + (string-to-number (function (string &optional integer) number)) + (string-to-syntax (function (string) (or cons null))) + (string< (function ((or string symbol) (or string symbol)) boolean)) + (string= (function ((or string symbol) (or string symbol)) boolean)) + (stringp (function (t) boolean)) + (subrp (function (t) boolean)) + (substring + (function ((or string vector) &optional integer integer) (or string vector))) + (sxhash (function (t) integer)) + (sxhash-eq (function (t) integer)) + (sxhash-eql (function (t) integer)) + (sxhash-equal (function (t) integer)) + (symbol-function (function (symbol) t)) + (symbol-name (function (symbol) string)) + (symbol-plist (function (symbol) list)) + (symbol-value (function (symbol) t)) + (symbolp (function (t) boolean)) + (syntax-table (function () char-table)) + (syntax-table-p (function (t) boolean)) + (tan (function (number) float)) + (this-command-keys (function () string)) + (this-command-keys-vector (function () vector)) + (this-single-command-keys (function () vector)) + (this-single-command-raw-keys (function () vector)) + (time-convert (function ((or number list) &optional (or symbol integer)) + (or cons number))) + (truncate (function (number &optional number) integer)) + (type-of (function (t) symbol)) + (unibyte-char-to-multibyte (function (fixnum) fixnum)) ;; byte is fixnum + (upcase (function ((or fixnum string)) (or fixnum string))) + (user-full-name (function (&optional integer) (or string null))) + (user-login-name (function (&optional integer) (or string null))) + (user-original-login-name (function (&optional integer) (or string null))) + (user-real-login-name (function () string)) + (user-real-uid (function () integer)) + (user-uid (function () integer)) + (vconcat (function (&rest sequence) vector)) + (vector (function (&rest t) vector)) + (vectorp (function (t) boolean)) + (visible-frame-list (function () list)) + (wholenump (function (t) boolean)) + (window-configuration-p (function (t) boolean)) + (window-live-p (function (t) boolean)) + (window-valid-p (function (t) boolean)) + (windowp (function (t) boolean)) + (zerop (function (number) boolean)) + ;; Type hints + (comp-hint-fixnum (function (t) fixnum)) + (comp-hint-cons (function (t) cons)) + ;; Non returning functions + (throw (function (t t) nil)) + (error (function (string &rest t) nil)) + (signal (function (symbol t) nil))) + "Alist used for type propagation.") + (defconst comp-limple-calls '(call callref direct-call @@ -182,6 +521,29 @@ comp-eln-load-path-eff (expand-file-name dir invocation-directory)))) native-comp-eln-load-path)) +;;;###autoload +(defun comp-function-type-spec (function) + "Return the type specifier of FUNCTION. + +This function returns a cons cell whose car is the function +specifier, and cdr is a symbol, either `inferred' or `know'. +If the symbol is `inferred', the type specifier is automatically +inferred from the code itself by the native compiler; if it is +`know', the type specifier comes from `comp-known-type-specifiers'." + (let ((kind 'know) + type-spec ) + (when-let ((res (assoc function comp-known-type-specifiers))) + (setf type-spec (cadr res))) + (let ((f (and (symbolp function) + (symbol-function function)))) + (when (and f + (null type-spec) + (subr-native-elisp-p f)) + (setf kind 'inferred + type-spec (subr-type f)))) + (when type-spec + (cons type-spec kind)))) + (provide 'comp-common) ;;; comp-common.el ends here diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 017af49b658..c0181aa5cf6 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -181,346 +181,6 @@ comp-post-pass-hooks Each function in FUNCTIONS is run after PASS. Useful to hook into pass checkers.") -;; FIXME this probably should not be here but... good for now. -(defconst comp-known-type-specifiers - `( - ;; Functions we can trust not to be redefined, or, if redefined, - ;; to expose the same type. The vast majority of these are - ;; either pure or primitive; the original list is the union of - ;; pure + side-effect-free-fns + side-effect-and-error-free-fns: - (% (function ((or number marker) (or number marker)) number)) - (* (function (&rest (or number marker)) number)) - (+ (function (&rest (or number marker)) number)) - (- (function (&rest (or number marker)) number)) - (/ (function ((or number marker) &rest (or number marker)) number)) - (/= (function ((or number marker) (or number marker)) boolean)) - (1+ (function ((or number marker)) number)) - (1- (function ((or number marker)) number)) - (< (function ((or number marker) &rest (or number marker)) boolean)) - (<= (function ((or number marker) &rest (or number marker)) boolean)) - (= (function ((or number marker) &rest (or number marker)) boolean)) - (> (function ((or number marker) &rest (or number marker)) boolean)) - (>= (function ((or number marker) &rest (or number marker)) boolean)) - (abs (function (number) number)) - (acos (function (number) float)) - (append (function (&rest t) t)) - (aref (function (t fixnum) t)) - (arrayp (function (t) boolean)) - (ash (function (integer integer) integer)) - (asin (function (number) float)) - (assq (function (t list) list)) - (atan (function (number &optional number) float)) - (atom (function (t) boolean)) - (bignump (function (t) boolean)) - (bobp (function () boolean)) - (bolp (function () boolean)) - (bool-vector-count-consecutive - (function (bool-vector boolean integer) fixnum)) - (bool-vector-count-population (function (bool-vector) fixnum)) - (bool-vector-not (function (bool-vector &optional bool-vector) bool-vector)) - (bool-vector-p (function (t) boolean)) - (bool-vector-subsetp (function (bool-vector bool-vector) boolean)) - (boundp (function (symbol) boolean)) - (buffer-end (function ((or number marker)) integer)) - (buffer-file-name (function (&optional buffer) (or string null))) - (buffer-list (function (&optional frame) list)) - (buffer-local-variables (function (&optional buffer) list)) - (buffer-modified-p - (function (&optional buffer) (or boolean (member autosaved)))) - (buffer-size (function (&optional buffer) integer)) - (buffer-string (function () string)) - (buffer-substring - (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))) - (car (function (list) t)) - (car-less-than-car (function (list list) boolean)) - (car-safe (function (t) t)) - (case-table-p (function (t) boolean)) - (cdr (function (list) t)) - (cdr-safe (function (t) t)) - (ceiling (function (number &optional number) integer)) - (char-after (function (&optional (or marker integer)) (or fixnum null))) - (char-before (function (&optional (or marker integer)) (or fixnum null))) - (char-equal (function (integer integer) boolean)) - (char-or-string-p (function (t) boolean)) - (char-to-string (function (fixnum) string)) - (char-width (function (fixnum) fixnum)) - (characterp (function (t &optional t) boolean)) - (charsetp (function (t) boolean)) - (commandp (function (t &optional t) boolean)) - (compare-strings - (function (string (or integer marker null) (or integer marker null) string - (or integer marker null) (or integer marker null) - &optional t) - (or (member t) fixnum))) - (concat (function (&rest sequence) string)) - (cons (function (t t) cons)) - (consp (function (t) boolean)) - (coordinates-in-window-p - (function (cons window) - (or cons null - (member bottom-divider right-divider mode-line header-line - tab-line left-fringe right-fringe vertical-line - left-margin right-margin)))) - (copy-alist (function (list) list)) - (copy-marker (function (&optional (or integer marker) boolean) marker)) - (copy-sequence (function (sequence) sequence)) - (copysign (function (float float) float)) - (cos (function (number) float)) - (count-lines - (function ((or integer marker) (or integer marker) &optional t) integer)) - (current-buffer (function () buffer)) - (current-global-map (function () cons)) - (current-indentation (function () integer)) - (current-local-map (function () (or cons null))) - (current-minor-mode-maps (function () (or cons null))) - (current-time (function () cons)) - (current-time-string (function (&optional (or number list) - (or symbol string cons integer)) - string)) - (current-time-zone (function (&optional (or number list) - (or symbol string cons integer)) - cons)) - (custom-variable-p (function (symbol) t)) - (decode-char (function (cons t) (or fixnum null))) - (decode-time (function (&optional (or number list) - (or symbol string cons integer) - symbol) - cons)) - (default-boundp (function (symbol) boolean)) - (default-value (function (symbol) t)) - (degrees-to-radians (function (number) float)) - (documentation - (function ((or function symbol subr) &optional t) (or null string))) - (downcase (function ((or fixnum string)) (or fixnum string))) - (elt (function (sequence integer) t)) - (encode-char (function (fixnum symbol) (or fixnum null))) - (encode-time (function (cons &rest t) cons)) - (eobp (function () boolean)) - (eolp (function () boolean)) - (eq (function (t t) boolean)) - (eql (function (t t) boolean)) - (equal (function (t t) boolean)) - (error-message-string (function (list) string)) - (eventp (function (t) boolean)) - (exp (function (number) float)) - (expt (function (number number) number)) - (fboundp (function (symbol) boolean)) - (fceiling (function (float) float)) - (featurep (function (symbol &optional symbol) boolean)) - (ffloor (function (float) float)) - (file-directory-p (function (string) boolean)) - (file-exists-p (function (string) boolean)) - (file-locked-p (function (string) (or boolean string))) - (file-name-absolute-p (function (string) boolean)) - (file-newer-than-file-p (function (string string) boolean)) - (file-readable-p (function (string) boolean)) - (file-symlink-p (function (string) (or boolean string))) - (file-writable-p (function (string) boolean)) - (fixnump (function (t) boolean)) - (float (function (number) float)) - (float-time (function (&optional (or number list)) float)) - (floatp (function (t) boolean)) - (floor (function (number &optional number) integer)) - (following-char (function () fixnum)) - (format (function (string &rest t) string)) - (format-time-string (function (string &optional (or number list) - (or symbol string cons integer)) - string)) - (frame-first-window (function ((or frame window)) window)) - (frame-root-window (function (&optional (or frame window)) window)) - (frame-selected-window (function (&optional (or frame window)) window)) - (frame-visible-p (function (frame) (or boolean (member icon)))) - (framep (function (t) symbol)) - (fround (function (float) float)) - (ftruncate (function (float) float)) - (get (function (symbol symbol) t)) - (get-buffer (function ((or buffer string)) (or buffer null))) - (get-buffer-window - (function (&optional (or buffer string) (or symbol (integer 0 0))) - (or null window))) - (get-file-buffer (function (string) (or null buffer))) - (get-largest-window (function (&optional t t t) (or window null))) - (get-lru-window (function (&optional t t t) (or window null))) - (getenv (function (string &optional frame) (or null string))) - (gethash (function (t hash-table &optional t) t)) - (hash-table-count (function (hash-table) integer)) - (hash-table-p (function (t) boolean)) - (identity (function (t) t)) - (ignore (function (&rest t) null)) - (int-to-string (function (number) string)) - (integer-or-marker-p (function (t) boolean)) - (integerp (function (t) boolean)) - (interactive-p (function () boolean)) - (intern-soft (function ((or string symbol) &optional vector) symbol)) - (invocation-directory (function () string)) - (invocation-name (function () string)) - (isnan (function (float) boolean)) - (keymap-parent (function (cons) (or cons null))) - (keymapp (function (t) boolean)) - (keywordp (function (t) boolean)) - (last (function (list &optional integer) list)) - (lax-plist-get (function (list t) t)) - (ldexp (function (number integer) float)) - (length (function (t) (integer 0 *))) - (length< (function (sequence fixnum) boolean)) - (length= (function (sequence fixnum) boolean)) - (length> (function (sequence fixnum) boolean)) - (line-beginning-position (function (&optional integer) integer)) - (line-end-position (function (&optional integer) integer)) - (list (function (&rest t) list)) - (listp (function (t) boolean)) - (local-variable-if-set-p (function (symbol &optional buffer) boolean)) - (local-variable-p (function (symbol &optional buffer) boolean)) - (locale-info (function ((member codeset days months paper)) (or null string))) - (log (function (number number) float)) - (log10 (function (number) float)) - (logand (function (&rest (or integer marker)) integer)) - (logb (function (number) integer)) - (logcount (function (integer) integer)) - (logior (function (&rest (or integer marker)) integer)) - (lognot (function (integer) integer)) - (logxor (function (&rest (or integer marker)) integer)) - ;; (lsh (function ((integer ,most-negative-fixnum *) integer) integer)) ? - (lsh (function (integer integer) integer)) - (make-byte-code - (function ((or fixnum list) string vector integer &optional string t - &rest t) - vector)) - (make-list (function (integer t) list)) - (make-marker (function () marker)) - (make-string (function (integer fixnum &optional t) string)) - (make-symbol (function (string) symbol)) - (mark (function (&optional t) (or integer null))) - (mark-marker (function () marker)) - (marker-buffer (function (marker) (or buffer null))) - (markerp (function (t) boolean)) - (max (function ((or number marker) &rest (or number marker)) number)) - (max-char (function (&optional t) fixnum)) - (member (function (t list) list)) - (memory-limit (function () integer)) - (memq (function (t list) list)) - (memql (function (t list) list)) - (min (function ((or number marker) &rest (or number marker)) number)) - (minibuffer-selected-window (function () (or window null))) - (minibuffer-window (function (&optional frame) window)) - (mod - (function ((or number marker) (or number marker)) - (or (integer 0 *) (float 0 *)))) - (mouse-movement-p (function (t) boolean)) - (multibyte-char-to-unibyte (function (fixnum) fixnum)) - (natnump (function (t) boolean)) - (next-window (function (&optional window t t) window)) - (nlistp (function (t) boolean)) - (not (function (t) boolean)) - (nth (function (integer list) t)) - (nthcdr (function (integer t) t)) - (null (function (t) boolean)) - (number-or-marker-p (function (t) boolean)) - (number-to-string (function (number) string)) - (numberp (function (t) boolean)) - (one-window-p (function (&optional t t) boolean)) - (overlayp (function (t) boolean)) - (parse-colon-path (function (string) cons)) - (plist-get (function (list t &optional t) t)) - (plist-member (function (list t &optional t) list)) - (point (function () integer)) - (point-marker (function () marker)) - (point-max (function () integer)) - (point-min (function () integer)) - (preceding-char (function () fixnum)) - (previous-window (function (&optional window t t) window)) - (prin1-to-string (function (t &optional t t) string)) - (processp (function (t) boolean)) - (proper-list-p (function (t) (or fixnum null))) - (propertize (function (string &rest t) string)) - (radians-to-degrees (function (number) float)) - (rassoc (function (t list) list)) - (rassq (function (t list) list)) - (read-from-string (function (string &optional integer integer) cons)) - (recent-keys (function (&optional (or cons null)) vector)) - (recursion-depth (function () integer)) - (regexp-opt (function (list) string)) - (regexp-quote (function (string) string)) - (region-beginning (function () integer)) - (region-end (function () integer)) - (reverse (function (sequence) sequence)) - (round (function (number &optional number) integer)) - (safe-length (function (t) integer)) - (selected-frame (function () frame)) - (selected-window (function () window)) - (sequencep (function (t) boolean)) - (sin (function (number) float)) - (sqrt (function (number) float)) - (standard-case-table (function () char-table)) - (standard-syntax-table (function () char-table)) - (string (function (&rest fixnum) string)) - (string-as-multibyte (function (string) string)) - (string-as-unibyte (function (string) string)) - (string-equal (function ((or string symbol) (or string symbol)) boolean)) - (string-lessp (function ((or string symbol) (or string symbol)) boolean)) - (string-make-multibyte (function (string) string)) - (string-make-unibyte (function (string) string)) - (string-search (function (string string &optional integer) (or integer null))) - (string-to-char (function (string) fixnum)) - (string-to-multibyte (function (string) string)) - (string-to-number (function (string &optional integer) number)) - (string-to-syntax (function (string) (or cons null))) - (string< (function ((or string symbol) (or string symbol)) boolean)) - (string= (function ((or string symbol) (or string symbol)) boolean)) - (stringp (function (t) boolean)) - (subrp (function (t) boolean)) - (substring - (function ((or string vector) &optional integer integer) (or string vector))) - (sxhash (function (t) integer)) - (sxhash-eq (function (t) integer)) - (sxhash-eql (function (t) integer)) - (sxhash-equal (function (t) integer)) - (symbol-function (function (symbol) t)) - (symbol-name (function (symbol) string)) - (symbol-plist (function (symbol) list)) - (symbol-value (function (symbol) t)) - (symbolp (function (t) boolean)) - (syntax-table (function () char-table)) - (syntax-table-p (function (t) boolean)) - (tan (function (number) float)) - (this-command-keys (function () string)) - (this-command-keys-vector (function () vector)) - (this-single-command-keys (function () vector)) - (this-single-command-raw-keys (function () vector)) - (time-convert (function ((or number list) &optional (or symbol integer)) - (or cons number))) - (truncate (function (number &optional number) integer)) - (type-of (function (t) symbol)) - (unibyte-char-to-multibyte (function (fixnum) fixnum)) ;; byte is fixnum - (upcase (function ((or fixnum string)) (or fixnum string))) - (user-full-name (function (&optional integer) (or string null))) - (user-login-name (function (&optional integer) (or string null))) - (user-original-login-name (function (&optional integer) (or string null))) - (user-real-login-name (function () string)) - (user-real-uid (function () integer)) - (user-uid (function () integer)) - (vconcat (function (&rest sequence) vector)) - (vector (function (&rest t) vector)) - (vectorp (function (t) boolean)) - (visible-frame-list (function () list)) - (wholenump (function (t) boolean)) - (window-configuration-p (function (t) boolean)) - (window-live-p (function (t) boolean)) - (window-valid-p (function (t) boolean)) - (windowp (function (t) boolean)) - (zerop (function (number) boolean)) - ;; Type hints - (comp-hint-fixnum (function (t) fixnum)) - (comp-hint-cons (function (t) cons)) - ;; Non returning functions - (throw (function (t t) nil)) - (error (function (string &rest t) nil)) - (signal (function (symbol t) nil))) - "Alist used for type propagation.") - (defconst comp-known-func-cstr-h (cl-loop with comp-ctxt = (make-comp-cstr-ctxt) @@ -3892,29 +3552,6 @@ native-compile-prune-cache (delete-directory subdir)))))) (message "Cache cleared")) -;;;###autoload -(defun comp-function-type-spec (function) - "Return the type specifier of FUNCTION. - -This function returns a cons cell whose car is the function -specifier, and cdr is a symbol, either `inferred' or `know'. -If the symbol is `inferred', the type specifier is automatically -inferred from the code itself by the native compiler; if it is -`know', the type specifier comes from `comp-known-type-specifiers'." - (let ((kind 'know) - type-spec ) - (when-let ((res (gethash function comp-known-func-cstr-h))) - (setf type-spec (comp-cstr-to-type-spec res))) - (let ((f (and (symbolp function) - (symbol-function function)))) - (when (and f - (null type-spec) - (subr-native-elisp-p f)) - (setf kind 'inferred - type-spec (subr-type f)))) - (when type-spec - (cons type-spec kind)))) - (provide 'comp) ;; LocalWords: limplified limplification limplify Limple LIMPLE libgccjit elc eln commit c559f4e36827bd6c1e10e0cb15b0e58a5fdbc59e Author: Andrea Corallo Date: Wed Nov 8 16:19:18 2023 +0100 comp: Add comp-common.el * lisp/emacs-lisp/comp-common.el: New file. (comp-common): New group. (native-comp-verbose, native-comp-never-optimize-functions) (native-comp-async-env-modifier-form, comp-limple-calls) (comp-limple-sets, comp-limple-assignments) (comp-limple-branches, comp-limple-ops) (comp-limple-lock-keywords, comp-log-buffer-name, comp-log) (native-comp-limple-mode, comp-log-to-buffer) (comp-ensure-native-compiler, comp-trampoline-filename) (comp-eln-load-path-eff): Move here * lisp/emacs-lisp/comp-run.el (comp-common): Require. * lisp/emacs-lisp/comp.el (comp-common): Require. * admin/MAINTAINERS: Add comp-common.el * lisp/Makefile.in (COMPILE_FIRST): Likewise. * src/Makefile.in (elnlisp): Likewise. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index fbb89f66006..f59c684e81f 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -133,6 +133,7 @@ Andrea Corallo Lisp native compiler src/comp.c lisp/emacs-lisp/comp.el + lisp/emacs-lisp/comp-common.el lisp/emacs-lisp/comp-run.el lisp/emacs-lisp/comp-cstr.el test/src/comp-*.el diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 446af922d34..0059305cc80 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -95,6 +95,7 @@ COMPILE_FIRST = ifeq ($(HAVE_NATIVE_COMP),yes) COMPILE_FIRST += $(lisp)/emacs-lisp/comp.elc COMPILE_FIRST += $(lisp)/emacs-lisp/comp-cstr.elc +COMPILE_FIRST += $(lisp)/emacs-lisp/comp-common.elc COMPILE_FIRST += $(lisp)/emacs-lisp/comp-run.elc endif COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el new file mode 100644 index 00000000000..6da2a98c617 --- /dev/null +++ b/lisp/emacs-lisp/comp-common.el @@ -0,0 +1,187 @@ +;;; comp-common.el --- common code -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Andrea Corallo +;; Keywords: lisp +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file holds common code required by comp.el and comp-run.el. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) + +(defgroup comp-common nil + "Emacs Lisp native compiler common code." + :group 'lisp) + +(defcustom native-comp-verbose 0 + "Compiler verbosity for native compilation, a number between 0 and 3. +This is intended for debugging the compiler itself. + 0 no logging. + 1 final LIMPLE is logged. + 2 LAP, final LIMPLE, and some pass info are logged. + 3 max verbosity." + :type 'natnum + :risky t + :version "28.1") + +(defcustom native-comp-never-optimize-functions + '(;; The following two are mandatory for Emacs to be working + ;; correctly (see comment in `advice--add-function'). DO NOT + ;; REMOVE. + macroexpand rename-buffer) + "Primitive functions to exclude from trampoline optimization. + +Primitive functions included in this list will not be called +directly by the natively-compiled code, which makes trampolines for +those primitives unnecessary in case of function redefinition/advice." + :type '(repeat symbol) + :version "28.1") + +(defcustom native-comp-async-env-modifier-form nil + "Form evaluated before compilation by each asynchronous compilation subprocess. +Used to modify the compiler environment." + :type 'sexp + :risky t + :version "28.1") + +(defconst comp-limple-calls '(call + callref + direct-call + direct-callref) + "Limple operators used to call subrs.") + +(defconst comp-limple-sets '(set + setimm + set-par-to-local + set-args-to-local + set-rest-args-to-local) + "Limple set operators.") + +(defconst comp-limple-assignments `(assume + fetch-handler + ,@comp-limple-sets) + "Limple operators that clobber the first m-var argument.") + +(defconst comp-limple-branches '(jump cond-jump) + "Limple operators used for conditional and unconditional branches.") + +(defconst comp-limple-ops `(,@comp-limple-calls + ,@comp-limple-assignments + ,@comp-limple-branches + return) + "All Limple operators.") + +(defconst comp-limple-lock-keywords + `((,(rx bol "(comment" (1+ not-newline)) . font-lock-comment-face) + (,(rx "#(" (group-n 1 "mvar")) + (1 font-lock-function-name-face)) + (,(rx bol "(" (group-n 1 "phi")) + (1 font-lock-variable-name-face)) + (,(rx bol "(" (group-n 1 (or "return" "unreachable"))) + (1 font-lock-warning-face)) + (,(rx (group-n 1 (or "entry" + (seq (or "entry_" "entry_fallback_" "bb_") + (1+ num) (? (or "_latch" + (seq "_cstrs_" (1+ num)))))))) + (1 font-lock-constant-face)) + (,(rx-to-string + `(seq "(" (group-n 1 (or ,@(mapcar #'symbol-name comp-limple-ops))))) + (1 font-lock-keyword-face))) + "Highlights used by `native-comp-limple-mode'.") + +(defconst comp-log-buffer-name "*Native-compile-Log*" + "Name of the native-compiler log buffer.") + +(cl-defun comp-log (data &optional (level 1) quoted) + "Log DATA at LEVEL. +LEVEL is a number from 1-3, and defaults to 1; if it is less +than `native-comp-verbose', do nothing. If `noninteractive', log +with `message'. Otherwise, log with `comp-log-to-buffer'." + (when (>= native-comp-verbose level) + (if noninteractive + (cl-typecase data + (atom (message "%s" data)) + (t (dolist (elem data) + (message "%s" elem)))) + (comp-log-to-buffer data quoted)))) + +(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE" + "Syntax-highlight LIMPLE IR." + (setf font-lock-defaults '(comp-limple-lock-keywords))) + +(cl-defun comp-log-to-buffer (data &optional quoted) + "Log DATA to `comp-log-buffer-name'." + (let* ((print-f (if quoted #'prin1 #'princ)) + (log-buffer + (or (get-buffer comp-log-buffer-name) + (with-current-buffer (get-buffer-create comp-log-buffer-name) + (unless (derived-mode-p 'compilation-mode) + (emacs-lisp-compilation-mode)) + (current-buffer)))) + (log-window (get-buffer-window log-buffer)) + (inhibit-read-only t) + at-end-p) + (with-current-buffer log-buffer + (unless (eq major-mode 'native-comp-limple-mode) + (native-comp-limple-mode)) + (when (= (point) (point-max)) + (setf at-end-p t)) + (save-excursion + (goto-char (point-max)) + (cl-typecase data + (atom (funcall print-f data log-buffer)) + (t (dolist (elem data) + (funcall print-f elem log-buffer) + (insert "\n")))) + (insert "\n")) + (when (and at-end-p log-window) + ;; When log window's point is at the end, follow the tail. + (with-selected-window log-window + (goto-char (point-max))))))) + +(defun comp-ensure-native-compiler () + "Make sure Emacs has native compiler support and libgccjit can be loaded. +Signal an error otherwise. +To be used by all entry points." + (cond + ((null (featurep 'native-compile)) + (error "Emacs was not compiled with native compiler support (--with-native-compilation)")) + ((null (native-comp-available-p)) + (error "Cannot find libgccjit library")))) + +(defun comp-trampoline-filename (subr-name) + "Given SUBR-NAME return the filename containing the trampoline." + (concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln")) + +(defun comp-eln-load-path-eff () + "Return a list of effective eln load directories. +Account for `native-comp-eln-load-path' and `comp-native-version-dir'." + (mapcar (lambda (dir) + (expand-file-name comp-native-version-dir + (file-name-as-directory + (expand-file-name dir invocation-directory)))) + native-comp-eln-load-path)) + +(provide 'comp-common) + +;;; comp-common.el ends here diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 512cadf4cab..87fb46d9aa9 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -32,6 +32,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'comp-common) (defgroup comp-run nil "Emacs Lisp native compiler runtime." @@ -96,13 +97,6 @@ native-comp-async-all-done-hook :type 'hook :version "28.1") -(defcustom native-comp-async-env-modifier-form nil - "Form evaluated before compilation by each asynchronous compilation subprocess. -Used to modify the compiler environment." - :type 'sexp - :risky t - :version "28.1") - (defcustom native-comp-async-query-on-exit nil "Whether to query the user about killing async compilations when exiting. If this is non-nil, Emacs will ask for confirmation to exit and kill the @@ -112,33 +106,6 @@ native-comp-async-query-on-exit :type 'boolean :version "28.1") -(defcustom native-comp-verbose 0 - "Compiler verbosity for native compilation, a number between 0 and 3. -This is intended for debugging the compiler itself. - 0 no logging. - 1 final LIMPLE is logged. - 2 LAP, final LIMPLE, and some pass info are logged. - 3 max verbosity." - :type 'natnum - :risky t - :version "28.1") - -(defcustom native-comp-never-optimize-functions - '(;; The following two are mandatory for Emacs to be working - ;; correctly (see comment in `advice--add-function'). DO NOT - ;; REMOVE. - macroexpand rename-buffer) - "Primitive functions to exclude from trampoline optimization. - -Primitive functions included in this list will not be called -directly by the natively-compiled code, which makes trampolines for -those primitives unnecessary in case of function redefinition/advice." - :type '(repeat symbol) - :version "28.1") - -(defconst comp-log-buffer-name "*Native-compile-Log*" - "Name of the native-compiler log buffer.") - (defconst comp-async-buffer-name "*Async-native-compile-log*" "Name of the async compilation buffer log.") @@ -148,63 +115,6 @@ comp-no-spawn (defvar comp-async-compilations (make-hash-table :test #'equal) "Hash table file-name -> async compilation process.") -(cl-defun comp-log (data &optional (level 1) quoted) - "Log DATA at LEVEL. -LEVEL is a number from 1-3, and defaults to 1; if it is less -than `native-comp-verbose', do nothing. If `noninteractive', log -with `message'. Otherwise, log with `comp-log-to-buffer'." - (when (>= native-comp-verbose level) - (if noninteractive - (cl-typecase data - (atom (message "%s" data)) - (t (dolist (elem data) - (message "%s" elem)))) - (comp-log-to-buffer data quoted)))) - -(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE" - "Syntax-highlight LIMPLE IR." - (setf font-lock-defaults '(comp-limple-lock-keywords))) - -(cl-defun comp-log-to-buffer (data &optional quoted) - "Log DATA to `comp-log-buffer-name'." - (let* ((print-f (if quoted #'prin1 #'princ)) - (log-buffer - (or (get-buffer comp-log-buffer-name) - (with-current-buffer (get-buffer-create comp-log-buffer-name) - (unless (derived-mode-p 'compilation-mode) - (emacs-lisp-compilation-mode)) - (current-buffer)))) - (log-window (get-buffer-window log-buffer)) - (inhibit-read-only t) - at-end-p) - (with-current-buffer log-buffer - (unless (eq major-mode 'native-comp-limple-mode) - (native-comp-limple-mode)) - (when (= (point) (point-max)) - (setf at-end-p t)) - (save-excursion - (goto-char (point-max)) - (cl-typecase data - (atom (funcall print-f data log-buffer)) - (t (dolist (elem data) - (funcall print-f elem log-buffer) - (insert "\n")))) - (insert "\n")) - (when (and at-end-p log-window) - ;; When log window's point is at the end, follow the tail. - (with-selected-window log-window - (goto-char (point-max))))))) - -(defun comp-ensure-native-compiler () - "Make sure Emacs has native compiler support and libgccjit can be loaded. -Signal an error otherwise. -To be used by all entry points." - (cond - ((null (featurep 'native-compile)) - (error "Emacs was not compiled with native compiler support (--with-native-compilation)")) - ((null (native-comp-available-p)) - (error "Cannot find libgccjit library")))) - (defun native-compile-async-skip-p (file load selector) "Return non-nil if FILE's compilation should be skipped. @@ -406,19 +316,6 @@ comp-warn-primitives "List of primitives we want to warn about in case of redefinition. This are essential for the trampoline machinery to work properly.") -(defun comp-trampoline-filename (subr-name) - "Given SUBR-NAME return the filename containing the trampoline." - (concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln")) - -(defun comp-eln-load-path-eff () - "Return a list of effective eln load directories. -Account for `native-comp-eln-load-path' and `comp-native-version-dir'." - (mapcar (lambda (dir) - (expand-file-name comp-native-version-dir - (file-name-as-directory - (expand-file-name dir invocation-directory)))) - native-comp-eln-load-path)) - (defun comp-trampoline-search (subr-name) "Search a trampoline file for SUBR-NAME. Return the trampoline if found or nil otherwise." diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 457960b2198..017af49b658 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -34,7 +34,7 @@ (require 'rx) (require 'subr-x) (require 'warnings) -(require 'comp-run) +(require 'comp-common) (require 'comp-cstr) ;; These variables and functions are defined in comp.c @@ -587,33 +587,6 @@ comp-type-hints comp-hint-cons) "List of fake functions used to give compiler hints.") -(defconst comp-limple-sets '(set - setimm - set-par-to-local - set-args-to-local - set-rest-args-to-local) - "Limple set operators.") - -(defconst comp-limple-assignments `(assume - fetch-handler - ,@comp-limple-sets) - "Limple operators that clobber the first m-var argument.") - -(defconst comp-limple-calls '(call - callref - direct-call - direct-callref) - "Limple operators used to call subrs.") - -(defconst comp-limple-branches '(jump cond-jump) - "Limple operators used for conditional and unconditional branches.") - -(defconst comp-limple-ops `(,@comp-limple-calls - ,@comp-limple-assignments - ,@comp-limple-branches - return) - "All Limple operators.") - (defvar comp-func nil "Bound to the current function by most passes.") @@ -965,24 +938,6 @@ comp-add-const-to-relocs ;;; Log routines. -(defconst comp-limple-lock-keywords - `((,(rx bol "(comment" (1+ not-newline)) . font-lock-comment-face) - (,(rx "#(" (group-n 1 "mvar")) - (1 font-lock-function-name-face)) - (,(rx bol "(" (group-n 1 "phi")) - (1 font-lock-variable-name-face)) - (,(rx bol "(" (group-n 1 (or "return" "unreachable"))) - (1 font-lock-warning-face)) - (,(rx (group-n 1 (or "entry" - (seq (or "entry_" "entry_fallback_" "bb_") - (1+ num) (? (or "_latch" - (seq "_cstrs_" (1+ num)))))))) - (1 font-lock-constant-face)) - (,(rx-to-string - `(seq "(" (group-n 1 (or ,@(mapcar #'symbol-name comp-limple-ops))))) - (1 font-lock-keyword-face))) - "Highlights used by `native-comp-limple-mode'.") - (defun comp-prettyformat-mvar (mvar) (format "#(mvar %s %s %S)" (comp-mvar-id mvar) diff --git a/src/Makefile.in b/src/Makefile.in index 963a0a14f4f..d3d71e78abb 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -943,6 +943,7 @@ elnlisp := international/charscript.eln \ emacs-lisp/comp.eln \ emacs-lisp/comp-cstr.eln \ + emacs-lisp/comp-common.eln \ emacs-lisp/comp-run.eln \ international/emoji-zwj.eln elnlisp := $(addprefix ${lispsource}/,${elnlisp}) $(lisp:.elc=.eln) commit b2416d2c029eeda5fa9e663dbe3f0264adc57a50 Author: Andrea Corallo Date: Tue Nov 7 11:28:32 2023 +0100 Don't load comp when installing an existing trampoline * lisp/emacs-lisp/nadvice.el (advice--add-function): Update. (comp-subr-trampoline-install): Update src file. * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Autoload. * lisp/emacs-lisp/comp-run.el (comp-log-buffer-name) (native--compile-async, comp-warn-primitives) (comp-trampoline-filename, comp-eln-load-path-eff) (comp-trampoline-search, comp-trampoline-compile): Move here. * lisp/emacs-lisp/advice.el (comp-subr-trampoline-install): Update src file. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 7fbdd963e0e..2a668f6ce0e 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2042,7 +2042,7 @@ ad-remove-advice function class name))) (error "ad-remove-advice: `%s' is not advised" function))) -(declare-function comp-subr-trampoline-install "comp") +(declare-function comp-subr-trampoline-install "comp-run") ;;;###autoload (defun ad-add-advice (function advice class position) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index b65c0997a3e..512cadf4cab 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -123,6 +123,19 @@ native-comp-verbose :risky t :version "28.1") +(defcustom native-comp-never-optimize-functions + '(;; The following two are mandatory for Emacs to be working + ;; correctly (see comment in `advice--add-function'). DO NOT + ;; REMOVE. + macroexpand rename-buffer) + "Primitive functions to exclude from trampoline optimization. + +Primitive functions included in this list will not be called +directly by the natively-compiled code, which makes trampolines for +those primitives unnecessary in case of function redefinition/advice." + :type '(repeat symbol) + :version "28.1") + (defconst comp-log-buffer-name "*Native-compile-Log*" "Name of the native-compiler log buffer.") @@ -385,6 +398,52 @@ comp-run-async-workers ;; Reset it anyway. (clrhash comp-deferred-pending-h))) +(defconst comp-warn-primitives + '(null memq gethash and subrp not subr-native-elisp-p + comp--install-trampoline concat if symbolp symbol-name make-string + length aset aref length> mapcar expand-file-name + file-name-as-directory file-exists-p native-elisp-load) + "List of primitives we want to warn about in case of redefinition. +This are essential for the trampoline machinery to work properly.") + +(defun comp-trampoline-filename (subr-name) + "Given SUBR-NAME return the filename containing the trampoline." + (concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln")) + +(defun comp-eln-load-path-eff () + "Return a list of effective eln load directories. +Account for `native-comp-eln-load-path' and `comp-native-version-dir'." + (mapcar (lambda (dir) + (expand-file-name comp-native-version-dir + (file-name-as-directory + (expand-file-name dir invocation-directory)))) + native-comp-eln-load-path)) + +(defun comp-trampoline-search (subr-name) + "Search a trampoline file for SUBR-NAME. +Return the trampoline if found or nil otherwise." + (cl-loop + with rel-filename = (comp-trampoline-filename subr-name) + for dir in (comp-eln-load-path-eff) + for filename = (expand-file-name rel-filename dir) + when (file-exists-p filename) + do (cl-return (native-elisp-load filename)))) + +(declare-function comp-trampoline-compile "comp") +;;;###autoload +(defun comp-subr-trampoline-install (subr-name) + "Make SUBR-NAME effectively advice-able when called from native code." + (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)))) + ;;;###autoload (defun native--compile-async (files &optional recursively load selector) ;; BEWARE, this function is also called directly from C. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 15662041a57..457960b2198 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -92,19 +92,6 @@ native-comp-bootstrap-deny-list :type '(repeat regexp) :version "28.1") -(defcustom native-comp-never-optimize-functions - '(;; The following two are mandatory for Emacs to be working - ;; correctly (see comment in `advice--add-function'). DO NOT - ;; REMOVE. - macroexpand rename-buffer) - "Primitive functions to exclude from trampoline optimization. - -Primitive functions included in this list will not be called -directly by the natively-compiled code, which makes trampolines for -those primitives unnecessary in case of function redefinition/advice." - :type '(repeat symbol) - :version "28.1") - (defcustom native-comp-compiler-options nil "Command line options passed verbatim to GCC compiler. Note that not all options are meaningful and some options might even @@ -644,30 +631,6 @@ 'native-compiler-error-empty-byte (defvar comp-no-spawn nil "Non-nil don't spawn native compilation processes.") -(defconst comp-warn-primitives - '(null memq gethash and subrp not subr-native-elisp-p - comp--install-trampoline concat if symbolp symbol-name make-string - length aset aref length> mapcar expand-file-name - file-name-as-directory file-exists-p native-elisp-load) - "List of primitives we want to warn about in case of redefinition. -This are essential for the trampoline machinery to work properly.") - -;; Moved early to avoid circularity when comp.el is loaded and -;; `macroexpand' needs to be advised (bug#47049). -;;;###autoload -(defun comp-subr-trampoline-install (subr-name) - "Make SUBR-NAME effectively advice-able when called from native code." - (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)))) - (cl-defstruct (comp-vec (:copier nil)) "A re-sizable vector like object." @@ -3635,19 +3598,6 @@ comp-hint-cons ;; Primitive function advice machinery -(defun comp-eln-load-path-eff () - "Return a list of effective eln load directories. -Account for `native-comp-eln-load-path' and `comp-native-version-dir'." - (mapcar (lambda (dir) - (expand-file-name comp-native-version-dir - (file-name-as-directory - (expand-file-name dir invocation-directory)))) - native-comp-eln-load-path)) - -(defun comp-trampoline-filename (subr-name) - "Given SUBR-NAME return the filename containing the trampoline." - (concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln")) - (defun comp-make-lambda-list-from-subr (subr) "Given SUBR return the equivalent lambda-list." (pcase-let ((`(,min . ,max) (subr-arity subr)) @@ -3663,16 +3613,6 @@ comp-make-lambda-list-from-subr (push (gensym "arg") lambda-list)) (reverse lambda-list))) -(defun comp-trampoline-search (subr-name) - "Search a trampoline file for SUBR-NAME. -Return the trampoline if found or nil otherwise." - (cl-loop - with rel-filename = (comp-trampoline-filename subr-name) - for dir in (comp-eln-load-path-eff) - for filename = (expand-file-name rel-filename dir) - when (file-exists-p filename) - do (cl-return (native-elisp-load filename)))) - (defun comp--trampoline-abs-filename (subr-name) "Return the absolute filename for a trampoline for SUBR-NAME." (cl-loop @@ -3698,6 +3638,8 @@ comp--trampoline-abs-filename (make-temp-file (file-name-sans-extension rel-filename) nil ".eln" nil)))) +;; Called from comp-run.el +;;;###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 diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index ce5467f3c5c..98efb4c9c28 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -389,7 +389,7 @@ add-function `(advice--add-function ,how (gv-ref ,(advice--normalize-place place)) ,function ,props)) -(declare-function comp-subr-trampoline-install "comp") +(declare-function comp-subr-trampoline-install "comp-run") ;;;###autoload (defun advice--add-function (how ref function props) @@ -407,7 +407,7 @@ advice--add-function (unless (memq subr-name '(macroexpand rename-buffer)) ;; Must require explicitly as during bootstrap we have no ;; autoloads. - (require 'comp) + (require 'comp-run) (comp-subr-trampoline-install subr-name)))) (let* ((name (cdr (assq 'name props))) (a (advice--member-p (or name function) (if name t) (gv-deref ref)))) commit 93cc43a23c90247644cb21bfdae60b36b1057de2 Author: Andrea Corallo Date: Wed Oct 25 23:50:39 2023 +0200 comp: don't require 'warnings' in comp-run * lisp/emacs-lisp/comp-run.el (warnings): Don't require. (warning-suppress-types): Wave warning. * lisp/emacs-lisp/warnings.el (warning-suppress-types): Autoload it. diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 9ea770135c1..b65c0997a3e 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -32,7 +32,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(require 'warnings) (defgroup comp-run nil "Emacs Lisp native compiler runtime." @@ -243,6 +242,8 @@ comp-effective-async-max-jobs (defvar comp-last-scanned-async-output nil) (make-variable-buffer-local 'comp-last-scanned-async-output) +;; From warnings.el +(defvar warning-suppress-types) (defun comp-accept-and-process-async-output (process) "Accept PROCESS output and check for diagnostic messages." (if native-comp-async-report-warnings-errors diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 31b840d6c83..b99b1d2ae29 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -106,6 +106,7 @@ warning-suppress-log-types :type '(repeat (repeat symbol)) :version "22.1") +;;;###autoload (defcustom warning-suppress-types nil "List of warning types not to display immediately. If any element of this list matches the TYPE argument to `display-warning', commit 4bb186356734cce2d9c5f1d506deb0da1bb40770 Author: Andrea Corallo Date: Wed Oct 25 17:58:43 2023 +0200 comp: make comp-run don't require cl-lib at runtime * lisp/emacs-lisp/comp-run.el (cl-lib): Require it only at compile time. (native-compile-async-skip-p): Use 'seq-some'. (native--compile-async): Don't use 'cl-substitute'. diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index bf54c64dd68..9ea770135c1 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -31,7 +31,7 @@ ;;; Code: -(require 'cl-lib) +(eval-when-compile (require 'cl-lib)) (require 'warnings) (defgroup comp-run nil @@ -209,7 +209,7 @@ native-compile-async-skip-p ;; any of the regexps in ;; `native-comp-jit-compilation-deny-list' matches. (and (eq load 'late) - (cl-some (lambda (re) + (seq-some (lambda (re) (string-match-p re file)) native-comp-jit-compilation-deny-list)))) @@ -433,14 +433,18 @@ native--compile-async (t (signal 'native-compiler-error (list "Not a file nor directory" file-or-dir))))) (dolist (file file-list) - (if-let ((entry (cl-find file comp-files-queue :key #'car :test #'string=))) + (if-let ((entry (seq-find (lambda (x) (string= file (car x))) comp-files-queue))) ;; Most likely the byte-compiler has requested a deferred ;; compilation, so update `comp-files-queue' to reflect that. (unless (or (null load) (eq load (cdr entry))) (setf comp-files-queue - (cl-substitute (cons file load) (car entry) comp-files-queue - :key #'car :test #'string=))) + (cl-loop for i in comp-files-queue + with old = (car entry) + if (string= (car i) old) + collect (cons file load) + else + collect i))) (unless (native-compile-async-skip-p file load selector) (let* ((out-filename (comp-el-to-eln-filename file)) commit e6a955d2426875188f4ffdbc90d4861b917fd7bd Author: Andrea Corallo Date: Thu Oct 19 18:10:25 2023 +0200 comp: split code in comp-run.el * lisp/emacs-lisp/comp-run.el : New file. (comp-run) (native-comp-jit-compilation-deny-list) (native-comp-async-jobs-number) (native-comp-async-report-warnings-errors) (native-comp-always-compile) (native-comp-async-cu-done-functions) (native-comp-async-all-done-hook) (native-comp-async-env-modifier-form) (native-comp-async-query-on-exit, native-comp-verbose) (comp-log-buffer-name, comp-async-buffer-name, comp-no-spawn) (comp-async-compilations, native-comp-limple-mode) (comp-ensure-native-compiler, native-compile-async-skip-p) (comp-files-queue, comp-async-compilations, comp-async-runnings) (comp-num-cpus, comp-effective-async-max-jobs) (comp-last-scanned-async-output) (comp-accept-and-process-async-output, comp-valid-source-re) (comp-run-async-workers, native--compile-async) (native-compile-async): Move these definitions here. * lisp/Makefile.in (COMPILE_FIRST): Update. * src/Makefile.in (elnlisp): Likewise. * admin/MAINTAINERS: Likewise. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index a6e1baf85e1..fbb89f66006 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -133,6 +133,7 @@ Andrea Corallo Lisp native compiler src/comp.c lisp/emacs-lisp/comp.el + lisp/emacs-lisp/comp-run.el lisp/emacs-lisp/comp-cstr.el test/src/comp-*.el diff --git a/lisp/Makefile.in b/lisp/Makefile.in index c4dd1e7a1f3..446af922d34 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -95,6 +95,7 @@ COMPILE_FIRST = ifeq ($(HAVE_NATIVE_COMP),yes) COMPILE_FIRST += $(lisp)/emacs-lisp/comp.elc COMPILE_FIRST += $(lisp)/emacs-lisp/comp-cstr.elc +COMPILE_FIRST += $(lisp)/emacs-lisp/comp-run.elc endif COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc COMPILE_FIRST += $(lisp)/emacs-lisp/radix-tree.elc diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el new file mode 100644 index 00000000000..bf54c64dd68 --- /dev/null +++ b/lisp/emacs-lisp/comp-run.el @@ -0,0 +1,488 @@ +;;; comp-runtime.el --- runtime Lisp native compiler code -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Andrea Corallo +;; Keywords: lisp +;; Package: emacs + +;; 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: + +;; 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 +;; the code needed to drive async compilations and any Lisp code +;; needed at runtime to run native code. + +;;; Code: + +(require 'cl-lib) +(require 'warnings) + +(defgroup comp-run nil + "Emacs Lisp native compiler runtime." + :group 'lisp) + +(defcustom native-comp-jit-compilation-deny-list + '() + "List of regexps to exclude matching files from deferred native compilation. +Files whose names match any regexp are excluded from native compilation." + :type '(repeat regexp) + :version "28.1") + +(defcustom native-comp-async-jobs-number 0 + "Default number of subprocesses used for async native compilation. +Value of zero means to use half the number of the CPU's execution units, +or one if there's just one execution unit." + :type 'natnum + :risky t + :version "28.1") + +(defcustom native-comp-async-report-warnings-errors t + "Whether to report warnings and errors from asynchronous native compilation. + +When native compilation happens asynchronously, it can produce +warnings and errors, some of which might not be emitted by a +byte-compilation. The typical case for that is native-compiling +a file that is missing some `require' of a necessary feature, +while having it already loaded into the environment when +byte-compiling. + +As asynchronous native compilation always starts from a pristine +environment, it is more sensitive to such omissions, and might be +unable to compile such Lisp source files correctly. + +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)) + :version "28.1") + +(defcustom native-comp-always-compile nil + "Non-nil means unconditionally (re-)compile all files." + :type 'boolean + :version "28.1") + +(make-obsolete-variable 'native-comp-deferred-compilation-deny-list + 'native-comp-jit-compilation-deny-list + "29.1") + +(defcustom native-comp-async-cu-done-functions nil + "List of functions to call when asynchronous compilation of a file is done. +Each function is called with one argument FILE, the filename whose +compilation has completed." + :type 'hook + :version "28.1") + +(defcustom native-comp-async-all-done-hook nil + "Hook run after completing asynchronous compilation of all input files." + :type 'hook + :version "28.1") + +(defcustom native-comp-async-env-modifier-form nil + "Form evaluated before compilation by each asynchronous compilation subprocess. +Used to modify the compiler environment." + :type 'sexp + :risky t + :version "28.1") + +(defcustom native-comp-async-query-on-exit nil + "Whether to query the user about killing async compilations when exiting. +If this is non-nil, Emacs will ask for confirmation to exit and kill the +asynchronous native compilations if any are running. If nil, when you +exit Emacs, it will silently kill those asynchronous compilations even +if `confirm-kill-processes' is non-nil." + :type 'boolean + :version "28.1") + +(defcustom native-comp-verbose 0 + "Compiler verbosity for native compilation, a number between 0 and 3. +This is intended for debugging the compiler itself. + 0 no logging. + 1 final LIMPLE is logged. + 2 LAP, final LIMPLE, and some pass info are logged. + 3 max verbosity." + :type 'natnum + :risky t + :version "28.1") + +(defconst comp-log-buffer-name "*Native-compile-Log*" + "Name of the native-compiler log buffer.") + +(defconst comp-async-buffer-name "*Async-native-compile-log*" + "Name of the async compilation buffer log.") + +(defvar comp-no-spawn nil + "Non-nil don't spawn native compilation processes.") + +(defvar comp-async-compilations (make-hash-table :test #'equal) + "Hash table file-name -> async compilation process.") + +(cl-defun comp-log (data &optional (level 1) quoted) + "Log DATA at LEVEL. +LEVEL is a number from 1-3, and defaults to 1; if it is less +than `native-comp-verbose', do nothing. If `noninteractive', log +with `message'. Otherwise, log with `comp-log-to-buffer'." + (when (>= native-comp-verbose level) + (if noninteractive + (cl-typecase data + (atom (message "%s" data)) + (t (dolist (elem data) + (message "%s" elem)))) + (comp-log-to-buffer data quoted)))) + +(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE" + "Syntax-highlight LIMPLE IR." + (setf font-lock-defaults '(comp-limple-lock-keywords))) + +(cl-defun comp-log-to-buffer (data &optional quoted) + "Log DATA to `comp-log-buffer-name'." + (let* ((print-f (if quoted #'prin1 #'princ)) + (log-buffer + (or (get-buffer comp-log-buffer-name) + (with-current-buffer (get-buffer-create comp-log-buffer-name) + (unless (derived-mode-p 'compilation-mode) + (emacs-lisp-compilation-mode)) + (current-buffer)))) + (log-window (get-buffer-window log-buffer)) + (inhibit-read-only t) + at-end-p) + (with-current-buffer log-buffer + (unless (eq major-mode 'native-comp-limple-mode) + (native-comp-limple-mode)) + (when (= (point) (point-max)) + (setf at-end-p t)) + (save-excursion + (goto-char (point-max)) + (cl-typecase data + (atom (funcall print-f data log-buffer)) + (t (dolist (elem data) + (funcall print-f elem log-buffer) + (insert "\n")))) + (insert "\n")) + (when (and at-end-p log-window) + ;; When log window's point is at the end, follow the tail. + (with-selected-window log-window + (goto-char (point-max))))))) + +(defun comp-ensure-native-compiler () + "Make sure Emacs has native compiler support and libgccjit can be loaded. +Signal an error otherwise. +To be used by all entry points." + (cond + ((null (featurep 'native-compile)) + (error "Emacs was not compiled with native compiler support (--with-native-compilation)")) + ((null (native-comp-available-p)) + (error "Cannot find libgccjit library")))) + +(defun native-compile-async-skip-p (file load selector) + "Return non-nil if FILE's compilation should be skipped. + +LOAD and SELECTOR work as described in `native--compile-async'." + ;; Make sure we are not already compiling `file' (bug#40838). + (or (gethash file comp-async-compilations) + (gethash (file-name-with-extension file "elc") comp--no-native-compile) + (cond + ((null selector) nil) + ((functionp selector) (not (funcall selector file))) + ((stringp selector) (not (string-match-p selector file))) + (t (error "SELECTOR must be a function a regexp or nil"))) + ;; Also exclude files from deferred compilation if + ;; any of the regexps in + ;; `native-comp-jit-compilation-deny-list' matches. + (and (eq load 'late) + (cl-some (lambda (re) + (string-match-p re file)) + native-comp-jit-compilation-deny-list)))) + +(defvar comp-files-queue () + "List of Emacs Lisp files to be compiled.") + +(defvar comp-async-compilations (make-hash-table :test #'equal) + "Hash table file-name -> async compilation process.") + +(defun comp-async-runnings () + "Return the number of async compilations currently running. +This function has the side effect of cleaning-up finished +processes from `comp-async-compilations'" + (cl-loop + for file-name in (cl-loop + for file-name being each hash-key of comp-async-compilations + for prc = (gethash file-name comp-async-compilations) + unless (process-live-p prc) + collect file-name) + do (remhash file-name comp-async-compilations)) + (hash-table-count comp-async-compilations)) + +(defvar comp-num-cpus nil) +(defun comp-effective-async-max-jobs () + "Compute the effective number of async jobs." + (if (zerop native-comp-async-jobs-number) + (or comp-num-cpus + (setf comp-num-cpus + (max 1 (/ (num-processors) 2)))) + native-comp-async-jobs-number)) + +(defvar comp-last-scanned-async-output nil) +(make-variable-buffer-local 'comp-last-scanned-async-output) +(defun comp-accept-and-process-async-output (process) + "Accept PROCESS output and check for diagnostic messages." + (if native-comp-async-report-warnings-errors + (let ((warning-suppress-types + (if (eq native-comp-async-report-warnings-errors 'silent) + (cons '(comp) warning-suppress-types) + warning-suppress-types))) + (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) + (display-warning 'comp (match-string 0))) + (setq comp-last-scanned-async-output (point-max))))) + (accept-process-output process))) + +(defconst comp-valid-source-re (rx ".el" (? ".gz") eos) + "Regexp to match filename of valid input source files.") + +(defun comp-run-async-workers () + "Start compiling files from `comp-files-queue' asynchronously. +When compilation is finished, run `native-comp-async-all-done-hook' and +display a message." + (cl-assert (null comp-no-spawn)) + (if (or comp-files-queue + (> (comp-async-runnings) 0)) + (unless (>= (comp-async-runnings) (comp-effective-async-max-jobs)) + (cl-loop + for (source-file . load) = (pop comp-files-queue) + while source-file + do (cl-assert (string-match-p comp-valid-source-re source-file) nil + "`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. + ;; Skip compilation if `comp-el-to-eln-filename' fails + ;; to find a writable directory. + (with-demoted-errors "Async compilation :%S" + (file-newer-than-file-p + source-file (comp-el-to-eln-filename source-file)))) + do (let* ((expr `((require 'comp) + (setq comp-async-compilation t + warning-fill-column most-positive-fixnum) + ,(let ((set (list 'setq))) + (dolist (var '(comp-file-preloaded-p + native-compile-target-directory + native-comp-speed + native-comp-debug + native-comp-verbose + comp-libgccjit-reproducer + native-comp-eln-load-path + native-comp-compiler-options + native-comp-driver-options + load-path + backtrace-line-length + byte-compile-warnings + ;; package-load-list + ;; package-user-dir + ;; package-directory-list + )) + (when (boundp var) + (push var set) + (push `',(symbol-value var) set))) + (nreverse set)) + ;; FIXME: Activating all packages would align the + ;; functionality offered with what is usually done + ;; for ELPA packages (and thus fix some compilation + ;; issues with some ELPA packages), but it's too + ;; blunt an instrument (e.g. we don't even know if + ;; we're compiling such an ELPA package at + ;; this point). + ;;(package-activate-all) + ,native-comp-async-env-modifier-form + (message "Compiling %s..." ,source-file) + (comp--native-compile ,source-file ,(and load t)))) + (source-file1 source-file) ;; Make the closure works :/ + (temp-file (make-temp-file + (concat "emacs-async-comp-" + (file-name-base source-file) "-") + nil ".el")) + (expr-strings (let ((print-length nil) + (print-level nil)) + (mapcar #'prin1-to-string expr))) + (_ (progn + (with-temp-file temp-file + (mapc #'insert expr-strings)) + (comp-log "\n") + (mapc #'comp-log expr-strings))) + (load1 load) + (default-directory invocation-directory) + (process (make-process + :name (concat "Compiling: " source-file) + :buffer (with-current-buffer + (get-buffer-create + comp-async-buffer-name) + (unless (derived-mode-p 'compilation-mode) + (emacs-lisp-compilation-mode)) + (current-buffer)) + :command (list + (expand-file-name invocation-name + invocation-directory) + "-no-comp-spawn" "-Q" "--batch" + "--eval" + ;; Suppress Abort dialogs on MS-Windows + "(setq w32-disable-abort-dialog t)" + "-l" temp-file) + :sentinel + (lambda (process _event) + (run-hook-with-args + 'native-comp-async-cu-done-functions + source-file) + (comp-accept-and-process-async-output process) + (ignore-errors (delete-file temp-file)) + (let ((eln-file (comp-el-to-eln-filename + source-file1))) + (when (and load1 + (zerop (process-exit-status + process)) + (file-exists-p eln-file)) + (native-elisp-load eln-file + (eq load1 'late)))) + (comp-run-async-workers)) + :noquery (not native-comp-async-query-on-exit)))) + (puthash source-file process comp-async-compilations)) + when (>= (comp-async-runnings) (comp-effective-async-max-jobs)) + do (cl-return))) + ;; No files left to compile and all processes finished. + (run-hooks 'native-comp-async-all-done-hook) + (with-current-buffer (get-buffer-create comp-async-buffer-name) + (save-excursion + (unless (derived-mode-p 'compilation-mode) + (emacs-lisp-compilation-mode)) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert "Compilation finished.\n")))) + ;; `comp-deferred-pending-h' should be empty at this stage. + ;; Reset it anyway. + (clrhash comp-deferred-pending-h))) + +;;;###autoload +(defun native--compile-async (files &optional recursively load selector) + ;; BEWARE, this function is also called directly from C. + "Compile FILES asynchronously. +FILES is one filename or a list of filenames or directories. + +If optional argument RECURSIVELY is non-nil, recurse into +subdirectories of given directories. + +If optional argument LOAD is non-nil, request to load the file +after compiling. + +The optional argument SELECTOR has the following valid values: + +nil -- Select all files. +a string -- A regular expression selecting files with matching names. +a function -- A function selecting files with matching names. + +The variable `native-comp-async-jobs-number' specifies the number +of (commands) to run simultaneously. + +LOAD can also be the symbol `late'. This is used internally if +the byte code has already been loaded when this function is +called. It means that we request the special kind of load +necessary in that situation, called \"late\" loading. + +During a \"late\" load, instead of executing all top-level forms +of the original files, only function definitions are +loaded (paying attention to have these effective only if the +bytecode definition was not changed in the meantime)." + (comp-ensure-native-compiler) + (unless (member load '(nil t late)) + (error "LOAD must be nil, t or 'late")) + (unless (listp files) + (setf files (list files))) + (let ((added-something nil) + file-list) + (dolist (file-or-dir files) + (cond ((file-directory-p file-or-dir) + (dolist (file (if recursively + (directory-files-recursively + file-or-dir comp-valid-source-re) + (directory-files file-or-dir + t comp-valid-source-re))) + (push file file-list))) + ((file-exists-p file-or-dir) (push file-or-dir file-list)) + (t (signal 'native-compiler-error + (list "Not a file nor directory" file-or-dir))))) + (dolist (file file-list) + (if-let ((entry (cl-find file comp-files-queue :key #'car :test #'string=))) + ;; Most likely the byte-compiler has requested a deferred + ;; compilation, so update `comp-files-queue' to reflect that. + (unless (or (null load) + (eq load (cdr entry))) + (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)) + (out-dir (file-name-directory out-filename))) + (unless (file-exists-p out-dir) + (make-directory out-dir t)) + (if (file-writable-p out-filename) + (setf comp-files-queue + (append comp-files-queue `((,file . ,load))) + added-something t) + (display-warning 'comp + (format "No write access for %s skipping." + out-filename))))))) + ;; Perhaps nothing passed `native-compile-async-skip-p'? + (when (and added-something + ;; Don't start if there's one already running. + (zerop (comp-async-runnings))) + (comp-run-async-workers)))) + +;;;###autoload +(defun native-compile-async (files &optional recursively load selector) + "Compile FILES asynchronously. +FILES is one file or a list of filenames or directories. + +If optional argument RECURSIVELY is non-nil, recurse into +subdirectories of given directories. + +If optional argument LOAD is non-nil, request to load the file +after compiling. + +The optional argument SELECTOR has the following valid values: + +nil -- Select all files. +a string -- A regular expression selecting files with matching names. +a function -- A function selecting files with matching names. + +The variable `native-comp-async-jobs-number' specifies the number +of (commands) to run simultaneously." + ;; Normalize: we only want to pass t or nil, never e.g. `late'. + (let ((load (not (not load)))) + (native--compile-async files recursively load selector))) + +(provide 'comp-run) + +;;; comp-run.el ends here diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index ba64bae599a..15662041a57 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -34,6 +34,7 @@ (require 'rx) (require 'subr-x) (require 'warnings) +(require 'comp-run) (require 'comp-cstr) ;; These variables and functions are defined in comp.c @@ -83,33 +84,6 @@ native-comp-debug :safe #'natnump :version "29.1") -(defcustom native-comp-verbose 0 - "Compiler verbosity for native compilation, a number between 0 and 3. -This is intended for debugging the compiler itself. - 0 no logging. - 1 final LIMPLE is logged. - 2 LAP, final LIMPLE, and some pass info are logged. - 3 max verbosity." - :type 'natnum - :risky t - :version "28.1") - -(defcustom native-comp-always-compile nil - "Non-nil means unconditionally (re-)compile all files." - :type 'boolean - :version "28.1") - -(defcustom native-comp-jit-compilation-deny-list - '() - "List of regexps to exclude matching files from deferred native compilation. -Files whose names match any regexp are excluded from native compilation." - :type '(repeat regexp) - :version "28.1") - -(make-obsolete-variable 'native-comp-deferred-compilation-deny-list - 'native-comp-jit-compilation-deny-list - "29.1") - (defcustom native-comp-bootstrap-deny-list '() "List of regexps to exclude files from native compilation during bootstrap. @@ -131,65 +105,6 @@ native-comp-never-optimize-functions :type '(repeat symbol) :version "28.1") -(defcustom native-comp-async-jobs-number 0 - "Default number of subprocesses used for async native compilation. -Value of zero means to use half the number of the CPU's execution units, -or one if there's just one execution unit." - :type 'natnum - :risky t - :version "28.1") - -(defcustom native-comp-async-cu-done-functions nil - "List of functions to call when asynchronous compilation of a file is done. -Each function is called with one argument FILE, the filename whose -compilation has completed." - :type 'hook - :version "28.1") - -(defcustom native-comp-async-all-done-hook nil - "Hook run after completing asynchronous compilation of all input files." - :type 'hook - :version "28.1") - -(defcustom native-comp-async-env-modifier-form nil - "Form evaluated before compilation by each asynchronous compilation subprocess. -Used to modify the compiler environment." - :type 'sexp - :risky t - :version "28.1") - -(defcustom native-comp-async-report-warnings-errors t - "Whether to report warnings and errors from asynchronous native compilation. - -When native compilation happens asynchronously, it can produce -warnings and errors, some of which might not be emitted by a -byte-compilation. The typical case for that is native-compiling -a file that is missing some `require' of a necessary feature, -while having it already loaded into the environment when -byte-compiling. - -As asynchronous native compilation always starts from a pristine -environment, it is more sensitive to such omissions, and might be -unable to compile such Lisp source files correctly. - -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)) - :version "28.1") - -(defcustom native-comp-async-query-on-exit nil - "Whether to query the user about killing async compilations when exiting. -If this is non-nil, Emacs will ask for confirmation to exit and kill the -asynchronous native compilations if any are running. If nil, when you -exit Emacs, it will silently kill those asynchronous compilations even -if `confirm-kill-processes' is non-nil." - :type 'boolean - :version "28.1") - (defcustom native-comp-compiler-options nil "Command line options passed verbatim to GCC compiler. Note that not all options are meaningful and some options might even @@ -245,15 +160,6 @@ comp-log-time-report (defvar comp-dry-run nil "If non-nil, run everything but the C back-end.") -(defconst comp-valid-source-re (rx ".el" (? ".gz") eos) - "Regexp to match filename of valid input source files.") - -(defconst comp-log-buffer-name "*Native-compile-Log*" - "Name of the native-compiler log buffer.") - -(defconst comp-async-buffer-name "*Async-native-compile-log*" - "Name of the async compilation buffer log.") - (defvar comp-native-compiling nil "This gets bound to t during native compilation. Intended to be used by code that needs to work differently when @@ -1027,16 +933,6 @@ comp-mvar-type-hint-match-p -(defun comp-ensure-native-compiler () - "Make sure Emacs has native compiler support and libgccjit can be loaded. -Signal an error otherwise. -To be used by all entry points." - (cond - ((null (featurep 'native-compile)) - (error "Emacs was not compiled with native compiler support (--with-native-compilation)")) - ((null (native-comp-available-p)) - (error "Cannot find libgccjit library")))) - (defun comp-equality-fun-p (function) "Equality functions predicate for FUNCTION." (when (memq function '(eq eql equal)) t)) @@ -1124,53 +1020,6 @@ comp-limple-lock-keywords (1 font-lock-keyword-face))) "Highlights used by `native-comp-limple-mode'.") -(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE" - "Syntax-highlight LIMPLE IR." - (setf font-lock-defaults '(comp-limple-lock-keywords))) - -(cl-defun comp-log (data &optional (level 1) quoted) - "Log DATA at LEVEL. -LEVEL is a number from 1-3, and defaults to 1; if it is less -than `native-comp-verbose', do nothing. If `noninteractive', log -with `message'. Otherwise, log with `comp-log-to-buffer'." - (when (>= native-comp-verbose level) - (if noninteractive - (cl-typecase data - (atom (message "%s" data)) - (t (dolist (elem data) - (message "%s" elem)))) - (comp-log-to-buffer data quoted)))) - -(cl-defun comp-log-to-buffer (data &optional quoted) - "Log DATA to `comp-log-buffer-name'." - (let* ((print-f (if quoted #'prin1 #'princ)) - (log-buffer - (or (get-buffer comp-log-buffer-name) - (with-current-buffer (get-buffer-create comp-log-buffer-name) - (unless (derived-mode-p 'compilation-mode) - (emacs-lisp-compilation-mode)) - (current-buffer)))) - (log-window (get-buffer-window log-buffer)) - (inhibit-read-only t) - at-end-p) - (with-current-buffer log-buffer - (unless (eq major-mode 'native-comp-limple-mode) - (native-comp-limple-mode)) - (when (= (point) (point-max)) - (setf at-end-p t)) - (save-excursion - (goto-char (point-max)) - (cl-typecase data - (atom (funcall print-f data log-buffer)) - (t (dolist (elem data) - (funcall print-f elem log-buffer) - (insert "\n")))) - (insert "\n")) - (when (and at-end-p log-window) - ;; When log window's point is at the end, follow the tail. - (with-selected-window log-window - (goto-char (point-max))))))) - (defun comp-prettyformat-mvar (mvar) (format "#(mvar %s %s %S)" (comp-mvar-id mvar) @@ -3927,174 +3776,6 @@ comp-delete-or-replace-file (when newfile (rename-file newfile oldfile))))) -(defvar comp-files-queue () - "List of Emacs Lisp files to be compiled.") - -(defvar comp-async-compilations (make-hash-table :test #'equal) - "Hash table file-name -> async compilation process.") - -(defun comp-async-runnings () - "Return the number of async compilations currently running. -This function has the side effect of cleaning-up finished -processes from `comp-async-compilations'" - (cl-loop - for file-name in (cl-loop - for file-name being each hash-key of comp-async-compilations - for prc = (gethash file-name comp-async-compilations) - unless (process-live-p prc) - collect file-name) - do (remhash file-name comp-async-compilations)) - (hash-table-count comp-async-compilations)) - -(defvar comp-num-cpus nil) -(defun comp-effective-async-max-jobs () - "Compute the effective number of async jobs." - (if (zerop native-comp-async-jobs-number) - (or comp-num-cpus - (setf comp-num-cpus - (max 1 (/ (num-processors) 2)))) - native-comp-async-jobs-number)) - -(defvar comp-last-scanned-async-output nil) -(make-variable-buffer-local 'comp-last-scanned-async-output) -(defun comp-accept-and-process-async-output (process) - "Accept PROCESS output and check for diagnostic messages." - (if native-comp-async-report-warnings-errors - (let ((warning-suppress-types - (if (eq native-comp-async-report-warnings-errors 'silent) - (cons '(comp) warning-suppress-types) - warning-suppress-types))) - (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) - (display-warning 'comp (match-string 0))) - (setq comp-last-scanned-async-output (point-max))))) - (accept-process-output process))) - -(defun comp-run-async-workers () - "Start compiling files from `comp-files-queue' asynchronously. -When compilation is finished, run `native-comp-async-all-done-hook' and -display a message." - (cl-assert (null comp-no-spawn)) - (if (or comp-files-queue - (> (comp-async-runnings) 0)) - (unless (>= (comp-async-runnings) (comp-effective-async-max-jobs)) - (cl-loop - for (source-file . load) = (pop comp-files-queue) - while source-file - do (cl-assert (string-match-p comp-valid-source-re source-file) nil - "`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. - ;; Skip compilation if `comp-el-to-eln-filename' fails - ;; to find a writable directory. - (with-demoted-errors "Async compilation :%S" - (file-newer-than-file-p - source-file (comp-el-to-eln-filename source-file)))) - do (let* ((expr `((require 'comp) - (setq comp-async-compilation t - warning-fill-column most-positive-fixnum) - ,(let ((set (list 'setq))) - (dolist (var '(comp-file-preloaded-p - native-compile-target-directory - native-comp-speed - native-comp-debug - native-comp-verbose - comp-libgccjit-reproducer - native-comp-eln-load-path - native-comp-compiler-options - native-comp-driver-options - load-path - backtrace-line-length - byte-compile-warnings - ;; package-load-list - ;; package-user-dir - ;; package-directory-list - )) - (when (boundp var) - (push var set) - (push `',(symbol-value var) set))) - (nreverse set)) - ;; FIXME: Activating all packages would align the - ;; functionality offered with what is usually done - ;; for ELPA packages (and thus fix some compilation - ;; issues with some ELPA packages), but it's too - ;; blunt an instrument (e.g. we don't even know if - ;; we're compiling such an ELPA package at - ;; this point). - ;;(package-activate-all) - ,native-comp-async-env-modifier-form - (message "Compiling %s..." ,source-file) - (comp--native-compile ,source-file ,(and load t)))) - (source-file1 source-file) ;; Make the closure works :/ - (temp-file (make-temp-file - (concat "emacs-async-comp-" - (file-name-base source-file) "-") - nil ".el")) - (expr-strings (let ((print-length nil) - (print-level nil)) - (mapcar #'prin1-to-string expr))) - (_ (progn - (with-temp-file temp-file - (mapc #'insert expr-strings)) - (comp-log "\n") - (mapc #'comp-log expr-strings))) - (load1 load) - (default-directory invocation-directory) - (process (make-process - :name (concat "Compiling: " source-file) - :buffer (with-current-buffer - (get-buffer-create - comp-async-buffer-name) - (unless (derived-mode-p 'compilation-mode) - (emacs-lisp-compilation-mode)) - (current-buffer)) - :command (list - (expand-file-name invocation-name - invocation-directory) - "-no-comp-spawn" "-Q" "--batch" - "--eval" - ;; Suppress Abort dialogs on MS-Windows - "(setq w32-disable-abort-dialog t)" - "-l" temp-file) - :sentinel - (lambda (process _event) - (run-hook-with-args - 'native-comp-async-cu-done-functions - source-file) - (comp-accept-and-process-async-output process) - (ignore-errors (delete-file temp-file)) - (let ((eln-file (comp-el-to-eln-filename - source-file1))) - (when (and load1 - (zerop (process-exit-status - process)) - (file-exists-p eln-file)) - (native-elisp-load eln-file - (eq load1 'late)))) - (comp-run-async-workers)) - :noquery (not native-comp-async-query-on-exit)))) - (puthash source-file process comp-async-compilations)) - when (>= (comp-async-runnings) (comp-effective-async-max-jobs)) - do (cl-return))) - ;; No files left to compile and all processes finished. - (run-hooks 'native-comp-async-all-done-hook) - (with-current-buffer (get-buffer-create comp-async-buffer-name) - (save-excursion - (unless (derived-mode-p 'compilation-mode) - (emacs-lisp-compilation-mode)) - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert "Compilation finished.\n")))) - ;; `comp-deferred-pending-h' should be empty at this stage. - ;; Reset it anyway. - (clrhash comp-deferred-pending-h))) - (defun comp--native-compile (function-or-file &optional with-late-load output) "Compile FUNCTION-OR-FILE into native code. When WITH-LATE-LOAD is non-nil, mark the compilation unit for late @@ -4177,102 +3858,6 @@ comp--native-compile (ignore-errors (delete-file (comp-ctxt-output comp-ctxt)))) (t (delete-file (comp-ctxt-output comp-ctxt)))))))))) -(defun native-compile-async-skip-p (file load selector) - "Return non-nil if FILE's compilation should be skipped. - -LOAD and SELECTOR work as described in `native--compile-async'." - ;; Make sure we are not already compiling `file' (bug#40838). - (or (gethash file comp-async-compilations) - (gethash (file-name-with-extension file "elc") comp--no-native-compile) - (cond - ((null selector) nil) - ((functionp selector) (not (funcall selector file))) - ((stringp selector) (not (string-match-p selector file))) - (t (error "SELECTOR must be a function a regexp or nil"))) - ;; Also exclude files from deferred compilation if - ;; any of the regexps in - ;; `native-comp-jit-compilation-deny-list' matches. - (and (eq load 'late) - (cl-some (lambda (re) - (string-match-p re file)) - native-comp-jit-compilation-deny-list)))) - -;;;###autoload -(defun native--compile-async (files &optional recursively load selector) - ;; BEWARE, this function is also called directly from C. - "Compile FILES asynchronously. -FILES is one filename or a list of filenames or directories. - -If optional argument RECURSIVELY is non-nil, recurse into -subdirectories of given directories. - -If optional argument LOAD is non-nil, request to load the file -after compiling. - -The optional argument SELECTOR has the following valid values: - -nil -- Select all files. -a string -- A regular expression selecting files with matching names. -a function -- A function selecting files with matching names. - -The variable `native-comp-async-jobs-number' specifies the number -of (commands) to run simultaneously. - -LOAD can also be the symbol `late'. This is used internally if -the byte code has already been loaded when this function is -called. It means that we request the special kind of load -necessary in that situation, called \"late\" loading. - -During a \"late\" load, instead of executing all top-level forms -of the original files, only function definitions are -loaded (paying attention to have these effective only if the -bytecode definition was not changed in the meantime)." - (comp-ensure-native-compiler) - (unless (member load '(nil t late)) - (error "LOAD must be nil, t or 'late")) - (unless (listp files) - (setf files (list files))) - (let ((added-something nil) - file-list) - (dolist (file-or-dir files) - (cond ((file-directory-p file-or-dir) - (dolist (file (if recursively - (directory-files-recursively - file-or-dir comp-valid-source-re) - (directory-files file-or-dir - t comp-valid-source-re))) - (push file file-list))) - ((file-exists-p file-or-dir) (push file-or-dir file-list)) - (t (signal 'native-compiler-error - (list "Not a file nor directory" file-or-dir))))) - (dolist (file file-list) - (if-let ((entry (cl-find file comp-files-queue :key #'car :test #'string=))) - ;; Most likely the byte-compiler has requested a deferred - ;; compilation, so update `comp-files-queue' to reflect that. - (unless (or (null load) - (eq load (cdr entry))) - (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)) - (out-dir (file-name-directory out-filename))) - (unless (file-exists-p out-dir) - (make-directory out-dir t)) - (if (file-writable-p out-filename) - (setf comp-files-queue - (append comp-files-queue `((,file . ,load))) - added-something t) - (display-warning 'comp - (format "No write access for %s skipping." - out-filename))))))) - ;; Perhaps nothing passed `native-compile-async-skip-p'? - (when (and added-something - ;; Don't start if there's one already running. - (zerop (comp-async-runnings))) - (comp-run-async-workers)))) - ;;; Compiler entry points. @@ -4380,29 +3965,6 @@ batch-byte+native-compile (comp-write-bytecode-file eln-file) (setq command-line-args-left (cdr command-line-args-left))))) -;;;###autoload -(defun native-compile-async (files &optional recursively load selector) - "Compile FILES asynchronously. -FILES is one file or a list of filenames or directories. - -If optional argument RECURSIVELY is non-nil, recurse into -subdirectories of given directories. - -If optional argument LOAD is non-nil, request to load the file -after compiling. - -The optional argument SELECTOR has the following valid values: - -nil -- Select all files. -a string -- A regular expression selecting files with matching names. -a function -- A function selecting files with matching names. - -The variable `native-comp-async-jobs-number' specifies the number -of (commands) to run simultaneously." - ;; Normalize: we only want to pass t or nil, never e.g. `late'. - (let ((load (not (not load)))) - (native--compile-async files recursively load selector))) - (defun native-compile-prune-cache () "Remove .eln files that aren't applicable to the current Emacs invocation." (interactive) diff --git a/src/Makefile.in b/src/Makefile.in index b14681f2537..963a0a14f4f 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -943,6 +943,7 @@ elnlisp := international/charscript.eln \ emacs-lisp/comp.eln \ emacs-lisp/comp-cstr.eln \ + emacs-lisp/comp-run.eln \ international/emoji-zwj.eln elnlisp := $(addprefix ${lispsource}/,${elnlisp}) $(lisp:.elc=.eln) commit fe000236cf278a469adbf27e2184f823f7e12587 Author: Eli Zaretskii Date: Thu Nov 9 10:33:28 2023 +0200 Improve documentation of signaling errors in batch mode * doc/lispref/control.texi (Signaling Errors) (Processing of Errors): * doc/lispref/os.texi (Batch Mode): * doc/lispref/debugging.texi (Invoking the Debugger): * lisp/emacs-lisp/debug.el (debug): * src/eval.c (Fsignal): * lisp/subr.el (error): Document more prominently that signaling an unhandled error in batch mode kills Emacs. Better documentation of backtrace in batch mode. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 3aee9dd80e4..84196c9116a 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1882,6 +1882,9 @@ Signaling Errors @var{string} contains @samp{%}, @samp{`}, or @samp{'} it may be reformatted, with undesirable results. Instead, use @code{(error "%s" @var{string})}. + +When @code{noninteractive} is non-@code{nil} (@pxref{Batch Mode}), +this function kills Emacs if the signaled error has no handler. @end defun @defun signal error-symbol data @@ -1915,6 +1918,9 @@ Signaling Errors The function @code{signal} never returns. @c (though in older Emacs versions it sometimes could). +If the error @var{error-symbol} has no handler, and +@code{noninteractive} is non-@code{nil} (@pxref{Batch Mode}), +this function eventually kills Emacs. @example @group @@ -1979,11 +1985,14 @@ Processing of Errors @end defvar @cindex @code{debug-on-error} use -An error that has no explicit handler may call the Lisp debugger. The -debugger is enabled if the variable @code{debug-on-error} (@pxref{Error -Debugging}) is non-@code{nil}. Unlike error handlers, the debugger runs -in the environment of the error, so that you can examine values of -variables precisely as they were at the time of the error. +An error that has no explicit handler may call the Lisp debugger +(@pxref{Invoking the Debugger}). The debugger is enabled if the +variable @code{debug-on-error} (@pxref{Error Debugging}) is +non-@code{nil}. Unlike error handlers, the debugger runs in the +environment of the error, so that you can examine values of variables +precisely as they were at the time of the error. In batch mode +(@pxref{Batch Mode}), the Emacs process then normally exits with a +non-zero exit status. @node Handling Errors @subsubsection Writing Code to Handle Errors diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 169e3ac37d3..1246b3ff57a 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -629,11 +629,18 @@ Invoking the Debugger to invoke the debugger. @deffn Command debug &rest debugger-args -This function enters the debugger. It switches buffers to a buffer -named @file{*Backtrace*} (or @file{*Backtrace*<2>} if it is the second -recursive entry to the debugger, etc.), and fills it with information -about the stack of Lisp function calls. It then enters a recursive -edit, showing the backtrace buffer in Debugger mode. +This function enters the debugger. In interactive sessions, it +switches to a buffer named @file{*Backtrace*} (or +@file{*Backtrace*<2>} if it is the second recursive entry to the +debugger, etc.), and fills it with information about the stack of Lisp +function calls. It then enters a recursive edit, showing the +backtrace buffer in Debugger mode. In batch mode (more generally, +when @code{noninteractive} is non-@code{nil}, @pxref{Batch Mode}), +this function shows the Lisp backtrace on the standard error stream, +and then kills Emacs, causing it to exit with a non-zero exit code +(@pxref{Killing Emacs}). Binding +@code{backtrace-on-error-noninteractive} to @code{nil} suppresses the +backtrace in batch mode, see below. The Debugger mode @kbd{c}, @kbd{d}, @kbd{j}, and @kbd{r} commands exit the recursive edit; then @code{debug} switches back to the previous @@ -717,6 +724,13 @@ Invoking the Debugger @end table @end deffn +@defvar backtrace-on-error-noninteractive +If this variable is non-@code{nil}, the default, entering the debugger +in batch mode shows the backtrace of Lisp functions calls. Binding +the variable to the @code{nil} value suppresses the backtrace and +shows only the error message. +@end defvar + @node Internals of Debugger @subsection Internals of the Debugger diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index ea27af8edb2..1995fd9fb2a 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2736,6 +2736,35 @@ Batch Mode loads the library named @var{file}, or @samp{-f @var{function}}, which calls @var{function} with no arguments, or @samp{--eval=@var{form}}. +@defvar noninteractive +This variable is non-@code{nil} when Emacs is running in batch mode. +@end defvar + + If the specified Lisp program signals an unhandled error in batch +mode, Emacs exits with a non-zero exit status after invoking the Lisp +debugger which shows the Lisp backtrace (@pxref{Invoking the +Debugger}) on the standard error stream: + +@example +$ emacs -Q --batch --eval '(error "foo")'; echo $? + +@group +Error: error ("foo") +mapbacktrace(#f(compiled-function (evald func args flags) #)) +debug-early-backtrace() +debug-early(error (error "foo")) +signal(error ("foo")) +error("foo") +eval((error "foo") t) +command-line-1(("--eval" "(error \"foo\")")) +command-line() +normal-top-level() +@end group +foo +255 +@end example + Any Lisp program output that would normally go to the echo area, either using @code{message}, or using @code{prin1}, etc., with @code{t} as the stream (@pxref{Output Streams}), goes instead to @@ -2753,6 +2782,7 @@ Batch Mode @code{coding-system-for-write} to a coding system of you choice (@pxref{Explicit Encoding}). +@vindex gc-cons-percentage@r{, in batch mode} In batch mode, Emacs will enlarge the value of the @code{gc-cons-percentage} variable from the default of @samp{0.1} up to @samp{1.0}. Batch jobs that are supposed to run for a long time @@ -2760,19 +2790,6 @@ Batch Mode garbage collection will be performed by default (and more memory consumed). -@defvar noninteractive -This variable is non-@code{nil} when Emacs is running in batch mode. -@end defvar - -If Emacs exits due to signaling an error in batch mode, the exit -status of the Emacs command is non-zero: - -@example -$ emacs -Q --batch --eval '(error "foo")'; echo $? -foo -255 -@end example - @node Session Management @section Session Management @cindex session manager diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index dc23b071f0d..5411088189d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -158,6 +158,13 @@ debugger--restore-buffer-state ;;;###autoload (defun debug (&rest args) "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. diff --git a/lisp/subr.el b/lisp/subr.el index d5c461346cb..88c2166b1c4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -418,6 +418,10 @@ error Errors cause entry to the debugger when `debug-on-error' is non-nil. This can be overridden by `debug-ignored-errors'. +When `noninteractive' is non-nil (in particular, in batch mode), an +unhandled error calls `kill-emacs', which terminates the Emacs +session with a non-zero exit code. + To signal with MESSAGE without interpreting format characters like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE). In Emacs, the convention is that error messages start with a capital diff --git a/src/eval.c b/src/eval.c index 2dd0c356e88..3a01617f702 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1666,6 +1666,10 @@ DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. This function does not return. +When `noninteractive' is non-nil (in particular, in batch mode), an +unhandled error calls `kill-emacs', which terminates the Emacs +session with a non-zero exit code. + An error symbol is a symbol with an `error-conditions' property that is a list of condition names. The symbol should be non-nil. A handler for any of those names will get to handle this signal. commit 103ca678ac1a043c9afbb7a419adb7ddf7a624ef Author: Yuan Fu Date: Wed Nov 8 23:46:32 2023 -0800 Fix treesit-simple-indent-presets docstring (bug#67007) * lisp/treesit.el (treesit-simple-indent-presets): Fix docstring. * doc/lispref/modes.texi (Parser-based Indentation): Fix example. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 4a54d6ec290..8cdbe1149ca 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -5087,7 +5087,7 @@ Parser-based Indentation first child where parent is @code{argument_list}, use @example -(match nil "argument_list" nil nil 0 0) +(match nil "argument_list" nil 0 0) @end example In addition, @var{node-type} can be a special value @code{null}, diff --git a/lisp/treesit.el b/lisp/treesit.el index c37e7b6b5b7..962a6fc3cf8 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1322,7 +1322,7 @@ treesit-simple-indent-presets NODE's index in PARENT. Therefore, to match the first child where PARENT is \"argument_list\", use - (match nil \"argument_list\" nil nil 0 0). + (match nil \"argument_list\" nil 0 0). NODE-TYPE, PARENT-TYPE, and NODE-FIELD are regexps. NODE-TYPE can also be `null', which matches when NODE is nil. commit 5416896d608b68a969977f91b8de1e613300421d Author: Eshel Yaron Date: Wed Nov 8 18:27:03 2023 +0100 Promptly disable 'completion-in-region-mode' (bug#67001) Avoid keeping 'completion-in-region-mode' on when exiting 'completion--in-region-1' if the *Completions* buffer isn't shown. Otherwise, the bindings from 'completion-in-region-mode-map' linger, notable shadowing other bindings for TAB. * lisp/minibuffer.el (completion--in-region-1): Disable 'completion-in-region-mode' if the *Completions* buffer isn't visible. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index bf1e014319e..d84e92fc013 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1561,11 +1561,12 @@ completion--in-region-1 (t (prog1 (pcase (completion--do-completion beg end) (#b000 nil) (_ t)) - (when (and (eq completion-auto-select t) - (window-live-p minibuffer-scroll-window) - (eq t (frame-visible-p (window-frame minibuffer-scroll-window)))) - ;; When the completion list window was displayed, select it. - (switch-to-completions)))))) + (if (window-live-p minibuffer-scroll-window) + (and (eq completion-auto-select t) + (eq t (frame-visible-p (window-frame minibuffer-scroll-window))) + ;; When the completion list window was displayed, select it. + (switch-to-completions)) + (completion-in-region-mode -1)))))) (defun completion--cache-all-sorted-completions (beg end comps) (add-hook 'after-change-functions commit 1cb738a482e132e34e7b31415cc974e83e3f41ba Author: Juri Linkov Date: Thu Nov 9 09:32:39 2023 +0200 * lisp/progmodes/elisp-mode.el (elisp--local-variables): Remove `debug'. Remove symbol `debug' from the condition-case handler of `error' that was added in commit f931cebce76d911dfc61274e0a8c1de3627b9179 since it interferes on completing in an incomplete elisp form (bug#66979). diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index ff90a744ea3..63198a660be 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -456,7 +456,7 @@ elisp--local-variables (lambda (expander form &rest args) (condition-case err (apply expander form args) - ((debug error) + (error (message "Ignoring macroexpansion error: %S" err) form)))) (sexp (unwind-protect commit 8323394bc801e01dedd95e0ff8d573dd1f5e34ba Author: Stefan Monnier Date: Mon Nov 6 19:05:40 2023 -0500 Use `derived-mode-add-parents` in remaining uses of `derived-mode-parent` Until now multiple inheritance wasn't really used, but some ad-hoc code went a bit beyond the normal uses of the mode hierarchy. Use the new multiple inheritance code to replace that ad-hoc code, thereby eliminating basically all remaining direct uses of the `derived-mode-parent` property. CEDET had its own notion of mode hierrchy using `derived-mode-parent` as well as its own `mode-local-parent` property set via `define-child-mode`. `derived-mode-add-parents` lets us reimplement `define-child-mode` such that CEDET can now use the normal API functions. * lisp/locate.el (locate-mode): Use `derived-mode-add-parents`. * lisp/cedet/mode-local.el (get-mode-local-parent): Declare obsolete. (mode-local-equivalent-mode-p, mode-local-use-bindings-p): Make them obsolete aliases. (mode-local--set-parent): Rewrite to use `derived-mode-add-parents`. Declare as obsolete. (mode-local-map-mode-buffers): Use `derived-mode-p`. (mode-local-symbol, mode-local--activate-bindings) (mode-local--deactivate-bindings, mode-local-describe-bindings-2): Use `derived-mode-all-parents`. * lisp/cedet/srecode/table.el (srecode-get-mode-table): * lisp/cedet/srecode/find.el (srecode-table, srecode-load-tables-for-mode) (srecode-all-template-hash): Use `derived-mode-all-parents`. * lisp/cedet/srecode/map.el (srecode-map-entries-for-mode): * lisp/cedet/semantic/db.el (semanticdb-equivalent-mode): Use `provided-mode-derived-p` now that it obeys `define-child-mode`. diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index c1a48bc50c8..4fb4460d4c6 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -68,22 +68,15 @@ mode-local-map-file-buffers (when (or (not predicate) (funcall predicate)) (funcall function)))))) -(defsubst get-mode-local-parent (mode) +(defun get-mode-local-parent (mode) "Return the mode parent of the major mode MODE. Return nil if MODE has no parent." + (declare (obsolete derived-mode-all-parents "30.1")) (or (get mode 'mode-local-parent) (get mode 'derived-mode-parent))) -;; FIXME doc (and function name) seems wrong. -;; Return a list of MODE and all its parent modes, if any. -;; Lists parent modes first. -(defun mode-local-equivalent-mode-p (mode) - "Is the major-mode in the current buffer equivalent to a mode in MODES." - (let ((modes nil)) - (while mode - (setq modes (cons mode modes) - mode (get-mode-local-parent mode))) - modes)) +(define-obsolete-function-alias 'mode-local-equivalent-mode-p + #'derived-mode-all-parents "30.1") (defun mode-local-map-mode-buffers (function modes) "Run FUNCTION on every file buffer with major mode in MODES. @@ -91,13 +84,7 @@ mode-local-map-mode-buffers FUNCTION does not have arguments." (setq modes (ensure-list modes)) (mode-local-map-file-buffers - function (lambda () - (let ((mm (mode-local-equivalent-mode-p major-mode)) - (ans nil)) - (while (and (not ans) mm) - (setq ans (memq (car mm) modes) - mm (cdr mm)) ) - ans)))) + function (lambda () (apply #'derived-mode-p modes)))) ;;; Hook machinery ;; @@ -145,7 +132,8 @@ mode-local--set-parent "Set parent of major mode MODE to PARENT mode. To work properly, this function should be called after PARENT mode local variables have been defined." - (put mode 'mode-local-parent parent) + (declare (obsolete derived-mode-add-parents "30.1")) + (derived-mode-add-parents mode (list parent)) ;; Refresh mode bindings to get mode local variables inherited from ;; PARENT. To work properly, the following should be called after ;; PARENT mode local variables have been defined. @@ -159,13 +147,8 @@ define-child-mode (declare (obsolete define-derived-mode "27.1") (indent 2)) `(mode-local--set-parent ',mode ',parent)) -(defun mode-local-use-bindings-p (this-mode desired-mode) - "Return non-nil if THIS-MODE can use bindings of DESIRED-MODE." - (let ((ans nil)) - (while (and (not ans) this-mode) - (setq ans (eq this-mode desired-mode)) - (setq this-mode (get-mode-local-parent this-mode))) - ans)) +(define-obsolete-function-alias 'mode-local-use-bindings-p + #'provided-mode-derived-p "30.1") ;;; Core bindings API @@ -270,11 +253,13 @@ mode-local-symbol (setq mode major-mode bind (and mode-local-symbol-table (intern-soft name mode-local-symbol-table)))) - (while (and mode (not bind)) - (or (and (get mode 'mode-local-symbol-table) - (setq bind (intern-soft - name (get mode 'mode-local-symbol-table)))) - (setq mode (get-mode-local-parent mode)))) + (let ((parents (derived-mode-all-parents mode))) + (while (and parents (not bind)) + (or (and (get (car parents) 'mode-local-symbol-table) + (setq bind (intern-soft + name (get (car parents) + 'mode-local-symbol-table)))) + (setq parents (cdr parents))))) bind)) (defsubst mode-local-symbol-value (symbol &optional mode property) @@ -311,16 +296,12 @@ mode-local--activate-bindings (mode-local-on-major-mode-change) ;; Do the normal thing. - (let (modes table old-locals) + (let (table old-locals) (unless mode (setq-local mode-local--init-mode major-mode) (setq mode major-mode)) - ;; Get MODE's parents & MODE in the right order. - (while mode - (setq modes (cons mode modes) - mode (get-mode-local-parent mode))) ;; Activate mode bindings following parent modes order. - (dolist (mode modes) + (dolist (mode (derived-mode-all-parents mode)) (when (setq table (get mode 'mode-local-symbol-table)) (mapatoms (lambda (var) @@ -345,14 +326,13 @@ mode-local--deactivate-bindings (kill-local-variable 'mode-local--init-mode) (setq mode major-mode)) (let (table) - (while mode + (dolist (mode (derived-mode-all-parents mode)) (when (setq table (get mode 'mode-local-symbol-table)) (mapatoms (lambda (var) (when (get var 'mode-variable-flag) (kill-local-variable (intern (symbol-name var))))) - table)) - (setq mode (get-mode-local-parent mode))))) + table))))) (defmacro with-mode-local-symbol (mode &rest body) "With the local bindings of MODE symbol, evaluate BODY. @@ -866,12 +846,11 @@ mode-local-describe-bindings-2 (when table (princ "\n- Buffer local\n") (mode-local-print-bindings table)) - (while mode + (dolist (mode (derived-mode-all-parents mode)) (setq table (get mode 'mode-local-symbol-table)) (when table (princ (format-message "\n- From `%s'\n" mode)) - (mode-local-print-bindings table)) - (setq mode (get-mode-local-parent mode))))) + (mode-local-print-bindings table))))) (defun mode-local-describe-bindings-1 (buffer-or-mode &optional interactive-p) "Display mode local bindings active in BUFFER-OR-MODE. diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 7c7ee749249..0c78493542f 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -799,7 +799,7 @@ semanticdb-equivalent-mode (null (oref table major-mode)) ;; nil means the same as major-mode (and (not semantic-equivalent-major-modes) - (mode-local-use-bindings-p major-mode (oref table major-mode))) + (provided-mode-derived-p major-mode (oref table major-mode))) (and semantic-equivalent-major-modes (member (oref table major-mode) semantic-equivalent-major-modes)) ) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 60c57210b8f..15ad18ad886 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -644,7 +644,7 @@ semantic-grammar--template-expand (cond (x (cdr x)) ((symbolp S) (symbol-value S)))))) - template "")) + template)) (defun semantic-grammar-header () "Return text of a generated standard header." diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 6a16845ecf2..35f09e7a784 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -434,8 +434,7 @@ semantic-lex-spp-one-token-to-txt (symbolp (car (car val)))) (mapconcat (lambda (subtok) (semantic-lex-spp-one-token-to-txt subtok)) - val - "")) + val)) ;; If val is nil, that's probably wrong. ;; Found a system header case where this was true. ((null val) "") @@ -699,8 +698,7 @@ semantic-lex-spp-symbol-merge (message "Invalid merge macro encountered; \ will return empty string instead.") ""))) - txt - "")) + txt)) (defun semantic-lex-spp-find-closing-macro () "Find next macro which closes a scope through a close-paren. diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index cfd64edfc98..6d64a26e46c 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el @@ -34,12 +34,12 @@ (defun srecode-table (&optional mode) "Return the currently active Semantic Recoder table for this buffer. Optional argument MODE specifies the mode table to use." - (let* ((modeq (or mode major-mode)) - (table (srecode-get-mode-table modeq))) + (let ((modes (derived-mode-all-parents (or mode major-mode))) + (table nil)) ;; If there isn't one, keep searching backwards for a table. - (while (and (not table) (setq modeq (get-mode-local-parent modeq))) - (setq table (srecode-get-mode-table modeq))) + (while (and modes (not (setq table (srecode-get-mode-table (car modes))))) + (setq modes (cdr modes))) ;; Last ditch effort. (when (not table) @@ -57,35 +57,23 @@ srecode-load-tables-for-mode See `srecode-get-maps' for more. APPNAME is the name of an application. In this case, all template files for that application will be loaded." - (let ((files - (apply #'append - (mapcar - (if appname + (dolist (mmode (cons 'default (reverse (derived-mode-all-parents mmode)))) + (let ((files + (apply #'append + (mapcar + (if appname + (lambda (map) + (srecode-map-entries-for-app-and-mode map appname mmode)) (lambda (map) - (srecode-map-entries-for-app-and-mode map appname mmode)) - (lambda (map) - (srecode-map-entries-for-mode map mmode))) - (srecode-get-maps)))) - ) - ;; Don't recurse if we are already the 'default state. - (when (not (eq mmode 'default)) - ;; Are we a derived mode? If so, get the parent mode's - ;; templates loaded too. - (if (get-mode-local-parent mmode) - (srecode-load-tables-for-mode (get-mode-local-parent mmode) - appname) - ;; No parent mode, all templates depend on the defaults being - ;; loaded in, so get that in instead. - (srecode-load-tables-for-mode 'default appname))) + (srecode-map-entries-for-mode map mmode))) + (srecode-get-maps))))) - ;; Load in templates for our major mode. - (dolist (f files) - (let ((mt (srecode-get-mode-table mmode)) - ) - (when (or (not mt) (not (srecode-mode-table-find mt (car f)))) - (srecode-compile-file (car f))) - )) - )) + ;; Load in templates for our major mode. + (when files + (let ((mt (srecode-get-mode-table mmode))) + (dolist (f files) + (when (not (and mt (srecode-mode-table-find mt (car f)))) + (srecode-compile-file (car f))))))))) ;;; PROJECT ;; @@ -227,12 +215,12 @@ srecode-all-template-hash Optional argument HASH is the hash table to fill in. Optional argument PREDICATE can be used to filter the returned templates." - (let* ((mhash (or hash (make-hash-table :test 'equal))) - (mmode (or mode major-mode)) - (parent-mode (get-mode-local-parent mmode))) - ;; Get the parent hash table filled into our current hash. - (unless (eq mode 'default) - (srecode-all-template-hash (or parent-mode 'default) mhash)) + (let* ((mhash (or hash (make-hash-table :test 'equal)))) + (dolist (mmode (cons 'default + ;; Get the parent hash table filled into our + ;; current hash. + (reverse (derived-mode-all-parents + (or mode major-mode))))) ;; Load up the hash table for our current mode. (let* ((mt (srecode-get-mode-table mmode)) @@ -246,7 +234,7 @@ srecode-all-template-hash (funcall predicate temp)) (puthash key temp mhash))) (oref tab namehash)))) - mhash))) + mhash)))) (defun srecode-calculate-default-template-string (hash) "Calculate the name of the template to use as a DEFAULT. diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index 004bb7adddb..44e465c69b1 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -76,7 +76,7 @@ srecode-map-entries-for-mode "Return the entries in MAP for major MODE." (let ((ans nil)) (dolist (f (oref map files)) - (when (mode-local-use-bindings-p mode (cdr f)) + (when (provided-mode-derived-p mode (cdr f)) (setq ans (cons f ans)))) ans)) diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index de151049f7f..e5ab53dd253 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -137,41 +137,36 @@ srecode-get-mode-table "Get the SRecoder mode table for the major mode MODE. This will find the mode table specific to MODE, and then calculate all inherited templates from parent modes." - (let ((table nil) - (tmptable nil)) - (while mode - (setq tmptable (eieio-instance-tracker-find - mode 'major-mode 'srecode-mode-table-list) - mode (get-mode-local-parent mode)) - (when tmptable - (if (not table) - (progn - ;; If this is the first, update tables to have - ;; all the mode specific tables in it. - (setq table tmptable) - (oset table tables (oref table modetables))) - ;; If there already is a table, then reset the tables - ;; slot to include all the tables belonging to this new child node. - (oset table tables (append (oref table modetables) - (oref tmptable modetables))))) - ) + (let ((table nil)) + (dolist (mode (derived-mode-all-parents mode)) + (let ((tmptable (eieio-instance-tracker-find + mode 'major-mode 'srecode-mode-table-list))) + (when tmptable + (if (not table) + (progn + ;; If this is the first, update tables to have + ;; all the mode specific tables in it. + (setq table tmptable) + (oset table tables (oref table modetables))) + ;; If there already is a table, then reset the tables + ;; slot to include all the tables belonging to this new child node. + (oset table tables (append (oref table modetables) + (oref tmptable modetables))))) + )) table)) (defun srecode-make-mode-table (mode) "Get the SRecoder mode table for the major mode MODE." (let ((old (eieio-instance-tracker-find mode 'major-mode 'srecode-mode-table-list))) - (if old - old - (let* ((ms (if (stringp mode) mode (symbol-name mode))) - (new (srecode-mode-table ms - :major-mode mode - :modetables nil - :tables nil))) - ;; Save this new mode table in that mode's variable. - (eval `(setq-mode-local ,mode srecode-table ,new) t) + (or old + (let* ((new (srecode-mode-table :major-mode mode + :modetables nil + :tables nil))) + ;; Save this new mode table in that mode's variable. + (eval `(setq-mode-local ,mode srecode-table ,new) t) - new)))) + new)))) (cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file) "Look in the mode table MT for a template table from FILE. diff --git a/lisp/locate.el b/lisp/locate.el index 63386e18ebb..caccf644c02 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -141,13 +141,11 @@ locate-command documentation of that program for the details about how it determines which file names match SEARCH-STRING. (Those details vary highly with the version.)" - :type 'string - :group 'locate) + :type 'string) (defcustom locate-post-command-hook nil "List of hook functions run after `locate' (see `run-hooks')." - :type 'hook - :group 'locate) + :type 'hook) (defvar locate-history-list nil "The history list used by the \\[locate] command.") @@ -162,13 +160,11 @@ locate-make-command-line and return a list of strings. The first element of the list should be the name of a command to be executed by a shell, the remaining elements should be the arguments to that command (including the name to find)." - :type 'function - :group 'locate) + :type 'function) (defcustom locate-buffer-name "*Locate*" "Name of the buffer to show results from the \\[locate] command." - :type 'string - :group 'locate) + :type 'string) (defcustom locate-fcodes-file nil "File name for the database of file names used by `locate'. @@ -179,20 +175,17 @@ locate-fcodes-file that `locate' searches. The executive program that the Emacs function `locate' uses, as given by the variables `locate-command' or `locate-make-command-line', determines the database." - :type '(choice (const :tag "None" nil) file) - :group 'locate) + :type '(choice (const :tag "None" nil) file)) (defcustom locate-header-face nil "Face used to highlight the locate header." - :type '(choice (const :tag "None" nil) face) - :group 'locate) + :type '(choice (const :tag "None" nil) face)) ;;;###autoload (defcustom locate-ls-subdir-switches (purecopy "-al") "`ls' switches for inserting subdirectories in `*Locate*' buffers. This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches." :type 'string - :group 'locate :version "22.1") (defcustom locate-update-when-revert nil @@ -202,13 +195,11 @@ locate-update-when-revert option `locate-update-path'.) If nil, reverting does not update the locate database." :type 'boolean - :group 'locate :version "22.1") (defcustom locate-update-command "updatedb" "The executable program used to update the locate database." - :type 'string - :group 'locate) + :type 'string) (defcustom locate-update-path "/" "The default directory from where `locate-update-command' is called. @@ -218,7 +209,6 @@ locate-update-path permissions are sufficient to run the command, you can set this option to \"/\"." :type 'string - :group 'locate :version "22.1") (defcustom locate-prompt-for-command nil @@ -227,13 +217,11 @@ locate-prompt-for-command Setting this option non-nil actually inverts the meaning of a prefix arg; that is, with a prefix arg, you get the default behavior." - :group 'locate :type 'boolean) (defcustom locate-mode-hook nil "List of hook functions run by `locate-mode' (see `run-mode-hooks')." - :type 'hook - :group 'locate) + :type 'hook) ;; Functions @@ -371,17 +359,17 @@ locate-filter-output (defvar locate-mode-map (let ((map (copy-keymap dired-mode-map))) ;; Undefine Useless Dired Menu bars - (define-key map [menu-bar Dired] 'undefined) - (define-key map [menu-bar subdir] 'undefined) - (define-key map [menu-bar mark executables] 'undefined) - (define-key map [menu-bar mark directory] 'undefined) - (define-key map [menu-bar mark directories] 'undefined) - (define-key map [menu-bar mark symlinks] 'undefined) - (define-key map [M-mouse-2] 'locate-mouse-view-file) - (define-key map "\C-c\C-t" 'locate-tags) - (define-key map "l" 'locate-do-redisplay) - (define-key map "U" 'dired-unmark-all-files) - (define-key map "V" 'locate-find-directory) + (define-key map [menu-bar Dired] #'undefined) + (define-key map [menu-bar subdir] #'undefined) + (define-key map [menu-bar mark executables] #'undefined) + (define-key map [menu-bar mark directory] #'undefined) + (define-key map [menu-bar mark directories] #'undefined) + (define-key map [menu-bar mark symlinks] #'undefined) + (define-key map [M-mouse-2] #'locate-mouse-view-file) + (define-key map "\C-c\C-t" #'locate-tags) + (define-key map "l" #'locate-do-redisplay) + (define-key map "U" #'dired-unmark-all-files) + (define-key map "V" #'locate-find-directory) map) "Local keymap for Locate mode buffers.") @@ -486,7 +474,7 @@ locate-mode (setq-local revert-buffer-function #'locate-update) (setq-local page-delimiter "\n\n")) -(put 'locate-mode 'derived-mode-parent 'dired-mode) +(derived-mode-add-parents 'locate-mode '(dired-mode special-mode)) (defun locate-do-setup (search-string) (goto-char (point-min)) commit 5afa55a946a0271c624359e9de5d62bcaf39729b Author: Stefan Monnier Date: Mon Nov 6 16:57:05 2023 -0500 subr.el: Add multiple inheritance to `derived-mode-p` Add the ability for a major mode to declare "extra parents" in addition to the one from which it inherits. * lisp/subr.el (derived-mode-add-parents): New function. (derived-mode-all-parents): Adjust accordingly. diff --git a/lisp/subr.el b/lisp/subr.el index 16f327ff699..b000787a5d6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2688,22 +2688,37 @@ derived-mode-all-parents (if (memq mode known-children) (error "Cycle in the major mode hierarchy: %S" mode) (push mode known-children)) - (let* ((parent (or (get mode 'derived-mode-parent) + ;; The mode hierarchy (or DAG, actually), is very static, but we + ;; need to react to changes because `parent' may not be defined + ;; yet (e.g. it's still just an autoload), so the recursive call + ;; to `derived-mode-all-parents' may return an + ;; invalid/incomplete result which we'll need to update when the + ;; mode actually gets loaded. + (let* ((all-parents + (lambda (parent) + ;; Can't use `cl-lib' here (nor `gv') :-( + ;;(cl-assert (not (equal parent mode))) + ;;(cl-pushnew mode (get parent 'derived-mode--followers)) + (let ((followers (get parent 'derived-mode--followers))) + (unless (memq mode followers) + (put parent 'derived-mode--followers + (cons mode followers)))) + (derived-mode-all-parents parent known-children))) + (parent (or (get mode 'derived-mode-parent) ;; If MODE is an alias, then follow the alias. (let ((alias (symbol-function mode))) - (and (symbolp alias) alias))))) + (and (symbolp alias) alias)))) + (parents (cons mode (if parent (funcall all-parents parent)))) + (extras (get mode 'derived-mode-extra-parents))) (put mode 'derived-mode--all-parents - (cons mode - (when parent - ;; Can't use `cl-lib' here (nor `gv') :-( - ;;(cl-assert (not (equal parent mode))) - ;;(cl-pushnew mode (get parent 'derived-mode--followers)) - (let ((followers (get parent 'derived-mode--followers))) - (unless (memq mode followers) - (put parent 'derived-mode--followers - (cons mode followers)))) - (derived-mode-all-parents - parent known-children)))))))) + (if (null extras) ;; Common case. + parents + (delete-dups + (apply #'append + parents (mapcar (lambda (extra) + (copy-sequence + (funcall all-parents extra))) + extras))))))))) (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. @@ -2715,8 +2730,7 @@ provided-mode-derived-p (car ps))) (defun derived-mode-p (&rest modes) - "Non-nil if the current major mode is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards." + "Non-nil if the current major mode is derived from one of MODES." (declare (side-effect-free t)) (apply #'provided-mode-derived-p major-mode modes)) @@ -2725,6 +2739,13 @@ derived-mode-set-parent (put mode 'derived-mode-parent parent) (derived-mode--flush mode)) +(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." + (put mode 'derived-mode-extra-parents extra-parents) + (derived-mode--flush mode)) + (defun derived-mode--flush (mode) (put mode 'derived-mode--all-parents nil) (let ((followers (get mode 'derived-mode--followers))) commit 492920dd5b469e18596a49a62fbefd8ad2cc518b Author: Stefan Monnier Date: Wed Nov 8 22:53:39 2023 -0500 Use new `derived-mode-all/set-parents` functions. Try and avoid using the `derived-mode-parent` property directly and use the new API functions instead. * lisp/emacs-lisp/derived.el (define-derived-mode): Use `derived-mode-set-parent`. * lisp/loadhist.el (unload--set-major-mode): * lisp/info-look.el (info-lookup-select-mode): * lisp/ibuf-ext.el (ibuffer-list-buffer-modes): * lisp/files.el (dir-locals--get-sort-score): * lisp/emacs-lisp/cl-generic.el (cl--generic-derived-specializers): Use `derived-mode-all-parents`. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 5346678dab0..56eb83e6f75 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1391,11 +1391,8 @@ cl-generic-generalizers (defun cl--generic-derived-specializers (mode &rest _) ;; FIXME: Handle (derived-mode ... ) - (let ((specializers ())) - (while mode - (push `(derived-mode ,mode) specializers) - (setq mode (get mode 'derived-mode-parent))) - (nreverse specializers))) + (mapcar (lambda (mode) `(derived-mode ,mode)) + (derived-mode-all-parents mode))) (cl-generic-define-generalizer cl--generic-derived-generalizer 90 (lambda (name) `(and (symbolp ,name) (functionp ,name) ,name)) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index b35994364a7..dec5883767d 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -240,7 +240,9 @@ define-derived-mode (unless (get ',abbrev 'variable-documentation) (put ',abbrev 'variable-documentation (purecopy ,(format "Abbrev table for `%s'." child)))))) - (put ',child 'derived-mode-parent ',parent) + (if (fboundp 'derived-mode-set-parent) ;; Emacs≥30.1 + (derived-mode-set-parent ',child ',parent) + (put ',child 'derived-mode-parent ',parent)) ,(if group `(put ',child 'custom-mode-group ,group)) (defun ,child () diff --git a/lisp/files.el b/lisp/files.el index 3d838cd3b8c..d729bdf8c25 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -228,7 +228,7 @@ small-temporary-file-directory by programs that create small temporary files. This is for systems that have fast storage with limited space, such as a RAM disk." :group 'files - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :type '(choice (const nil) directory)) ;; The system null device. (Should reference NULL_DEVICE from C.) @@ -434,7 +434,7 @@ auto-save-file-name-transforms ,@(mapcar (lambda (algo) (list 'const algo)) (secure-hash-algorithms))))) - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :version "21.1") (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.") @@ -1296,7 +1296,7 @@ file-remote-p (defcustom remote-shell-program (or (executable-find "ssh") "ssh") "Program to use to execute commands on a remote host (i.e. ssh)." :version "29.1" - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :group 'environment :type 'file) @@ -4585,12 +4585,7 @@ dir-locals--get-sort-score variables will override modes." (let ((key (car node))) (cond ((null key) -1) - ((symbolp key) - (let ((mode key) - (depth 0)) - (while (setq mode (get mode 'derived-mode-parent)) - (setq depth (1+ depth))) - depth)) + ((symbolp key) (length (derived-mode-all-parents key))) ((stringp key) (+ 1000 (length key))) (t -2)))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e93c535bbef..e723d97cfc2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -742,6 +742,7 @@ help-fns--signature (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 parent-mode diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 37065f5d41a..70c7516f903 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -400,9 +400,9 @@ ibuffer-auto-mode (error "This buffer is not in Ibuffer mode")) (cond (ibuffer-auto-mode (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector - (add-hook 'post-command-hook 'ibuffer-auto-update-changed)) + (add-hook 'post-command-hook #'ibuffer-auto-update-changed)) (t - (remove-hook 'post-command-hook 'ibuffer-auto-update-changed)))) + (remove-hook 'post-command-hook #'ibuffer-auto-update-changed)))) (defun ibuffer-auto-update-changed () (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) @@ -557,7 +557,7 @@ eval (list (read--expression "Eval in buffers (form): ")) :opstring "evaluated in" :modifier-p :maybe) - (eval form)) + (eval form t)) ;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext") (define-ibuffer-op view-and-eval (form) @@ -575,7 +575,7 @@ view-and-eval (unwind-protect (progn (switch-to-buffer buf) - (eval form)) + (eval form t)) (switch-to-buffer ibuffer-buf)))) ;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext") @@ -1185,10 +1185,12 @@ ibuffer-format-qualifier-1 (concat " [filter: " (cdr qualifier) "]")) ('or (concat " [OR" (mapconcat #'ibuffer-format-qualifier - (cdr qualifier) "") "]")) + (cdr qualifier)) + "]")) ('and (concat " [AND" (mapconcat #'ibuffer-format-qualifier - (cdr qualifier) "") "]")) + (cdr qualifier)) + "]")) (_ (let ((type (assq (car qualifier) ibuffer-filtering-alist))) (unless qualifier @@ -1202,11 +1204,12 @@ ibuffer-list-buffer-modes If INCLUDE-PARENTS is non-nil then include parent modes." (let ((modes)) (dolist (buf (buffer-list)) - (let ((this-mode (buffer-local-value 'major-mode buf))) - (while (and this-mode (not (memq this-mode modes))) - (push this-mode modes) - (setq this-mode (and include-parents - (get this-mode 'derived-mode-parent)))))) + (let ((this-modes (derived-mode-all-parents + (buffer-local-value 'major-mode buf)))) + (while (and this-modes (not (memq (car this-modes) modes))) + (push (car this-modes) modes) + (setq this-modes (and include-parents + (cdr this-modes)))))) (mapcar #'symbol-name modes))) @@ -1391,7 +1394,7 @@ predicate (:description "predicate" :reader (read-minibuffer "Filter by predicate (form): ")) (with-current-buffer buf - (eval qualifier))) + (eval qualifier t))) ;;;###autoload (autoload 'ibuffer-filter-chosen-by-completion "ibuf-ext") (defun ibuffer-filter-chosen-by-completion () @@ -1508,7 +1511,7 @@ ibuffer-bs-show "Emulate `bs-show' from the bs.el package." (interactive) (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t) - (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all)) + (define-key (current-local-map) "a" #'ibuffer-bs-toggle-all)) (defun ibuffer-bs-toggle-all () "Emulate `bs-toggle-show-all' from the bs.el package." @@ -1746,7 +1749,7 @@ ibuffer-copy-filename-as-kill (t (file-name-nondirectory name)))))) buffers)) (string - (mapconcat 'identity (delete "" file-names) " "))) + (mapconcat #'identity (delete "" file-names) " "))) (unless (string= string "") (if (eq last-command 'kill-region) (kill-append string nil) diff --git a/lisp/info-look.el b/lisp/info-look.el index eeb758e5b85..8653a292a16 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -53,13 +53,13 @@ info-lookup-mode (make-variable-buffer-local 'info-lookup-mode) (defcustom info-lookup-other-window-flag t - "Non-nil means pop up the Info buffer in another window." - :group 'info-lookup :type 'boolean) + "Non-nil means pop up the Info buffer in another window." + :type 'boolean) (defcustom info-lookup-highlight-face 'match "Face for highlighting looked up help items. Setting this variable to nil disables highlighting." - :group 'info-lookup :type 'face) + :type 'face) (defvar info-lookup-highlight-overlay nil "Overlay object used for highlighting.") @@ -73,7 +73,7 @@ info-lookup-file-name-alist If a file name matches REGEXP, then use help mode MODE instead of the buffer's major mode." - :group 'info-lookup :type '(repeat (cons (regexp :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (symbol :tag "Mode")))) (defvar info-lookup-history nil @@ -167,13 +167,13 @@ info-lookup-add-help If no topic or mode option has been specified, then the help topic defaults to `symbol', and the help mode defaults to the current major mode." - (apply 'info-lookup-add-help* nil arg)) + (apply #'info-lookup-add-help* nil arg)) (defun info-lookup-maybe-add-help (&rest arg) "Add a help specification if none is defined. See the documentation of the function `info-lookup-add-help' for more details." - (apply 'info-lookup-add-help* t arg)) + (apply #'info-lookup-add-help* t arg)) (defun info-lookup-add-help* (maybe &rest arg) (let (topic mode regexp ignore-case doc-spec @@ -349,18 +349,18 @@ info-lookup-select-mode (setq file-name-alist (cdr file-name-alist))))) ;; If major-mode has no setups in info-lookup-alist, under any topic, then - ;; search up through derived-mode-parent to find a parent mode which does - ;; have some setups. This means that a `define-derived-mode' with no + ;; search up through `derived-mode-all-parents' to find a parent mode which + ;; does have some setups. This means that a `define-derived-mode' with no ;; setups of its own will select its parent mode for lookups, if one of ;; its parents has some setups. Good for example on `makefile-gmake-mode' ;; and similar derivatives of `makefile-mode'. ;; - (let ((mode major-mode)) ;; Look for `mode' with some setups. - (while (and mode (not info-lookup-mode)) + (let ((modes (derived-mode-all-parents major-mode))) ;; Look for `mode' with some setups. + (while (and modes (not info-lookup-mode)) (dolist (topic-cell info-lookup-alist) ;; Usually only two topics here. - (if (info-lookup->mode-value (car topic-cell) mode) - (setq info-lookup-mode mode))) - (setq mode (get mode 'derived-mode-parent)))) + (if (info-lookup->mode-value (car topic-cell) (car modes)) + (setq info-lookup-mode (car modes)))) + (setq modes (cdr modes)))) (or info-lookup-mode (setq info-lookup-mode major-mode))) @@ -526,7 +526,7 @@ info-lookup-setup-mode (nconc (condition-case nil (info-lookup-make-completions topic mode) (error nil)) - (apply 'append + (apply #'append (mapcar (lambda (arg) (info-lookup->completions topic arg)) refer-modes)))) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 3800ea70ea4..8a571661e89 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -149,14 +149,14 @@ unload--set-major-mode (save-current-buffer (dolist (buffer (buffer-list)) (set-buffer buffer) - (let ((proposed major-mode)) + (let ((proposed (derived-mode-all-parents major-mode))) ;; Look for a predecessor mode not defined in the feature we're processing - (while (and proposed (rassq proposed unload-function-defs-list)) - (setq proposed (get proposed 'derived-mode-parent))) - (unless (eq proposed major-mode) + (while (and proposed (rassq (car proposed) unload-function-defs-list)) + (setq proposed (cdr proposed))) + (unless (eq (car proposed) major-mode) ;; Two cases: either proposed is nil, and we want to switch to fundamental ;; mode, or proposed is not nil and not major-mode, and so we use it. - (funcall (or proposed 'fundamental-mode))))))) + (funcall (or (car proposed) 'fundamental-mode))))))) (defvar loadhist-unload-filename nil) diff --git a/lisp/so-long.el b/lisp/so-long.el index b7cfce31173..e5f7b81e717 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -783,8 +783,7 @@ so-long-file-local-mode-function :package-version '(so-long . "1.0")) (make-variable-buffer-local 'so-long-file-local-mode-function) -;; `provided-mode-derived-p' was added in 26.1 -(unless (fboundp 'provided-mode-derived-p) +(unless (fboundp 'provided-mode-derived-p) ;Only in Emacs≥26.1 (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards. commit 9c6b22bb3e2126a1ab355b81ae4268ac53c2b6fe Author: Stefan Monnier Date: Wed Nov 8 14:20:09 2023 -0500 (derived-mode-all-parents): Speed up with a cache Most uses of the mode hierarchy don't really need to construct the list, they just need to iterate over it. With single inheritance we could do it just by jumping up from a mode to its parent, but to support the upcoming multiple inheritance we'd need a more complex and costly iterator. Luckily, the inheritance graph is mostly static so we can cache the list of all parents, making `derived-mode-all-parents` cheap enough to be the basis of iteration and keeping the API very simple. * lisp/subr.el (derived-mode-all-parents): Cache the result. (derived-mode--flush): New function. (derived-mode-set-parent): Use it. diff --git a/lisp/subr.el b/lisp/subr.el index 6a4c1abfb62..16f327ff699 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2682,14 +2682,28 @@ derived-mode-all-parents "Return all the parents of MODE, starting with MODE. The returned list is not fresh, don't modify it. \n(fn MODE)" ;`known-children' is for internal use only. - (if (memq mode known-children) - (error "Cycle in the major mode hierarchy: %S" mode) - (push mode known-children)) - (let* ((parent (or (get mode 'derived-mode-parent) - ;; If MODE is an alias, then follow the alias. - (let ((alias (symbol-function mode))) - (and (symbolp alias) alias))))) - (cons mode (if parent (derived-mode-all-parents parent known-children))))) + ;; Can't use `with-memoization' :-( + (let ((ps (get mode 'derived-mode--all-parents))) + (if ps ps + (if (memq mode known-children) + (error "Cycle in the major mode hierarchy: %S" mode) + (push mode known-children)) + (let* ((parent (or (get mode 'derived-mode-parent) + ;; If MODE is an alias, then follow the alias. + (let ((alias (symbol-function mode))) + (and (symbolp alias) alias))))) + (put mode 'derived-mode--all-parents + (cons mode + (when parent + ;; Can't use `cl-lib' here (nor `gv') :-( + ;;(cl-assert (not (equal parent mode))) + ;;(cl-pushnew mode (get parent 'derived-mode--followers)) + (let ((followers (get parent 'derived-mode--followers))) + (unless (memq mode followers) + (put parent 'derived-mode--followers + (cons mode followers)))) + (derived-mode-all-parents + parent known-children)))))))) (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. @@ -2708,7 +2722,15 @@ derived-mode-p (defun derived-mode-set-parent (mode parent) "Declare PARENT to be the parent of MODE." - (put mode 'derived-mode-parent parent)) + (put mode 'derived-mode-parent parent) + (derived-mode--flush mode)) + +(defun derived-mode--flush (mode) + (put mode 'derived-mode--all-parents nil) + (let ((followers (get mode 'derived-mode--followers))) + (when followers ;; Common case. + (put mode 'derived-mode--followers nil) + (mapc #'derived-mode--flush followers)))) (defvar-local major-mode--suspended nil) (put 'major-mode--suspended 'permanent-local t) commit 19445b6b7bb04e44e39ef2e39a620bd3eadb0acd Author: Stefan Monnier Date: Wed Nov 8 11:32:27 2023 -0500 subr.el: Provide a functional API around `derived-mode-parent` The `derived-mode-parent` property should be an implementation detail, so we can change it more easily. To that end, add functions to set and query it. * lisp/subr.el (derived-mode-all-parents): New function. (provided-mode-derived-p): Use it. (derived-mode-set-parent): New function. diff --git a/lisp/subr.el b/lisp/subr.el index d4173b4daba..6a4c1abfb62 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2678,20 +2678,27 @@ while-let ;; PUBLIC: find if the current mode derives from another. +(defun derived-mode-all-parents (mode &optional known-children) + "Return all the parents of MODE, starting with MODE. +The returned list is not fresh, don't modify it. +\n(fn MODE)" ;`known-children' is for internal use only. + (if (memq mode known-children) + (error "Cycle in the major mode hierarchy: %S" mode) + (push mode known-children)) + (let* ((parent (or (get mode 'derived-mode-parent) + ;; If MODE is an alias, then follow the alias. + (let ((alias (symbol-function mode))) + (and (symbolp alias) alias))))) + (cons mode (if parent (derived-mode-all-parents parent known-children))))) + (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." (declare (side-effect-free t)) - (while - (and - (not (memq mode modes)) - (let* ((parent (get mode 'derived-mode-parent))) - (setq mode (or parent - ;; If MODE is an alias, then follow the alias. - (let ((alias (symbol-function mode))) - (and (symbolp alias) alias))))))) - mode) + (let ((ps (derived-mode-all-parents mode))) + (while (and ps (not (memq (car ps) modes))) + (setq ps (cdr ps))) + (car ps))) (defun derived-mode-p (&rest modes) "Non-nil if the current major mode is derived from one of MODES. @@ -2699,6 +2706,10 @@ derived-mode-p (declare (side-effect-free t)) (apply #'provided-mode-derived-p major-mode modes)) +(defun derived-mode-set-parent (mode parent) + "Declare PARENT to be the parent of MODE." + (put mode 'derived-mode-parent parent)) + (defvar-local major-mode--suspended nil) (put 'major-mode--suspended 'permanent-local t) commit 21f36705266934d5a351d4d7f360734540132139 Author: Po Lu Date: Thu Nov 9 10:12:24 2023 +0800 Guarantee files are auto-saved when Emacs is terminated by Android * java/org/gnu/emacs/EmacsNative.java (shutDownEmacs): * java/org/gnu/emacs/EmacsService.java (onDestroy): New function. When invoked, call shut_down_emacs and await its completion. * src/android.c (android_shut_down_emacs, shutDownEmacs): New functions. diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index f15927bb3a7..946a38f7f84 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -92,6 +92,10 @@ public static native void setEmacsParams (AssetManager assetManager, loadup.el itself. */ public static native void initEmacs (String argv[], String dumpFile); + /* Call shut_down_emacs to auto-save and unlock files in the main + thread, then return. */ + public static native void shutDownEmacs (); + /* Abort and generate a native core dump. */ public static native void emacsAbort (); diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 1325cd85e9b..ab6d57b9c4f 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -321,6 +321,18 @@ invocation of app_process (through android-emacs) can } } + @Override + public void + onDestroy () + { + /* This function is called immediately before the system kills + Emacs. In this respect, it is rather akin to a SIGDANGER + signal, so force an auto-save accordingly. */ + + EmacsNative.shutDownEmacs (); + super.onDestroy (); + } + /* Functions from here on must only be called from the Emacs diff --git a/src/android.c b/src/android.c index 3397ec0e740..f5af742b422 100644 --- a/src/android.c +++ b/src/android.c @@ -1938,6 +1938,25 @@ NATIVE_NAME (quit) (JNIEnv *env, jobject object) kill (getpid (), SIGIO); } +/* Call shut_down_emacs subsequent to a call to the service's + onDestroy callback. CLOSURE is ignored. */ + +static void +android_shut_down_emacs (void *closure) +{ + __android_log_print (ANDROID_LOG_INFO, __func__, + "The Emacs service is being shut down"); + shut_down_emacs (0, Qnil); +} + +JNIEXPORT void JNICALL +NATIVE_NAME (shutDownEmacs) (JNIEnv *env, jobject object) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + android_run_in_emacs_thread (android_shut_down_emacs, NULL); +} + JNIEXPORT jlong JNICALL NATIVE_NAME (sendConfigureNotify) (JNIEnv *env, jobject object, jshort window, jlong time, commit b7871cefe7b94ac6a6a4fd561d41af00ae3d3578 Author: Stephen Berman Date: Thu Nov 9 00:13:06 2023 +0100 Prevent an infinite loop in todo-mode (bug#66994) * lisp/calendar/todo-mode.el (todo-item-start): Moving an item to a todo file (with `C-u m') that had not yet been read into a buffer puts point at the beginning of the file, from where it is impossible to reach todo-item-start by this function, so don't try in that case. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index ad18e8f035e..393dd1851f3 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -5240,7 +5240,12 @@ todo-item-start ;; Point is on done items separator. (save-excursion (beginning-of-line) (looking-at todo-category-done)) ;; Buffer is widened. - (looking-at (regexp-quote todo-category-beg))) + (looking-at (regexp-quote todo-category-beg)) + ;; Moving an item to a todo file (with `C-u m') that had + ;; not yet been read into a buffer puts point at the + ;; beginning of the file, from where it is impossible to + ;; reach todo-item-start by the loop below (bug#66994). + (= (point) 1)) (goto-char (line-beginning-position)) (while (not (looking-at todo-item-start)) (forward-line -1)) commit 06e4ebc81a44c709b08ce72c746629c6c77e6f6e Author: Alan Mackenzie Date: Wed Nov 8 20:49:48 2023 +0000 With `native-compile', compile lambdas in a defun or lambda too This fixes bug#64646. Also refactor two functions to reduce code duplication. * lisp/emacs-lisp/comp.el (comp-spill-lap-function/symbol) (comp-spill-lap-function/list): Add all functions found by the byte compiler (including lambdas) to the native compiler's context, thus making them be native compiled. Refactor to use comp-intern-func-in-ctxt. Make comp-spill-lap-function/list also compile closures. * test/src/comp-resources/comp-test-funcs.el (comp-tests-lambda-return-f2): New function * test/src/comp-tests.el (comp-test-lambda-return2) (comp-tests-free-fun-f2): New functions to test that internal lambdas get native compiled. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 7fd9543d2ba..ba64bae599a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1316,86 +1316,31 @@ comp-spill-lap-function nil ".eln"))) (let* ((f (symbol-function function-name)) (byte-code (byte-compile function-name)) - (c-name (comp-c-func-name function-name "F")) - (func - (if (comp-lex-byte-func-p byte-code) - (make-comp-func-l :name function-name - :c-name c-name - :doc (documentation f t) - :int-spec (interactive-form f) - :command-modes (command-modes f) - :speed (comp-spill-speed function-name) - :pure (comp-spill-decl-spec function-name - 'pure)) - (make-comp-func-d :name function-name - :c-name c-name - :doc (documentation f t) - :int-spec (interactive-form f) - :command-modes (command-modes f) - :speed (comp-spill-speed function-name) - :pure (comp-spill-decl-spec function-name - 'pure))))) + (c-name (comp-c-func-name function-name "F"))) (when (byte-code-function-p f) (signal 'native-compiler-error '("can't native compile an already byte-compiled function"))) - (setf (comp-func-byte-func func) byte-code) - (let ((lap (byte-to-native-lambda-lap - (gethash (aref (comp-func-byte-func func) 1) - byte-to-native-lambdas-h)))) - (cl-assert lap) - (comp-log lap 2 t) - (if (comp-func-l-p func) - (let ((arg-list (aref (comp-func-byte-func func) 0))) - (setf (comp-func-l-args func) - (comp-decrypt-arg-list arg-list function-name))) - (setf (comp-func-d-lambda-list func) (cadr f))) - (setf (comp-func-lap func) - lap - (comp-func-frame-size func) - (comp-byte-frame-size (comp-func-byte-func func)) - (comp-ctxt-top-level-forms comp-ctxt) + (setf (comp-ctxt-top-level-forms comp-ctxt) (list (make-byte-to-native-func-def :name function-name - :c-name c-name))) - (comp-add-func-to-ctxt func)))) + :c-name c-name + :byte-func byte-code))) + (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) (cl-defmethod comp-spill-lap-function ((form list)) "Byte-compile FORM, spilling data from the byte compiler." - (unless (eq (car-safe form) 'lambda) + (unless (memq (car-safe form) '(lambda closure)) (signal 'native-compiler-error - '("Cannot native-compile, form is not a lambda"))) + '("Cannot native-compile, form is not a lambda or closure"))) (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (make-temp-file "comp-lambda-" nil ".eln"))) (let* ((byte-code (byte-compile form)) - (c-name (comp-c-func-name "anonymous-lambda" "F")) - (func (if (comp-lex-byte-func-p byte-code) - (make-comp-func-l :c-name c-name - :doc (documentation form t) - :int-spec (interactive-form form) - :command-modes (command-modes form) - :speed (comp-ctxt-speed comp-ctxt)) - (make-comp-func-d :c-name c-name - :doc (documentation form t) - :int-spec (interactive-form form) - :command-modes (command-modes form) - :speed (comp-ctxt-speed comp-ctxt))))) - (let ((lap (byte-to-native-lambda-lap - (gethash (aref byte-code 1) - byte-to-native-lambdas-h)))) - (cl-assert lap) - (comp-log lap 2 t) - (if (comp-func-l-p func) - (setf (comp-func-l-args func) - (comp-decrypt-arg-list (aref byte-code 0) byte-code)) - (setf (comp-func-d-lambda-list func) (cadr form))) - (setf (comp-func-lap func) lap - (comp-func-frame-size func) (comp-byte-frame-size - byte-code)) - (setf (comp-func-byte-func func) byte-code - (comp-ctxt-top-level-forms comp-ctxt) + (c-name (comp-c-func-name "anonymous-lambda" "F"))) + (setf (comp-ctxt-top-level-forms comp-ctxt) (list (make-byte-to-native-func-def :name '--anonymous-lambda - :c-name c-name))) - (comp-add-func-to-ctxt func)))) + :c-name c-name + :byte-func byte-code))) + (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) (defun comp-intern-func-in-ctxt (_ obj) "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 6d0cb353513..85282e4dc97 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -242,6 +242,10 @@ comp-tests-buff0-f (defun comp-tests-lambda-return-f () (lambda (x) (1+ x))) +(defun comp-tests-lambda-return-f2 () + (lambda () + (lambda (x) (1+ x)))) + (defun comp-tests-fib-f (n) (cond ((= n 0) 0) ((= n 1) 1) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 2b3c3dd4c75..c2f0af51570 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -327,6 +327,14 @@ lambda-return (should (subr-native-elisp-p f)) (should (= (funcall f 3) 4)))) +(comp-deftest lambda-return2 () + "Check a nested lambda function gets native compiled." + (let ((f (comp-tests-lambda-return-f2))) + (should (subr-native-elisp-p f)) + (let ((f2 (funcall f))) + (should (subr-native-elisp-p f2)) + (should (= (funcall f2 3) 4))))) + (comp-deftest recursive () (should (= (comp-tests-fib-f 10) 55))) @@ -388,7 +396,27 @@ free-fun "Some doc.")) (should (commandp #'comp-tests-free-fun-f)) (should (equal (interactive-form #'comp-tests-free-fun-f) - '(interactive)))) + '(interactive nil)))) + +(declare-function comp-tests-free-fun-f2 nil) + +(comp-deftest free-fun2 () + "Check compiling a symbol's function compiles contained lambdas." + (eval '(defun comp-tests-free-fun-f2 () + (lambda (x) + "Some doc." + (interactive) + x))) + (native-compile #'comp-tests-free-fun-f2) + + (let* ((f (symbol-function 'comp-tests-free-fun-f2)) + (f2 (funcall f))) + (should (subr-native-elisp-p f)) + (should (subr-native-elisp-p f2)) + (should (string= (documentation f2) "Some doc.")) + (should (commandp f2)) + (should (equal (interactive-form f2) '(interactive nil))) + (should (= (funcall f2 3) 3)))) (declare-function comp-tests/free\fun-f nil) commit fa8cc4c9ee271d88d52f2573d7d1ef54c7d0ca8e Author: Randy Taylor Date: Tue Oct 31 22:08:25 2023 -0400 Fix cmake-ts-mode indentation (Bug#66845) * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode--indent-rules): Support versions v0.3.0 and v0.4.0 of the grammar. (cmake-ts-mode--font-lock-compatibility-fe9b5e0): Fix docstring. diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 53d471c381a..8fcdcaddc7b 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -63,7 +63,15 @@ cmake-ts-mode--indent-rules ((parent-is "foreach_loop") parent-bol cmake-ts-mode-indent-offset) ((parent-is "function_def") parent-bol cmake-ts-mode-indent-offset) ((parent-is "if_condition") parent-bol cmake-ts-mode-indent-offset) - ((parent-is "normal_command") parent-bol cmake-ts-mode-indent-offset))) + ((parent-is "normal_command") parent-bol cmake-ts-mode-indent-offset) + ;;; Release v0.4.0 wraps arguments in an argument_list node. + ,@(ignore-errors + (treesit-query-capture 'cmake '((argument_list) @capture)) + `(((parent-is "argument_list") grand-parent cmake-ts-mode-indent-offset))) + ;;; Release v0.3.0 wraps the body of commands into a body node. + ,@(ignore-errors + (treesit-query-capture 'cmake '((body) @capture)) + `(((parent-is "body") grand-parent cmake-ts-mode-indent-offset))))) "Tree-sitter indent rules for `cmake-ts-mode'.") (defvar cmake-ts-mode--constants @@ -89,8 +97,8 @@ cmake-ts-mode--if-conditions "CMake if conditions for tree-sitter font-locking.") (defun cmake-ts-mode--font-lock-compatibility-fe9b5e0 () - "Indent rules helper, to handle different releases of tree-sitter-cmake. -Check if a node type is available, then return the right indent rules." + "Font lock helper, to handle different releases of tree-sitter-cmake. +Check if a node type is available, then return the right font lock rules." ;; handle commit fe9b5e0 (condition-case nil (progn (treesit-query-capture 'cmake '((argument_list) @capture)) commit bf9cbc2354124a1e9eb3327007468ba384ba2945 Author: Philip Kaludercic Date: Wed Nov 1 22:34:28 2023 +0100 Simplify 'project-remember-projects-under' * lisp/progmodes/project.el (project-remember-projects-under): Instead of traversing the directories manually, re-use `directory-files-recursively' to reduce complexity. (Bug#66649) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index a6426c08840..95db9d0ef4c 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1866,35 +1866,28 @@ project-remember-projects-under projects." (interactive "DDirectory: \nP") (project--ensure-read-project-list) - (let ((queue (list dir)) - (count 0) - (known (make-hash-table - :size (* 2 (length project--list)) - :test #'equal ))) + (let ((dirs (if recursive + (directory-files-recursively dir "" t) + (directory-files dir t))) + (known (make-hash-table :size (* 2 (length project--list)) + :test #'equal)) + (count 0)) (dolist (project (mapcar #'car project--list)) (puthash project t known)) - (while queue - (when-let ((subdir (pop queue)) - ((file-directory-p subdir))) - (when-let ((project (project--find-in-directory subdir)) - (project-root (project-root project)) - ((not (gethash project-root known)))) - (project-remember-project project t) - (puthash project-root t known) - (message "Found %s..." project-root) - (setq count (1+ count))) - (when (and recursive (file-directory-p subdir)) - (setq queue - (nconc - (directory-files - subdir t directory-files-no-dot-files-regexp t) - queue))))) - (unless (eq recursive 'in-progress) - (if (zerop count) - (message "No projects were found") - (project--write-project-list) - (message "%d project%s were found" - count (if (= count 1) "" "s")))) + (dolist (subdir dirs) + (when-let (((file-directory-p subdir)) + (project (project--find-in-directory subdir)) + (project-root (project-root project)) + ((not (gethash project-root known)))) + (project-remember-project project t) + (puthash project-root t known) + (message "Found %s..." project-root) + (setq count (1+ count)))) + (if (zerop count) + (message "No projects were found") + (project--write-project-list) + (message "%d project%s were found" + count (if (= count 1) "" "s"))) count)) (defun project-forget-zombie-projects () commit 01912a0679ea3feb48fdde4dab372c056bce446e Author: Juri Linkov Date: Wed Nov 8 09:38:35 2023 +0200 * lisp/minibuffer.el (minibuffer-choose-completion-or-exit): New command. (minibuffer-visible-completions-map): Bind it to "RET". https://lists.gnu.org/archive/html/emacs-devel/2023-11/msg00246.html diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7a791fafaa6..bf1e014319e 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3000,7 +3000,7 @@ minibuffer-visible-completions-map "" (minibuffer-visible-completions-bind #'minibuffer-next-completion) "" (minibuffer-visible-completions-bind #'minibuffer-previous-line-completion) "" (minibuffer-visible-completions-bind #'minibuffer-next-line-completion) - "RET" (minibuffer-visible-completions-bind #'minibuffer-choose-completion) + "RET" (minibuffer-visible-completions-bind #'minibuffer-choose-completion-or-exit) "C-g" (minibuffer-visible-completions-bind #'minibuffer-hide-completions)) @@ -4682,10 +4682,20 @@ minibuffer-choose-completion If NO-QUIT is non-nil, insert the completion candidate at point to the minibuffer, but don't quit the completions window." (interactive "P") - (with-minibuffer-completions-window + (with-minibuffer-completions-window (let ((completion-use-base-affixes t)) (choose-completion nil no-exit no-quit)))) +(defun minibuffer-choose-completion-or-exit (&optional no-exit no-quit) + "Choose the completion from the minibuffer or exit the minibuffer. +When `minibuffer-choose-completion' can't find a completion candidate +in the completions window, then exit the minibuffer using its present +contents." + (interactive "P") + (condition-case nil + (minibuffer-choose-completion no-exit no-quit) + (error (exit-minibuffer)))) + (defun minibuffer-complete-history () "Complete the minibuffer history as far as possible. Like `minibuffer-complete' but completes on the history items commit 089b7d4e6281f47fae51668ce6947aad24e34b76 Author: Po Lu Date: Wed Nov 8 11:03:57 2023 +0800 Don't leave point amid text conversion edits if auto-fill transpires * lisp/simple.el (analyze-text-conversion): Save point in old-point after auto-fill completes, so that point-moved is not set if point remains intact subsequent to the execution of both hooks. diff --git a/lisp/simple.el b/lisp/simple.el index 3a5a81e0011..266a66500cb 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -11205,15 +11205,19 @@ analyze-text-conversion ;; whether or not auto-fill has actually taken ;; place. (old-undo-list buffer-undo-list) + ;; Save the point position to return it there + ;; later. (old-point (point))) (save-excursion (if (and auto-fill-function newline-p) (progn (goto-char (nth 2 edit)) (previous-logical-line) - (funcall auto-fill-function)) + (funcall auto-fill-function) + (setq old-point (point))) (when (and auto-fill-function auto-fill-p) - (progn (goto-char (nth 2 edit)) - (funcall auto-fill-function)))) + (goto-char (nth 2 edit)) + (funcall auto-fill-function) + (setq old-point (point)))) ;; Record whether or not this edit should result in ;; an undo boundary being added. (setq any-nonephemeral commit 3ab99e977db01939cc42f285d5ce58807cf2e7d0 Author: João Távora Date: Tue Nov 7 09:09:30 2023 -0600 Eglot: Demote errors to warnings in eglot-ensure Github-reference: https://github.com/joaotavora/eglot/discussions/1318 * doc/misc/eglot.texi (Quick Start): Reword. (Starting Eglot): Reword. * lisp/progmodes/eglot.el (eglot-ensure): Demote errors to warnings. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 9ffea80b641..2d9b2a2b60e 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -139,16 +139,19 @@ Quick Start a buffer visiting any file that belongs to the project. This starts the language server configured for the programming language of that buffer, and causes Eglot to start managing all the files of the -project which use the same programming language. The notion of a -``project'' used by Eglot is the same Emacs uses (@pxref{Projects,,, -emacs, GNU Emacs Manual}): in the simplest case, the ``project'' is -the single file you are editing, but it can also be all the files in a -single directory or a directory tree under some version control -system, such as Git. +project which use the same programming language. This includes files +of a given project that are already visited at the time the +@code{eglot} command is invoked as well as files visited after this +invocation. -Alternatively, you can start Eglot automatically from the major-mode -hook of the mode used for the programming language; see @ref{Starting -Eglot}. +The notion of a ``project'' used by Eglot is the same Emacs uses +(@pxref{Projects,,, emacs, GNU Emacs Manual}): in the simplest case, +the ``project'' is the single file you are editing, but it can also be +all the files in a single directory or a directory tree under some +version control system, such as Git. + +There are alternate ways of starting Eglot; see @ref{Starting Eglot} +for details. @item Use Eglot. @@ -344,6 +347,12 @@ Starting Eglot only when you are confident that Eglot can be started reliably for any file which may be visited with the major-mode in question. +Note that it's often difficult to establish this confidence fully, so +it may be wise to use the interactive command @code{eglot} instead. +You only need to invoke it once per project, as all other files +visited within the same project will automatically be managed with no +further user intervention needed. + When Eglot connects to a language server for the first time in an Emacs session, it runs the hook @code{eglot-connect-hook} (@pxref{Eglot Variables}). diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index eba66503bf7..816f6952d2e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1366,7 +1366,18 @@ eglot--managed-mode ;;;###autoload (defun eglot-ensure () - "Start Eglot session for current buffer if there isn't one." + "Start Eglot session for current buffer if there isn't one. + +Only use this function (in major mode hooks, etc) if you are +confident that Eglot can be started safely and efficiently for +*every* buffer visited where these hooks may execute. + +Since it is difficult to establish this confidence fully, it's +often wise to use the interactive command `eglot' instead. This +command only needs to be invoked once per project, as all other +files of a given major mode visited within the same project will +automatically become managed with no further user intervention +needed." (let ((buffer (current-buffer))) (cl-labels ((maybe-connect @@ -1374,7 +1385,9 @@ eglot-ensure (eglot--when-live-buffer buffer (remove-hook 'post-command-hook #'maybe-connect t) (unless eglot--managed-mode - (apply #'eglot--connect (eglot--guess-contact)))))) + (condition-case-unless-debug oops + (apply #'eglot--connect (eglot--guess-contact)) + (error (eglot--warn (error-message-string oops)))))))) (when buffer-file-name (add-hook 'post-command-hook #'maybe-connect 'append t))))) commit 361f9fe4152f8dbb2a8c36c97bae13f689b606f0 Author: Eli Zaretskii Date: Tue Nov 7 16:31:40 2023 +0200 ; * lisp/minibuffer.el (completion-lazy-hilit-fn): Fix last change. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 8d662fafb9e..7a791fafaa6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3825,9 +3825,9 @@ completion-lazy-hilit-fn "Fontification function set by lazy-highlighting completions styles. When a given style wants to enable support for `completion-lazy-hilit' \(which see), that style should set this variable to a function of one -argument. It will be called with a completion candidate, a string, to -be displayed to the user, and should destructively propertize the string -with the `face' property.") +argument. It will be called with each completion candidate, a string, to +be displayed to the user, and should destructively propertize these +strings with the `face' property.") (defun completion-lazy-hilit (str) "Return a copy of completion candidate STR that is `face'-propertized. commit 14f0b6331d2248476ab5fe44bb1217327cf6724a Author: Eli Zaretskii Date: Tue Nov 7 16:29:06 2023 +0200 ; Minor documentation fixes * etc/NEWS: * lisp/minibuffer.el (completion-lazy-hilit) (completion-lazy-hilit-fn, completion-lazy-hilit): Fix recently added documentation. diff --git a/etc/NEWS b/etc/NEWS index b9a1c3dd572..767e4c27b43 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1280,11 +1280,12 @@ If non-nil, this variable contains a keymap of menu items that are displayed along tool bar items inside 'tool-bar-map'. ** New variable 'completion-lazy-hilit'. -Completion-presenting frontends may bind this variable non-nil around -calls to functions such as `completion-all-completions'. This hints -at the underlying completion styles to skip eager fontification of -completion candidates, which increases performance. Frontends then -use the 'completion-lazy-hilit' function to fontify just in time. +Lisp programs that present completion candidates may bind this +variable non-nil around calls to functions such as +'completion-all-completions'. This tells the underlying completion +styles to skip eager fontification of completion candidates, which +improves performance. Such a Lisp program can then use the +'completion-lazy-hilit' function to fontify candidates just in time. ** Functions and variables to transpose sexps diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ca2b25415f1..8d662fafb9e 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3799,41 +3799,39 @@ flex-score-match-tightness one-letter-long matches).") (defvar completion-lazy-hilit nil - "If non-nil, request completion lazy highlighting. - -Completion-presenting frontends may opt to bind this variable to -non-nil value in the context of completion-producing calls (such -as `completion-all-completions'). This hints the intervening -completion styles that they do not need to -fontify (i.e. propertize with a `face' property) completion -strings with highlights of the matching parts. - -When doing so, it is the frontend -- not the style -- who becomes -responsible for this fontification. The frontend binds this -variable to non-nil, and calls the function with the same name -`completion-lazy-hilit' on each completion string that is to be + "If non-nil, request lazy highlighting of completion candidates. + +Lisp programs (a.k.a. \"front ends\") that present completion +candidates may opt to bind this variable to a non-nil value when +calling functions (such as `completion-all-completions') which +produce completion candidates. This tells the underlying +completion styles that they do not need to fontify (i.e., +propertize with the `face' property) completion candidates in a +way that highlights the matching parts. Then it is the front end +which presents the candidates that becomes responsible for this +fontification. The front end does that by calling the function +`completion-lazy-hilit' on each completion candidate that is to be displayed to the user. Note that only some completion styles take advantage of this variable for optimization purposes. Other styles will ignore the hint and fontify eagerly as usual. It is still safe for a -frontend to call `completion-lazy-hilit' in these situations. +front end to call `completion-lazy-hilit' in these situations. -To author a completion style that takes advantage see -`completion-lazy-hilit-fn' and look in the source of -`completion-pcm--hilit-commonality'.") +To author a completion style that takes advantage of this variable, +see `completion-lazy-hilit-fn' and `completion-pcm--hilit-commonality'.") (defvar completion-lazy-hilit-fn nil - "Function set by lazy-highlighting completions styles. -When a given style wants to enable support for -`completion-lazy-hilit' (which see), that style should set this -variable to a function of one argument, a fresh string to be -displayed to the user. The function is responsible for -destructively propertizing the string with a `face' property.") + "Fontification function set by lazy-highlighting completions styles. +When a given style wants to enable support for `completion-lazy-hilit' +\(which see), that style should set this variable to a function of one +argument. It will be called with a completion candidate, a string, to +be displayed to the user, and should destructively propertize the string +with the `face' property.") (defun completion-lazy-hilit (str) - "Return a copy of completion STR that is `face'-propertized. -See documentation for variable `completion-lazy-hilit' for more + "Return a copy of completion candidate STR that is `face'-propertized. +See documentation of the variable `completion-lazy-hilit' for more details." (if (and completion-lazy-hilit completion-lazy-hilit-fn) (funcall completion-lazy-hilit-fn (copy-sequence str)) commit a1abb6a85e6605c256595b8d7b885018e5421c28 Author: Juri Linkov Date: Mon Nov 6 19:43:06 2023 +0200 * lisp/simple.el (next-line-completion): Improve (bug#59486). Handle the case when lines with completion candidates are interspersed with lines that contain group headings. diff --git a/lisp/simple.el b/lisp/simple.el index 96cdedb4f38..3a5a81e0011 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10017,7 +10017,7 @@ next-line-completion Also see the `completion-auto-wrap' variable." (interactive "p") - (let (line column pos) + (let (line column pos found) (when (and (bobp) (> n 0) (get-text-property (point) 'mouse-face) @@ -10044,12 +10044,14 @@ next-line-completion ((< n 0) (first-completion))))) (while (> n 0) - (setq pos nil column (current-column) line (line-number-at-pos)) - (when (and (or (not (eq (forward-line 1) 0)) - (eobp) - (not (eq (move-to-column column) column)) - (not (get-text-property (point) 'mouse-face))) - completion-auto-wrap) + (setq found nil pos nil column (current-column) line (line-number-at-pos)) + (while (and (not found) + (eq (forward-line 1) 0) + (not (eobp)) + (eq (move-to-column column) column)) + (when (get-text-property (point) 'mouse-face) + (setq found t))) + (when (and (not found) completion-auto-wrap) (save-excursion (goto-char (point-min)) (when (and (eq (move-to-column column) column) @@ -10064,11 +10066,13 @@ next-line-completion (setq n (1- n))) (while (< n 0) - (setq pos nil column (current-column) line (line-number-at-pos)) - (when (and (or (not (eq (forward-line -1) 0)) - (not (eq (move-to-column column) column)) - (not (get-text-property (point) 'mouse-face))) - completion-auto-wrap) + (setq found nil pos nil column (current-column) line (line-number-at-pos)) + (while (and (not found) + (eq (forward-line -1) 0) + (eq (move-to-column column) column)) + (when (get-text-property (point) 'mouse-face) + (setq found t))) + (when (and (not found) completion-auto-wrap) (save-excursion (goto-char (point-max)) (when (and (eq (move-to-column column) column) commit dfffb91a70532ac0021648ba692336331cbe0499 Author: João Távora Date: Wed Oct 25 13:45:01 2023 +0100 Allow completion frontends to fontify candidates just-in-time bug#48841, bug#47711 The variable may be bound by the frontend to a non-nil around completion-producing calls like completion-all-completions. See completion-lazy-hilit docstring for more info. * lisp/icomplete.el (icomplete-minibuffer-setup): Set completion-lazy-hilit. (icomplete--render-vertical): Call completion-lazy-hilit. (icomplete-completions): Call completion-lazy-hilit. * lisp/minibuffer.el (completion-lazy-hilit): New variable. (completion-lazy-hilit): New function. (completion-lazy-hilit-fn): New variable. (completion-pcm--regexp) (completion--flex-score-last-md): New helper variables. (completion--flex-score-1): New helper. (completion-pcm--hilit-commonality): Use completion-lazy-hilit. (completion--flex-adjust-metadata): Rework sorting code. * etc/NEWS: Mention completion-lazy-hilit diff --git a/etc/NEWS b/etc/NEWS index 94bcb75835b..b9a1c3dd572 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1279,6 +1279,13 @@ with Emacs. If non-nil, this variable contains a keymap of menu items that are displayed along tool bar items inside 'tool-bar-map'. +** New variable 'completion-lazy-hilit'. +Completion-presenting frontends may bind this variable non-nil around +calls to functions such as `completion-all-completions'. This hints +at the underlying completion styles to skip eager fontification of +completion candidates, which increases performance. Frontends then +use the 'completion-lazy-hilit' function to fontify just in time. + ** Functions and variables to transpose sexps +++ diff --git a/lisp/icomplete.el b/lisp/icomplete.el index e6fdd1f1836..f4c4feb7304 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -722,7 +722,8 @@ icomplete-exhibit ;; Check if still in the right buffer (bug#61308) (or (window-minibuffer-p) completion-in-region--data) (icomplete-simple-completing-p)) ;Shouldn't be necessary. - (let ((saved-point (point))) + (let ((saved-point (point)) + (completion-lazy-hilit t)) (save-excursion (goto-char (icomplete--field-end)) ;; Insert the match-status information: @@ -901,7 +902,7 @@ icomplete--render-vertical 'icomplete-selected-match 'append comp) collect (concat prefix (make-string (- max-prefix-len (length prefix)) ? ) - comp + (completion-lazy-hilit comp) (make-string (- max-comp-len (length comp)) ? ) suffix) into lines-aux @@ -1067,7 +1068,8 @@ icomplete-completions (if (< prospects-len prospects-max) (push comp prospects) (setq limit t))) - (setq prospects (nreverse prospects)) + (setq prospects + (nreverse (mapcar #'completion-lazy-hilit prospects))) ;; Decorate first of the prospects. (when prospects (let ((first (copy-sequence (pop prospects)))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 45d9a113d0b..ca2b25415f1 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -677,6 +677,10 @@ completion--twq-all 'completions-common-part) qprefix)))) (qcompletion (concat qprefix qnew))) + ;; Attach unquoted completion string, which is needed + ;; to score the completion in `completion--flex-score'. + (put-text-property 0 1 'completion--unquoted + completion qcompletion) ;; FIXME: Similarly here, Cygwin's mapping trips this ;; assertion. ;;(cl-assert @@ -1234,6 +1238,7 @@ completion-all-completions POINT is the position of point within STRING. The return value is a list of completions and may contain the base-size in the last `cdr'." + (setq completion-lazy-hilit-fn nil) ;; FIXME: We need to additionally return the info needed for the ;; second part of completion-base-position. (completion--nth-completion 2 string table pred point metadata)) @@ -3793,108 +3798,193 @@ flex-score-match-tightness than the latter (which has two \"holes\" and three one-letter-long matches).") +(defvar completion-lazy-hilit nil + "If non-nil, request completion lazy highlighting. + +Completion-presenting frontends may opt to bind this variable to +non-nil value in the context of completion-producing calls (such +as `completion-all-completions'). This hints the intervening +completion styles that they do not need to +fontify (i.e. propertize with a `face' property) completion +strings with highlights of the matching parts. + +When doing so, it is the frontend -- not the style -- who becomes +responsible for this fontification. The frontend binds this +variable to non-nil, and calls the function with the same name +`completion-lazy-hilit' on each completion string that is to be +displayed to the user. + +Note that only some completion styles take advantage of this +variable for optimization purposes. Other styles will ignore the +hint and fontify eagerly as usual. It is still safe for a +frontend to call `completion-lazy-hilit' in these situations. + +To author a completion style that takes advantage see +`completion-lazy-hilit-fn' and look in the source of +`completion-pcm--hilit-commonality'.") + +(defvar completion-lazy-hilit-fn nil + "Function set by lazy-highlighting completions styles. +When a given style wants to enable support for +`completion-lazy-hilit' (which see), that style should set this +variable to a function of one argument, a fresh string to be +displayed to the user. The function is responsible for +destructively propertizing the string with a `face' property.") + +(defun completion-lazy-hilit (str) + "Return a copy of completion STR that is `face'-propertized. +See documentation for variable `completion-lazy-hilit' for more +details." + (if (and completion-lazy-hilit completion-lazy-hilit-fn) + (funcall completion-lazy-hilit-fn (copy-sequence str)) + str)) + +(defun completion--hilit-from-re (string regexp) + "Fontify STRING with `completions-common-part' using REGEXP." + (let* ((md (and regexp (string-match regexp string) (cddr (match-data t)))) + (me (and md (match-end 0))) + (from 0)) + (while md + (add-face-text-property from (pop md) 'completions-common-part nil string) + (setq from (pop md))) + (unless (or (not me) (= from me)) + (add-face-text-property from me 'completions-common-part nil string)) + string)) + +(defun completion--flex-score-1 (md-groups match-end len) + "Compute matching score of completion. +The score lies in the range between 0 and 1, where 1 corresponds to +the full match. +MD-GROUPS is the \"group\" part of the match data. +MATCH-END is the end of the match. +LEN is the length of the completion string." + (let* ((from 0) + ;; To understand how this works, consider these simple + ;; ascii diagrams showing how the pattern "foo" + ;; flex-matches "fabrobazo", "fbarbazoo" and + ;; "barfoobaz": + + ;; f abr o baz o + ;; + --- + --- + + + ;; f barbaz oo + ;; + ------ ++ + + ;; bar foo baz + ;; +++ + + ;; "+" indicates parts where the pattern matched. A + ;; "hole" in the middle of the string is indicated by + ;; "-". Note that there are no "holes" near the edges + ;; of the string. The completion score is a number + ;; bound by (0..1] (i.e., larger than (but not equal + ;; to) zero, and smaller or equal to one): the higher + ;; the better and only a perfect match (pattern equals + ;; string) will have score 1. The formula takes the + ;; form of a quotient. For the numerator, we use the + ;; number of +, i.e. the length of the pattern. For + ;; the denominator, it first computes + ;; + ;; hole_i_contrib = 1 + (Li-1)^(1/tightness) + ;; + ;; , for each hole "i" of length "Li", where tightness + ;; is given by `flex-score-match-tightness'. The + ;; final value for the denominator is then given by: + ;; + ;; (SUM_across_i(hole_i_contrib) + 1) * len + ;; + ;; , where "len" is the string's length. + (score-numerator 0) + (score-denominator 0) + (last-b 0)) + (while (and md-groups (car md-groups)) + (let ((a from) + (b (pop md-groups))) + (setq + score-numerator (+ score-numerator (- b a))) + (unless (or (= a last-b) + (zerop last-b) + (= a len)) + (setq + score-denominator (+ score-denominator + 1 + (expt (- a last-b 1) + (/ 1.0 + flex-score-match-tightness))))) + (setq + last-b b)) + (setq from (pop md-groups))) + ;; If `pattern' doesn't have an explicit trailing any, the + ;; regex `re' won't produce match data representing the + ;; region after the match. We need to account to account + ;; for that extra bit of match (bug#42149). + (unless (= from match-end) + (let ((a from) + (b match-end)) + (setq + score-numerator (+ score-numerator (- b a))) + (unless (or (= a last-b) + (zerop last-b) + (= a len)) + (setq + score-denominator (+ score-denominator + 1 + (expt (- a last-b 1) + (/ 1.0 + flex-score-match-tightness))))) + (setq + last-b b))) + (/ score-numerator (* len (1+ score-denominator)) 1.0))) + +(defvar completion--flex-score-last-md nil + "Helper variable for `completion--flex-score'.") + +(defun completion--flex-score (str re &optional dont-error) + "Compute flex score of completion STR based on RE. +If DONT-ERROR, just return nil if RE doesn't match STR." + (cond ((string-match re str) + (let* ((match-end (match-end 0)) + (md (cddr + (setq + completion--flex-score-last-md + (match-data t completion--flex-score-last-md))))) + (completion--flex-score-1 md match-end (length str)))) + ((not dont-error) + (error "Internal error: %s does not match %s" re str)))) + +(defvar completion-pcm--regexp nil + "Regexp from PCM pattern in `completion-pcm--hilit-commonality'.") + (defun completion-pcm--hilit-commonality (pattern completions) "Show where and how well PATTERN matches COMPLETIONS. PATTERN, a list of symbols and strings as seen `completion-pcm--merge-completions', is assumed to match every -string in COMPLETIONS. Return a deep copy of COMPLETIONS where -each string is propertized with `completion-score', a number -between 0 and 1, and with faces `completions-common-part', -`completions-first-difference' in the relevant segments." +string in COMPLETIONS. + +If `completion-lazy-hilit' is nil, return a deep copy of +COMPLETIONS where each string is propertized with +`completion-score', a number between 0 and 1, and with faces +`completions-common-part', `completions-first-difference' in the +relevant segments. + +Else, if `completion-lazy-hilit' is t, return COMPLETIONS +unchanged, but setup a suitable `completion-lazy-hilit-fn' (which +see) for later lazy highlighting." + (setq completion-pcm--regexp nil + completion-lazy-hilit-fn nil) (cond ((and completions (cl-loop for e in pattern thereis (stringp e))) - (let* ((re (completion-pcm--pattern->regex pattern 'group)) - (point-idx (completion-pcm--pattern-point-idx pattern)) - (case-fold-search completion-ignore-case) - last-md) - (mapcar - (lambda (str) - ;; Don't modify the string itself. - (setq str (copy-sequence str)) - (unless (string-match re str) - (error "Internal error: %s does not match %s" re str)) - (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0))) - (match-end (match-end 0)) - (md (cddr (setq last-md (match-data t last-md)))) - (from 0) - (end (length str)) - ;; To understand how this works, consider these simple - ;; ascii diagrams showing how the pattern "foo" - ;; flex-matches "fabrobazo", "fbarbazoo" and - ;; "barfoobaz": - - ;; f abr o baz o - ;; + --- + --- + - - ;; f barbaz oo - ;; + ------ ++ - - ;; bar foo baz - ;; +++ - - ;; "+" indicates parts where the pattern matched. A - ;; "hole" in the middle of the string is indicated by - ;; "-". Note that there are no "holes" near the edges - ;; of the string. The completion score is a number - ;; bound by (0..1] (i.e., larger than (but not equal - ;; to) zero, and smaller or equal to one): the higher - ;; the better and only a perfect match (pattern equals - ;; string) will have score 1. The formula takes the - ;; form of a quotient. For the numerator, we use the - ;; number of +, i.e. the length of the pattern. For - ;; the denominator, it first computes - ;; - ;; hole_i_contrib = 1 + (Li-1)^(1/tightness) - ;; - ;; , for each hole "i" of length "Li", where tightness - ;; is given by `flex-score-match-tightness'. The - ;; final value for the denominator is then given by: - ;; - ;; (SUM_across_i(hole_i_contrib) + 1) * len - ;; - ;; , where "len" is the string's length. - (score-numerator 0) - (score-denominator 0) - (last-b 0) - (update-score-and-face - (lambda (a b) - "Update score and face given match range (A B)." - (add-face-text-property a b - 'completions-common-part - nil str) - (setq - score-numerator (+ score-numerator (- b a))) - (unless (or (= a last-b) - (zerop last-b) - (= a (length str))) - (setq - score-denominator (+ score-denominator - 1 - (expt (- a last-b 1) - (/ 1.0 - flex-score-match-tightness))))) - (setq - last-b b)))) - (while md - (funcall update-score-and-face from (pop md)) - (setq from (pop md))) - ;; If `pattern' doesn't have an explicit trailing any, the - ;; regex `re' won't produce match data representing the - ;; region after the match. We need to account to account - ;; for that extra bit of match (bug#42149). - (unless (= from match-end) - (funcall update-score-and-face from match-end)) - (if (> (length str) pos) - (add-face-text-property - pos (1+ pos) - 'completions-first-difference - nil str)) - (unless (zerop (length str)) - (put-text-property - 0 1 'completion-score - (/ score-numerator (* end (1+ score-denominator)) 1.0) str))) - str) - completions))) + (let* ((re (completion-pcm--pattern->regex pattern 'group))) + (setq completion-pcm--regexp re) + (cond (completion-lazy-hilit + (setq completion-lazy-hilit-fn + (lambda (str) (completion--hilit-from-re str re))) + completions) + (t + (mapcar + (lambda (str) + (completion--hilit-from-re (copy-sequence str) re)) + completions))))) (t completions))) (defun completion-pcm--find-all-completions (string table pred point @@ -4231,36 +4321,39 @@ completion-flex-nospace (defun completion--flex-adjust-metadata (metadata) "If `flex' is actually doing filtering, adjust sorting." - (let ((flex-is-filtering-p - ;; JT@2019-12-23: FIXME: this is kinda wrong. What we need - ;; to test here is "some input that actually leads/led to - ;; flex filtering", not "something after the minibuffer - ;; prompt". E.g. The latter is always true for file - ;; searches, meaning we'll be doing extra work when we - ;; needn't. - (or (not (window-minibuffer-p)) - (> (point-max) (minibuffer-prompt-end)))) + (let ((flex-is-filtering-p completion-pcm--regexp) (existing-dsf (completion-metadata-get metadata 'display-sort-function)) (existing-csf (completion-metadata-get metadata 'cycle-sort-function))) (cl-flet - ((compose-flex-sort-fn - (existing-sort-fn) ; wish `cl-flet' had proper indentation... - (lambda (completions) - (sort - (funcall existing-sort-fn completions) - (lambda (c1 c2) - (let ((s1 (get-text-property 0 'completion-score c1)) - (s2 (get-text-property 0 'completion-score c2))) - (> (or s1 0) (or s2 0)))))))) + ((compose-flex-sort-fn (existing-sort-fn) + (lambda (completions) + (let* ((sorted (sort + (mapcar + (lambda (str) + (cons + (- (completion--flex-score + (or (get-text-property + 0 'completion--unquoted str) + str) + completion-pcm--regexp)) + str)) + (if existing-sort-fn + (funcall existing-sort-fn completions) + completions)) + #'car-less-than-car)) + (cell sorted)) + ;; Reuse the list + (while cell + (setcar cell (cdar cell)) + (pop cell)) + sorted)))) `(metadata ,@(and flex-is-filtering-p - `((display-sort-function - . ,(compose-flex-sort-fn (or existing-dsf #'identity))))) + `((display-sort-function . ,(compose-flex-sort-fn existing-dsf)))) ,@(and flex-is-filtering-p - `((cycle-sort-function - . ,(compose-flex-sort-fn (or existing-csf #'identity))))) + `((cycle-sort-function . ,(compose-flex-sort-fn existing-csf)))) ,@(cdr metadata))))) (defun completion-flex--make-flex-pattern (pattern) commit 94807b6896191245ff3bef44a0ec21efb918232f Author: Mattias Engdegård Date: Mon Nov 6 12:06:40 2023 +0100 ; * lisp/emacs-lisp/cl-macs.el: Axe useless `gethash` inline decl diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 71a9ad33f98..e2c13534054 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3735,7 +3735,7 @@ cl--compiler-macro-get ;;; Things that are inline. (cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend - cl-nreconc gethash)) + cl-nreconc)) ;;; Things that are side-effect-free. (mapc (lambda (x) (function-put x 'side-effect-free t)) commit bf81706988f6b1b9d6e8033c8227f0129e04ef03 Author: Stefan Kangas Date: Mon Nov 6 08:51:59 2023 +0100 Silence warning when requiring ruby-ts-mode * lisp/progmodes/ruby-ts-mode.el: Silence warning when requiring file without a treesitter grammar. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index fabe5859779..4f85e1c63ff 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; This file defines ruby-ts-mode which is a major mode for editing -;; Ruby files that uses Tree Sitter to parse the language. More +;; Ruby files that uses Tree Sitter to parse the language. More ;; information about Tree Sitter can be found in the ELisp Info pages ;; as well as this website: https://tree-sitter.github.io/tree-sitter/ @@ -1198,7 +1198,7 @@ ruby-ts--parser-after-change (syntax-ppss-flush-cache (cl-loop for r in ranges minimize (car r)))))) -(if (treesit-ready-p 'ruby) +(if (treesit-ready-p 'ruby t) ;; Copied from ruby-mode.el. (add-to-list 'auto-mode-alist (cons (concat "\\(?:\\.\\(?:" commit b52849594668799a40112e31d2086c4a6d966f94 Author: Juri Linkov Date: Mon Nov 6 09:27:48 2023 +0200 * lisp/vc/vc-git.el (vc-git-revision-table): Reverse the table (bug#64656). diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 9ec45c59893..707fc7cfc07 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1723,7 +1723,7 @@ vc-git-revision-table "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"))) (while (re-search-forward regexp nil t) (push (match-string 2) table)))) - table)) + (nreverse table))) (defun vc-git-revision-completion-table (files) (letrec ((table (lazy-completion-table commit 5bdc61bc0efc704c85b78f36f5f7e5f6c42bb877 Author: Kyle Meyer Date: Sun Nov 5 21:46:42 2023 -0500 Update to Org 9.6.11 diff --git a/doc/misc/org.org b/doc/misc/org.org index d8bbcb4d0c5..9f6cda17da0 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -20266,12 +20266,12 @@ packages are documented here. #+vindex: org-table-formula-constants Org can use names for constants in formulas in tables. Org can also - use calculation suffixes for units, such as =M= for =Mega=. For - a standard collection of such constants, install the =constants= + use calculation suffixes for units, such as =M= for =Mega=. For a + standard collection of such constants, install the =constants= package. Install version 2.0 of this package, available at - [[http://www.astro.uva.nl/~dominik/Tools]]. Org checks if the function - ~constants-get~ has been autoloaded. Installation instructions are - in the file =constants.el=. + [[https://github.com/cdominik/constants-for-Emacs]]. Org checks if the + function ~constants-get~ has been autoloaded. Installation + instructions are in the file =constants.el=. - =cdlatex.el= by Carsten Dominik :: #+cindex: @file{cdlatex.el} diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 240e3366b0b..4b73a544e80 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.10} +\def\orgversionnumber{9.6.11} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index e69ce4f1d12..2df3396ee72 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -1932,12 +1932,12 @@ org-babel-find-named-result (defun org-babel-result-names (&optional file) "Return the names of results in FILE or the current buffer." - (save-excursion - (when file (find-file file)) (goto-char (point-min)) - (let ((case-fold-search t) names) + (with-current-buffer (if file (find-file-noselect file) (current-buffer)) + (org-with-point-at 1 + (let ((case-fold-search t) names) (while (re-search-forward org-babel-result-w-name-regexp nil t) (setq names (cons (match-string-no-properties 9) names))) - names))) + names)))) ;;;###autoload (defun org-babel-next-src-block (&optional arg) @@ -2358,7 +2358,7 @@ org-babel-insert-result using the argument supplied to specify the export block or snippet type." (cond ((stringp result) - (setq result (org-no-properties result)) + (setq result (substring-no-properties result)) (when (member "file" result-params) (setq result (org-babel-result-to-file diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el index 2c30a26056b..87e38e414ce 100644 --- a/lisp/org/ob-shell.el +++ b/lisp/org/ob-shell.el @@ -166,6 +166,11 @@ org-babel--variable-assignments:sh-generic "Return a list of statements declaring the values as a generic variable." (format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline))) +(defun org-babel--variable-assignments:fish + (varname values &optional sep hline) + "Return a list of statements declaring the values as a fish variable." + (format "set %s %s" varname (org-babel-sh-var-to-sh values sep hline))) + (defun org-babel--variable-assignments:bash_array (varname values &optional sep hline) "Return a list of statements declaring the values as a bash array." @@ -211,8 +216,11 @@ org-babel-variable-assignments:shell (if (string-suffix-p "bash" shell-file-name) (org-babel--variable-assignments:bash (car pair) (cdr pair) sep hline) - (org-babel--variable-assignments:sh-generic - (car pair) (cdr pair) sep hline))) + (if (string-suffix-p "fish" shell-file-name) + (org-babel--variable-assignments:fish + (car pair) (cdr pair) sep hline) + (org-babel--variable-assignments:sh-generic + (car pair) (cdr pair) sep hline)))) (org-babel--get-vars params)))) (defun org-babel-sh-var-to-sh (var &optional sep hline) diff --git a/lisp/org/ol-info.el b/lisp/org/ol-info.el index ad9e4a12bd7..350ccf5cc57 100644 --- a/lisp/org/ol-info.el +++ b/lisp/org/ol-info.el @@ -129,13 +129,13 @@ org-info-follow-link (defconst org-info-emacs-documents '("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x" - "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eieio" "eintr" "elisp" - "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell" "eudc" "eww" - "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info" "mairix-el" - "message" "mh-e" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs" - "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve" - "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper" - "widget" "wisent" "woman") + "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eglot" "eieio" "eintr" + "elisp" "emacs-gnutls" "emacs-mime" "emacs" "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") "List of Emacs documents available. Taken from ") diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 38e81d9d713..670116304e6 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6321,6 +6321,11 @@ org-agenda-get-deadlines (org-element-cache-map (lambda (el) (when (and (org-element-property :deadline el) + ;; Only consider active timestamp values. + (memq (org-element-property + :type + (org-element-property :deadline el)) + '(diary active active-range)) (or (not with-hour) (org-element-property :hour-start @@ -6662,6 +6667,11 @@ org-agenda-get-scheduled (org-element-cache-map (lambda (el) (when (and (org-element-property :scheduled el) + ;; Only consider active timestamp values. + (memq (org-element-property + :type + (org-element-property :scheduled el)) + '(diary active active-range)) (or (not with-hour) (org-element-property :hour-start diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index cfef38581c6..e5b0fbcf2a9 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.6.10")) + (let ((org-release "9.6.11")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.6.10")) + (let ((org-git-version "release_9.6.11")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 0ba0cef4490..863a9e093f5 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9,7 +9,7 @@ ;; URL: https://orgmode.org ;; Package-Requires: ((emacs "26.1")) -;; Version: 9.6.10 +;; Version: 9.6.11 ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 94cc5a22881..e9cc0ed8fc7 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -264,13 +264,17 @@ org-export-default-inline-image-rule rules.") (defconst org-export-ignored-local-variables - '( org-font-lock-keywords org-element--cache-change-tic - org-element--cache-change-tic org-element--cache-size - org-element--headline-cache-size - org-element--cache-sync-keys-value - org-element--cache-change-warning org-element--headline-cache - org-element--cache org-element--cache-sync-keys - org-element--cache-sync-requests org-element--cache-sync-timer) + '( org-font-lock-keywords + org-element--cache org-element--cache-size + org-element--headline-cache org-element--headline-cache-size + org-element--cache-hash-left org-element--cache-hash-right + org-element--cache-sync-requests org-element--cache-sync-timer + org-element--cache-sync-keys-value org-element--cache-change-tic + org-element--cache-last-buffer-size + org-element--cache-diagnostics-ring + org-element--cache-diagnostics-ring-size + org-element--cache-gapless + org-element--cache-change-warning) "List of variables not copied through upon buffer duplication. Export process takes place on a copy of the original buffer. When this copy is created, all Org related local variables not in @@ -6691,6 +6695,11 @@ org-export-to-file ',ext-plist))) (with-temp-buffer (insert output) + ;; Ensure final newline. This is what was done + ;; historically, when we used `write-file'. + ;; Note that adding a newline is only safe for + ;; non-binary data. + (unless (bolp) (insert "\n")) (let ((coding-system-for-write ',encoding)) (write-region (point-min) (point-max) ,file))) (or (ignore-errors (funcall ',post-process ,file)) ,file))) @@ -6698,6 +6707,11 @@ org-export-to-file backend subtreep visible-only body-only ext-plist))) (with-temp-buffer (insert output) + ;; Ensure final newline. This is what was done + ;; historically, when we used `write-file'. + ;; Note that adding a newline is only safe for + ;; non-binary data. + (unless (bolp) (insert "\n")) (let ((coding-system-for-write encoding)) (write-region (point-min) (point-max) file))) (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output)) commit de380adb64688455ef315ea807622de25e385c44 Author: Po Lu Date: Mon Nov 6 10:14:09 2023 +0800 Emulate secondary selections on Android * doc/lispref/frames.texi (Other Selections): Revise documentation to match. * lisp/term/android-win.el (android-secondary-selection): New variable. (android-primary-selection, android-get-clipboard-1) (android-get-primary, gui-backend-get-selection) (gui-backend-selection-exists-p, gui-backend-selection-owner-p) (gui-backend-set-selection): Update doc strings and code as is proper. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 6193a4fe1cd..ca8c79395ed 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4686,15 +4686,18 @@ Other Selections @cindex Android selections Much like MS-Windows, Android provides a clipboard but no primary or secondary selection; @code{gui-set-selection} simulates the primary -selection by saving the value supplied into a variable subsequent -calls to @code{gui-get-selection} return. +and secondary selections by saving the value supplied into a variable +subsequent calls to @code{gui-get-selection} return. From the clipboard, @code{gui-get-selection} is capable of returning UTF-8 string data of the type @code{STRING}, the @code{TAREGTS} data type, or image and application data of any MIME type. @code{gui-set-selection} sets only string data, much as under MS-Windows, although this data is not affected by the value of -@code{selection-coding-system}. +@code{selection-coding-system}. By contrast, only string data can be +saved to and from the primary and secondary selections; but since this +data is not communicated to programs besides Emacs, it is not subject +to encoding or decoding by any coding system. @node Yanking Media @section Yanking Media diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 70e24f4ccc7..7d9a033d723 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -75,19 +75,28 @@ handle-args-function (defvar android-primary-selection nil "The last string placed in the primary selection. -Nil if there was no such string. +nil if there was no such string. -Android does not have a primary selection of its own, so Emacs -emulates one inside Lisp.") +Android is not equipped with a primary selection of its own, so +Emacs emulates one in Lisp.") + +(defvar android-secondary-selection nil + "The last string placed in the secondary selection. +nil if there was no such string. + +Android is not equipped with a secondary selection of its own, so +Emacs emulates one in Lisp.") (defun android-get-clipboard-1 (data-type) - "Return the clipboard data. -DATA-TYPE is a selection conversion target. `STRING' means to -return the contents of the clipboard as a string. `TARGETS' -means to return supported data types as a vector. + "Return data saved from the clipboard. +DATA-TYPE is a selection conversion target. -Interpret any other symbol as a MIME type, and return its -corresponding data." +`STRING' means return the contents of the clipboard as a string, +while `TARGETS' means return the types of all data present within +the clipboard as a vector. + +Interpret any other symbol as a MIME type for which any clipboard +data is returned" (or (and (eq data-type 'STRING) (android-get-clipboard)) (and (eq data-type 'TARGETS) @@ -95,7 +104,8 @@ android-get-clipboard-1 (vconcat [TARGETS STRING] (let ((i nil)) (dolist (type (android-get-clipboard-targets)) - ;; Don't report plain text as a valid target. + ;; Don't report plain text as a valid target + ;; since it is addressed by STRING. (unless (equal type "text/plain") (push (intern type) i))) (nreverse i)))) @@ -109,7 +119,16 @@ android-get-primary (or (and (eq data-type 'STRING) android-primary-selection) (and (eq data-type 'TARGETS) - [TARGETS])))) + [TARGETS STRING])))) + +(defun android-get-secondary (data-type) + "Return the last string placed in the secondary selection, or nil. +Return nil if DATA-TYPE is anything other than STRING or TARGETS." + (when android-secondary-selection + (or (and (eq data-type 'STRING) + android-secondary-selection) + (and (eq data-type 'TARGETS) + [TARGETS STRING])))) (defun android-selection-bounds (value) "Return bounds of selection value VALUE. @@ -152,26 +171,34 @@ gui-backend-get-selection (cond ((eq type 'CLIPBOARD) (android-get-clipboard-1 data-type)) ((eq type 'PRIMARY) - (android-get-primary data-type)))) + (android-get-primary data-type)) + ((eq type 'SECONDARY) + (android-get-secondary data-type)))) (cl-defmethod gui-backend-selection-exists-p (selection &context (window-system android)) (cond ((eq selection 'CLIPBOARD) (android-clipboard-exists-p)) ((eq selection 'PRIMARY) - (not (null android-primary-selection))))) + (not (null android-primary-selection))) + ((eq selection 'SECONDARY) + (not (null android-secondary-selection))))) (cl-defmethod gui-backend-selection-owner-p (selection &context (window-system android)) (cond ((eq selection 'CLIPBOARD) (let ((ownership (android-clipboard-owner-p))) - ;; If ownership is `lambda', then Emacs couldn't determine + ;; If ownership is `lambda', then Emacs couldn't establish ;; whether or not it owns the clipboard. (and (not (eq ownership 'lambda)) ownership))) ((eq selection 'PRIMARY) ;; Emacs always owns its own primary selection as long as it ;; exists. - (not (null android-primary-selection))))) + (not (null android-primary-selection))) + ((eq selection 'SECONDARY) + ;; Emacs always owns its own secondary selection as long as + ;; it exists. + (not (null android-secondary-selection))))) (cl-defmethod gui-backend-set-selection (type value &context (window-system android)) @@ -181,7 +208,9 @@ gui-backend-set-selection (cond ((eq type 'CLIPBOARD) (android-set-clipboard string)) ((eq type 'PRIMARY) - (setq android-primary-selection string))))) + (setq android-primary-selection string)) + ((eq type 'SECONDARY) + (setq android-secondary-selection string))))) ;;; Character composition display. commit 3dd9750d124b077b2e87e0a253f69cf1f65422d6 Author: Jeremy Bryant Date: Sat Nov 4 23:29:10 2023 +0000 * lisp/emacs-lisp/cl-extra.el (cl-remprop): Update names to match docstring diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 15be51bd651..2ca2d03170a 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -635,13 +635,12 @@ cl--do-remf (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) ;;;###autoload -(defun cl-remprop (sym tag) - "Remove from SYMBOL's plist the property PROPNAME and its value. -\n(fn SYMBOL PROPNAME)" - (let ((plist (symbol-plist sym))) - (if (and plist (eq tag (car plist))) - (progn (setplist sym (cdr (cdr plist))) t) - (cl--do-remf plist tag)))) +(defun cl-remprop (symbol propname) + "Remove from SYMBOL's plist the property PROPNAME and its value." + (let ((plist (symbol-plist symbol))) + (if (and plist (eq propname (car plist))) + (progn (setplist symbol (cdr (cdr plist))) t) + (cl--do-remf plist propname)))) ;;; Streams. commit f0c0ff6bf23ec667ff5487fd94b7f46803ea00ac Author: Juri Linkov Date: Sun Nov 5 19:52:33 2023 +0200 New option to use arrows in the minibuffer to select completions (bug#59486) * lisp/minibuffer.el (minibuffer-visible-completions): New defcustom. (minibuffer-visible-completions-bind): New function. (minibuffer-visible-completions-map): New defvar-keymap. (minibuffer-mode): Set buffer-local minibuffer-completion-auto-choose to nil for minibuffer-visible-completions. (completing-read-default, completion-in-region-mode): Use minibuffer-visible-completions to compose keymap with minibuffer-visible-completions-map. (minibuffer-next-completion): Add new arg VERTICAL, and use next-line-completion. (minibuffer-next-line-completion) (minibuffer-previous-line-completion): New commands. diff --git a/etc/NEWS b/etc/NEWS index c06a013466f..94bcb75835b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1013,6 +1013,14 @@ Bound to '' and '' arrow keys, respectively, they navigate the "*Completions*" buffer vertically by lines, wrapping at the top/bottom when 'completion-auto-wrap' is non-nil. +*** New user option 'minibuffer-visible-completions'. +When customized to non-nil, you can use arrow key in the minibuffer +to navigate the completions displayed in the *Completions* window. +Typing 'RET' selects the highlighted candidate. 'C-g' hides the +completions window. When the completions window is not visible, +then all these keys have their usual meaning in the minibuffer. +This option is supported for in-buffer completion as well. + +++ *** New global minor mode 'minibuffer-regexp-mode'. This is a minor mode for editing regular expressions in the minibuffer. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 2120e31775e..45d9a113d0b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2707,8 +2707,14 @@ completion-in-region-mode completion-in-region-mode-predicate) (setq-local minibuffer-completion-auto-choose nil) (add-hook 'post-command-hook #'completion-in-region--postch) - (push `(completion-in-region-mode . ,completion-in-region-mode-map) - minor-mode-overriding-map-alist))) + (let* ((keymap completion-in-region-mode-map) + (keymap (if minibuffer-visible-completions + (make-composed-keymap + (list minibuffer-visible-completions-map + keymap)) + keymap))) + (push `(completion-in-region-mode . ,keymap) + minor-mode-overriding-map-alist)))) ;; Define-minor-mode added our keymap to minor-mode-map-alist, but we want it ;; on minor-mode-overriding-map-alist instead. @@ -2953,8 +2959,46 @@ minibuffer-mode :interactive nil ;; Enable text conversion, but always make sure `RET' does ;; something. - (setq text-conversion-style 'action)) + (setq text-conversion-style 'action) + (when minibuffer-visible-completions + (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." + :type 'boolean + :version "30.1") + +(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))))) + +(defvar-keymap minibuffer-visible-completions-map + :doc "Local keymap for minibuffer input with visible completions." + "" (minibuffer-visible-completions-bind #'minibuffer-previous-completion) + "" (minibuffer-visible-completions-bind #'minibuffer-next-completion) + "" (minibuffer-visible-completions-bind #'minibuffer-previous-line-completion) + "" (minibuffer-visible-completions-bind #'minibuffer-next-line-completion) + "RET" (minibuffer-visible-completions-bind #'minibuffer-choose-completion) + "C-g" (minibuffer-visible-completions-bind #'minibuffer-hide-completions)) + ;;; Completion tables. (defun minibuffer--double-dollars (str) @@ -4370,6 +4414,11 @@ completing-read-default ;; in minibuffer-local-filename-completion-map can ;; override bindings in base-keymap. base-keymap))) + (keymap (if minibuffer-visible-completions + (make-composed-keymap + (list minibuffer-visible-completions-map + keymap)) + keymap)) (buffer (current-buffer)) (c-i-c completion-ignore-case) (result @@ -4489,16 +4538,21 @@ minibuffer-completion-auto-choose :type 'boolean :version "29.1") -(defun minibuffer-next-completion (&optional n) +(defun minibuffer-next-completion (&optional n vertical) "Move to the next item in its completions window from the minibuffer. +When the optional argument VERTICAL is non-nil, move vertically +to the next item on the next line using `next-line-completion'. +Otherwise, move to the next item horizontally using `next-completion'. When `minibuffer-completion-auto-choose' is non-nil, then also -insert the selected completion to the minibuffer." +insert the selected completion candidate to the minibuffer." (interactive "p") (let ((auto-choose minibuffer-completion-auto-choose)) (with-minibuffer-completions-window (when completions-highlight-face (setq-local cursor-face-highlight-nonselected-window t)) - (next-completion (or n 1)) + (if vertical + (next-line-completion (or n 1)) + (next-completion (or n 1))) (when auto-choose (let ((completion-use-base-affixes t)) (choose-completion nil t t)))))) @@ -4506,17 +4560,35 @@ minibuffer-next-completion (defun minibuffer-previous-completion (&optional n) "Move to the previous item in its completions window from the minibuffer. When `minibuffer-completion-auto-choose' is non-nil, then also -insert the selected completion to the minibuffer." +insert the selected completion candidate to the minibuffer." (interactive "p") (minibuffer-next-completion (- (or n 1)))) +(defun minibuffer-next-line-completion (&optional n) + "Move to the next completion line from the minibuffer. +This means to move to the completion candidate on the next line +in the *Completions* buffer while point stays in the minibuffer. +When `minibuffer-completion-auto-choose' is non-nil, then also +insert the selected completion candidate to the minibuffer." + (interactive "p") + (minibuffer-next-completion (or n 1) t)) + +(defun minibuffer-previous-line-completion (&optional n) + "Move to the previous completion line from the minibuffer. +This means to move to the completion candidate on the previous line +in the *Completions* buffer while point stays in the minibuffer. +When `minibuffer-completion-auto-choose' is non-nil, then also +insert the selected completion candidate to the minibuffer." + (interactive "p") + (minibuffer-next-completion (- (or n 1)) t)) + (defun minibuffer-choose-completion (&optional no-exit no-quit) "Run `choose-completion' from the minibuffer in its completions window. -With prefix argument NO-EXIT, insert the completion at point to the -minibuffer, but don't exit the minibuffer. When the prefix argument +With prefix argument NO-EXIT, insert the completion candidate at point to +the minibuffer, but don't exit the minibuffer. When the prefix argument is not provided, then whether to exit the minibuffer depends on the value of `completion-no-auto-exit'. -If NO-QUIT is non-nil, insert the completion at point to the +If NO-QUIT is non-nil, insert the completion candidate at point to the minibuffer, but don't quit the completions window." (interactive "P") (with-minibuffer-completions-window commit ad82bc9b29eacad29a441bbb4e87bd09ef1ff1c4 Author: Stefan Kangas Date: Sun Nov 5 17:36:21 2023 +0100 Declare calc-eval-error in calc.el * lisp/calc/calc.el (calc-eval-error): Declare. (Bug#58801) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 652cb8c1a88..b347cc1da23 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -906,6 +906,8 @@ calc-embedded-new-formula-hook (defvar calc-embedded-mode-hook nil "Hook run when starting embedded mode.") +(defvar calc-eval-error) + ;; The following modes use specially-formatted data. (put 'calc-mode 'mode-class 'special) commit b819b8d6e90337b4cb36b35c2c6d0112c90a8e24 Author: Stephen Gildea Date: Sat Nov 4 21:46:27 2023 -0700 Further improve test coverage of time-stamp-pattern parsing * test/lisp/time-stamp-tests.el (time-stamp-custom-pattern): Use test strings that are easier to mis-parse, for a more exacting test. * (fz-make+zone, fz-make-zone): Declare pure. diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index 341c40b617b..c1036f636e5 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -89,12 +89,12 @@ time-stamp-custom-time-zone (iter-defun time-stamp-test-pattern-sequential () "Iterate through each possibility for a part of `time-stamp-pattern'." (let ((pattern-value-parts - '(("4/" "10/" "-9/" "0/" "") ;0: line limit - ("stamp<" "") ;1: start - ("%-d" "%_H" "%^a" "%#Z" "%:A" "%09z" "%%" "") ;2: format part 1 - (" " "x" ":" "\n" "") ;3: format part 2 - ("%-d" "%_H" "%^a" "%#Z" "%:A" "%09z" "%%") ;4: format part 3 - (">end" "")))) ;5: end + '(("4/" "10/" "-9/" "0/" "") ;0: line limit + ("stamp:" "") ;1: start + ("%-d" "%_H" "%^a" "%#Z" "%:A" "%019z" "%%" "") ;2: format part 1 + (" " "x" ":" "\n" "") ;3: format part 2 + ("%-d" "%_H" "%^a" "%#Z" "%:A" "%019z" "%%") ;4: format part 3 + ("end" "")))) ;5: end (dotimes (cur (length pattern-value-parts)) (dotimes (cur-index (length (nth cur pattern-value-parts))) (cl-flet ((extract-part @@ -118,15 +118,21 @@ time-stamp-test-pattern-sequential (iter-defun time-stamp-test-pattern-multiply () "Iterate through every combination of parts of `time-stamp-pattern'." (let ((line-limit-values '("" "4/")) - (start-values '("" "/stamp/")) - (format-values '("%%" "%m")) + (start-values '("" "/stamp1/")) + (format-values '("" "%%" "%m")) (end-values '("" ">end"))) ;; yield all combinations of the above (dolist (line-limit line-limit-values) (dolist (start start-values) (dolist (format format-values) (dolist (end end-values) - (iter-yield (list line-limit start format end)))))))) + ;; If the format is not supplied, the end cannot be either, + ;; so not all generated combinations are valid. + ;; (This is why the format can be supplied as "%%" to + ;; preserve the default format.) + (if (or (not (equal format "")) + (equal end "")) + (iter-yield (list line-limit start format end))))))))) (iter-defun time-stamp-test-pattern-all () (iter-yield-from (time-stamp-test-pattern-sequential)) @@ -156,7 +162,8 @@ time-stamp-custom-pattern (if (equal start1 "") (should (equal ts-start time-stamp-start)) (should (equal ts-start start1))) - (if (equal whole-format "%%") + (if (or (equal whole-format "") + (equal whole-format "%%")) (should (equal ts-format time-stamp-format)) (should (equal ts-format whole-format))) (if (equal end1 "") @@ -165,7 +172,8 @@ time-stamp-custom-pattern ;; return nil to stop time-stamp from calling us again nil))) (let ((time-stamp-pattern (concat - line-limit1 start1 whole-format end1))) + line-limit1 start1 whole-format end1)) + (case-fold-search nil)) (with-temp-buffer ;; prep the buffer with more than the ;; largest line-limit1 number of lines @@ -758,12 +766,14 @@ format-time-offset (defun fz-make+zone (h &optional m s) "Creates a non-negative offset." + (declare (pure t)) (let ((m (or m 0)) (s (or s 0))) (+ (* 3600 h) (* 60 m) s))) (defun fz-make-zone (h &optional m s) "Creates a negative offset. The arguments are all non-negative." + (declare (pure t)) (- (fz-make+zone h m s))) (defmacro formatz-should-equal (zone expect) commit c6c5bba06fcc1c467c547e4d35abc6bc5c2f3429 Author: Po Lu Date: Sun Nov 5 10:40:52 2023 +0800 Implement more Android text editing controls * lisp/term/android-win.el (android-deactivate-mark-command): New command. (select-all, start-selecting-text, stop-selecting-text): Arrange for commands manipulating the region to be executed when these keys are registered. * src/android.c (android_get_keysym_name): Return the keysym name of each of the new keysyms introduced. * src/androidterm.c (performContextMenuAction): Save special keysyms into key events for the selectAll, startSelectingText and stopSelectingText actions. diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 960dfdcb4a6..70e24f4ccc7 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -294,6 +294,21 @@ android-handle-dnd-event (define-key special-event-map [drag-n-drop] 'android-handle-dnd-event) + +;; Bind keys sent by input methods to manipulate the state of the +;; selection to commands which set or deactivate the mark. + +(defun android-deactivate-mark-command () + "Deactivate the mark in this buffer. +This command is generally invoked by input methods sending +the `stop-selecting-text' editing key." + (interactive) + (deactivate-mark)) + +(global-set-key [select-all] 'mark-whole-buffer) +(global-set-key [start-selecting-text] 'set-mark-command) +(global-set-key [stop-selecting-text] 'android-deactivate-mark-command) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/android.c b/src/android.c index 79f16568fd4..3397ec0e740 100644 --- a/src/android.c +++ b/src/android.c @@ -5598,6 +5598,27 @@ android_get_keysym_name (int keysym, char *name_return, size_t size) const char *buffer; jmethodID method; + /* These keysyms are special editor actions sent by the input + method. */ + + switch (keysym) + { + case 65536 + 1: + strncpy (name_return, "select-all", size - 1); + name_return[size] = '\0'; + return; + + case 65536 + 2: + strncpy (name_return, "start-selecting-text", size - 1); + name_return[size] = '\0'; + return; + + case 65536 + 3: + strncpy (name_return, "stop-selecting-text", size - 1); + name_return[size] = '\0'; + return; + } + method = service_class.name_keysym; string = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, @@ -5607,6 +5628,13 @@ android_get_keysym_name (int keysym, char *name_return, size_t size) (jint) keysym); android_exception_check (); + if (!string) + { + strncpy (name_return, "stop-selecting-text", size - 1); + name_return[size] = '\0'; + return; + } + buffer = (*android_java_env)->GetStringUTFChars (android_java_env, (jstring) string, NULL); diff --git a/src/androidterm.c b/src/androidterm.c index 4a479daf452..1593cac36ba 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -5402,11 +5402,22 @@ NATIVE_NAME (performContextMenuAction) (JNIEnv *env, jobject object, switch (action) { + /* The subsequent three keycodes are addressed by + android_get_keysym_name rather than in keyboard.c. */ + case 0: /* android.R.id.selectAll */ + key = 65536 + 1; + break; + case 1: /* android.R.id.startSelectingText */ + key = 65536 + 2; + break; + case 2: /* android.R.id.stopSelectingText */ + key = 65536 + 3; + break; + default: - /* These actions are not implemented. */ return; case 3: /* android.R.id.cut */ commit 41e801fea1caff57203f76693ac4f0fe1ba2df03 Author: Dmitry Gutov Date: Sun Nov 5 02:35:25 2023 +0200 Add project-any-command and project-prefix-or-any-command * lisp/progmodes/project.el (project-any-command): New command. (project-prefix-map): Bind it to 'o'. (project-switch-commands): Add entry for it here too. (project-prefix-or-any-command): New command (bug#63648). (project-switch-commands): Update the custom type to mention 'project-prefix-or-any-command' as well. * etc/NEWS: Document the change. diff --git a/etc/NEWS b/etc/NEWS index e29a787a0cc..c06a013466f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1056,6 +1056,16 @@ additionally traverse the parent directories until a VCS root is found (if any), so that the ignore rules for that repository are used, and the file listing's performance is still optimized. +*** New commands 'project-any-command' and 'project-prefix-or-any-command'. +The former is now bound to 'C-x p o' by default. +The latter is designed primarily for use as a value of +'project-switch-commands'. If instead of a short menu you prefer to +have access to all keys defined inside 'project-prefix-map', as well +as global bindings (to run other commands inside the project root), +you can add this to your init script: + + (setq project-switch-commands #'project-prefix-or-any-command) + ** 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/progmodes/project.el b/lisp/progmodes/project.el index 57d9d8e99ab..a6426c08840 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -855,6 +855,7 @@ project-prefix-map (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) (define-key map "x" 'project-execute-extended-command) + (define-key map "o" 'project-any-command) (define-key map "\C-b" 'project-list-buffers) map) "Keymap for project commands.") @@ -1817,6 +1818,46 @@ project-execute-extended-command (let ((default-directory (project-root (project-current t)))) (call-interactively #'execute-extended-command))) +;;;###autoload +(defun project-any-command (&optional overriding-map prompt-format) + "Run the next command in the current project. +If the command is in `project-prefix-map', it gets passed that +info with `project-current-directory-override'. 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." + (interactive) + (let* ((pr (project-current t)) + (prompt-format (or prompt-format "[execute in %s]:")) + (command (let ((overriding-local-map overriding-map)) + (key-binding (read-key-sequence + (format prompt-format (project-root pr))) + t))) + (root (project-root pr)) + found) + (when command + ;; We could also check the command name against "\\`project-", + ;; and/or (get command 'project-command). + (map-keymap + (lambda (_evt cmd) (if (eq cmd command) (setq found t))) + project-prefix-map) + (if found + (let ((project-current-directory-override root)) + (call-interactively command)) + (let ((default-directory root)) + (call-interactively command)))))) + +;;;###autoload +(defun project-prefix-or-any-command () + "Run the next command in the current project. +Works like `project-any-command', but also mixes in the shorter +bindings from `project-prefix-map'." + (interactive) + (project-any-command project-prefix-map "[execute in %s]:")) + (defun project-remember-projects-under (dir &optional recursive) "Index all projects below a directory DIR. If RECURSIVE is non-nil, recurse into all subdirectories to find @@ -1895,7 +1936,8 @@ project-switch-commands (project-find-regexp "Find regexp") (project-find-dir "Find directory") (project-vc-dir "VC-Dir") - (project-eshell "Eshell")) + (project-eshell "Eshell") + (project-any-command "Other")) "Alist mapping commands to descriptions. Used by `project-switch-project' to construct a dispatch menu of commands available upon \"switching\" to another project. @@ -1919,7 +1961,9 @@ project-switch-commands (choice :tag "Key to press" (const :tag "Infer from the keymap" nil) (character :tag "Explicit key")))) - (symbol :tag "Single command"))) + (const :tag "Use both short keys and global bindings" + project-prefix-or-any-command) + (symbol :tag "Custom command"))) (defcustom project-switch-use-entire-map nil "Whether `project-switch-project' will use the entire `project-prefix-map'. commit f99a0dae7ca1c5fe5232dafd7b1290b3435ad526 Author: F. Jason Park Date: Thu Nov 2 17:05:48 2023 -0700 Align date stamps to whole days in ERC * lisp/erc/erc-stamp.el (erc-stamp--current-time): Ditch overriding precedence of the `erc--ts' property in `:around' method because the variable `erc-stamp--current-time' fills that role well enough. (erc-stamp--current-datestamp-left): Remove unused variable. (erc-stamp--insert-date-stamp-as-phony-message): Assume `erc-timestamp-last-inserted-left' has already been assigned the updated rendered stamp for the current time. (erc-stamp--lr-date-on-pre-modify): Use the variable `erc-stamp--current-time' instead of the `erc-ts' property to convey an overriding time value for `erc-add-timestamp'. Set `erc-timestamp-last-inserted-left' instead of fiddling with another temporary variable to hack around these ill-fitting interfaces. Use day-aligned time value for the `erc-ts' property assigned to date stamps. (erc-stamp--date-mode): New internal minor mode. (erc-insert-timestamp-left-and-right): Defer to `erc-stamp--date-mode' for setting up date-stamp specific hooks. (erc-stamp--time-as-day): New function to "round" a date stamp to start of local day. (erc-stamp--setup): Defer to `erc-stamp--date-mode' for date-stamp specific teardown. (Bug#60936) * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--current-time-value): Change default value to nil. (erc-stamp--current-time): New method for test cases. (erc-fill-tests--insert-privmsg): Use realistic value for `unparsed' slot. (erc-fill-tests--wrap-populate): Bind `erc-fill-tests--current-time-value' to 0. Don't mock the function `erc-stamp--current-time' because doing so inhibits normal polymorphic dispatch, which test cases rely on for delivering correct timestamp values in varied contexts. ; * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update. diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 71036a9a853..e23380eb936 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -216,9 +216,7 @@ erc-stamp--current-time (erc-compat--current-lisp-time)) (cl-defmethod erc-stamp--current-time :around () - (or erc-stamp--current-time - (and erc--msg-props (gethash 'erc-ts erc--msg-props)) - (cl-call-next-method))) + (or erc-stamp--current-time (cl-call-next-method))) (defvar erc-stamp--skip nil "Non-nil means inhibit `erc-add-timestamp' completely.") @@ -653,9 +651,6 @@ erc-stamp--propertize-left-date-stamp (erc--hide-message 'timestamp) (run-hooks 'erc-stamp--insert-date-hook)) -;; A kludge to pass state from insert hook to nested insert hook. -(defvar erc-stamp--current-datestamp-left nil) - (defun erc-stamp--format-date-stamp (ct) "Format left date stamp with `erc-timestamp-format-left'." (unless erc-stamp--date-format-end @@ -676,7 +671,7 @@ erc-stamp--format-date-stamp ;; adjust invisibility props. (defun erc-stamp--insert-date-stamp-as-phony-message (string) (cl-assert (string-empty-p string)) - (setq string erc-stamp--current-datestamp-left) + (setq string erc-timestamp-last-inserted-left) (let ((erc-stamp--skip t) (erc-insert-modify-hook `(,@erc-insert-modify-hook erc-stamp--propertize-left-date-stamp)) @@ -684,27 +679,59 @@ erc-stamp--insert-date-stamp-as-phony-message ;; Don't run hooks that aren't expecting a narrowed buffer. (erc-insert-pre-hook nil) (erc-insert-done-hook nil)) - (erc-display-message nil nil (current-buffer) string) - (setq erc-timestamp-last-inserted-left string))) + (erc-display-message nil nil (current-buffer) string))) (defun erc-stamp--lr-date-on-pre-modify (_) - (when-let ((ct (erc-stamp--current-time)) + (when-let (((not erc-stamp--skip)) + (ct (erc-stamp--current-time)) (rendered (erc-stamp--format-date-stamp ct)) ((not (string-equal rendered erc-timestamp-last-inserted-left))) - (erc-stamp--current-datestamp-left rendered) (erc-insert-timestamp-function #'erc-stamp--insert-date-stamp-as-phony-message)) (save-excursion (save-restriction (narrow-to-region (or erc--insert-marker erc-insert-marker) (or erc--insert-marker erc-insert-marker)) - ;; Forget current `erc-cmd', etc. - (let ((erc--msg-props - (map-into `((erc-msg . datestamp) - (erc-ts . ,(erc-stamp--current-time))) - 'hash-table)) - erc-timestamp-format erc-away-timestamp-format) - (erc-add-timestamp)))))) + ;; Ensure all hooks, like `erc-stamp--insert-date-hook', only + ;; see the let-bound value below during `erc-add-timestamp'. + (setq erc-timestamp-last-inserted-left nil) + (let* ((aligned (erc-stamp--time-as-day ct)) + (erc-stamp--current-time aligned) + ;; Forget current `erc-cmd', etc. + (erc--msg-props (map-into `((erc-msg . datestamp)) + '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))))) + +;; This minor mode is just a placeholder and currently unhelpful for +;; managing complexity. A useful version would leave a marker during +;; post-modify hooks and then perform insertions (before markers) +;; during "done" hooks. This would enable completely decoupling from +;; and possibly deprecating `erc-insert-timestamp-left-and-right'. +;; However, doing this would require expanding the internal API to +;; include insertion and deletion handlers for twiddling and massaging +;; text properties based on context immediately after modifying text +;; earlier in a buffer (away from `erc-insert-marker'). Without such +;; handlers, things like "merged" `fill-wrap' speakers and invisible +;; messages may be damaged by buffer modifications. +(define-minor-mode erc-stamp--date-mode + "Insert date stamps as standalone messages." + :interactive nil + (if erc-stamp--date-mode + (progn (add-hook 'erc-insert-pre-hook + #'erc-stamp--lr-date-on-pre-modify 10 t) + (add-hook 'erc-pre-send-functions + #'erc-stamp--lr-date-on-pre-modify 10 t)) + (kill-local-variable 'erc-timestamp-last-inserted-left) + (remove-hook 'erc-insert-pre-hook + #'erc-stamp--lr-date-on-pre-modify t) + (remove-hook 'erc-pre-send-functions + #'erc-stamp--lr-date-on-pre-modify t))) (defvar erc-stamp-prepend-date-stamps-p nil "When non-nil, date stamps are not independent messages. @@ -736,9 +763,12 @@ erc-insert-timestamp-left-and-right (and (or (null erc-timestamp-format-left) (string-empty-p ; compat (string-trim erc-timestamp-format-left "\n"))) + (always (erc-stamp--date-mode -1)) (setq erc-stamp-prepend-date-stamps-p t))) - (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify 10 t) - (add-hook 'erc-pre-send-functions #'erc-stamp--lr-date-on-pre-modify 10 t) + (erc-stamp--date-mode +1) + ;; Hooks used by ^ are the preferred means of inserting date + ;; stamps. But they'll never see this inaugural message, so it + ;; must be handled specially. (let ((erc--insert-marker (point-min-marker)) (end-marker (point-max-marker))) (set-marker-insertion-type erc--insert-marker t) @@ -771,6 +801,19 @@ erc-insert-timestamp-left-and-right ;; for testing: (setq erc-timestamp-only-if-changed-flag nil) (defvar erc-stamp--tz nil) +;; Unfortunately, cursory measurements show that this function is 10x +;; slower than `erc-format-timestamp', which is perhaps +;; counterintuitive. Thus, we use the latter for our cache, and +;; 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." + (let* ((current-time-list) ; flag + (decoded (decode-time current-time erc-stamp--tz))) + (setf (decoded-time-second decoded) 0 + (decoded-time-minute decoded) 0 + (decoded-time-hour decoded) 0) + (encode-time decoded))) ; may return an integer + (defun erc-format-timestamp (time format) "Return TIME formatted as string according to FORMAT. Return the empty string if FORMAT is nil." @@ -843,11 +886,9 @@ erc-stamp--setup (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) (erc-munge-invisibility-spec)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. - (remove-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify t) - (remove-hook 'erc-pre-send-functions #'erc-stamp--lr-date-on-pre-modify t) + (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' (kill-local-variable 'erc-stamp--last-stamp) (kill-local-variable 'erc-timestamp-last-inserted) - (kill-local-variable 'erc-timestamp-last-inserted-left) (kill-local-variable 'erc-timestamp-last-inserted-right) (kill-local-variable 'erc-stamp--date-format-end))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 8179cbda2cb..c21f3935503 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -27,13 +27,19 @@ (require 'erc-fill) (defvar erc-fill-tests--buffers nil) -(defvar erc-fill-tests--current-time-value 0) +(defvar erc-fill-tests--current-time-value nil) + +(cl-defmethod erc-stamp--current-time + (&context (erc-fill-tests--current-time-value integer)) + erc-fill-tests--current-time-value) (defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) (let* ((msg (erc-format-privmessage speaker (apply #'concat msg-parts) nil t)) - (parsed (make-erc-response :unparsed msg :sender speaker + (parsed (make-erc-response :unparsed (format ":%s PRIVMSG #chan :%s" + speaker msg) + :sender speaker :command "PRIVMSG" :command-args (list "#chan" msg) :contents msg))) @@ -45,12 +51,11 @@ erc-fill-tests--wrap-populate (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) (inhibit-message noninteractive) + (erc-fill-tests--current-time-value 0) erc-insert-post-hook extended-command-history erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (cl-letf (((symbol-function 'erc-stamp--current-time) - (lambda () erc-fill-tests--current-time-value)) - ((symbol-function 'erc-server-connect) + (cl-letf (((symbol-function 'erc-server-connect) (lambda (&rest _) (setq erc-server-process (start-process "sleep" (current-buffer) "sleep" "1")) 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 8a6f2289f5d..c07eee3517f 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-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-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 1680332400 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-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-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-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-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-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-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-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#)) +#("\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-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-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-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-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-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-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-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-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-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#)) 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 3eb4be4919b..cf5cdb4f825 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 (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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg erc-ts 0 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-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#) 436 437 (erc-msg datestamp erc-ts 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 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#)) +#("\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 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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg erc-ts 0 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-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#) 436 437 (erc-msg datestamp erc-ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 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#)) 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 f966daeed1f..ad4e6483f01 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-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-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 1680332400 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-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-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 msg 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-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-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 msg 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-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 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-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-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-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-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 msg 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-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-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 msg 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-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#)) commit 4c8510857693812ff7ff635cd0d70f97022792db Author: F. Jason Park Date: Sat Nov 4 13:48:11 2023 -0700 Decouple disparate escape-hatch concerns in erc-stamp * lisp/erc/erc-stamp.el (erc-stamp--allow-unmanaged): Improve doc string. (erc-stamp--permanent-cursor-sensor-functions): New variable to take over the formerly provided `cursor-sensor-functions' aspect of the flag `erc-stamp--allow-unmanaged'. (erc-add-timestamp): Use `erc-stamp--permanent-cursor-sensor-functions' instead of `erc-stamp--allow-unmanaged' in guard condition. (erc-munge-invisibility-spec): Use dedicated compatibility flag `erc-stamp--permanent-cursor-sensor-functions' and forgo unnecessary setup when it's non-nil. (Bug#60936) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index b65c7adf676..71036a9a853 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -224,9 +224,19 @@ erc-stamp--skip "Non-nil means inhibit `erc-add-timestamp' completely.") (defvar erc-stamp--allow-unmanaged nil - "Non-nil means `erc-add-timestamp' runs unconditionally. -Escape hatch for third-parties using lower-level API functions, -such as `erc-display-line', directly.") + "Non-nil means run `erc-add-timestamp' almost unconditionally. +This is an unofficial escape hatch for code wanting to use +lower-level message-insertion functions, like `erc-insert-line', +directly. Third parties needing such functionality should +petition for it via \\[erc-bug].") + +(defvar erc-stamp--permanent-cursor-sensor-functions nil + "Non-nil means add `cursor-sensor-functions' unconditionally. +This is an unofficial escape hatch for code wanting the text +property `cursor-sensor-functions' to always be present, +regardless of the option `erc-echo-timestamps'. Third parties +needing such pre-5.6 behavior to stick around should make that +known via \\[erc-bug].") (defun erc-add-timestamp () "Add timestamp and text-properties to message. @@ -256,8 +266,8 @@ erc-add-timestamp (erc-away-time)) (funcall erc-insert-away-timestamp-function (erc-format-timestamp ct erc-away-timestamp-format))) - (when erc-stamp--allow-unmanaged - (add-text-properties (point-min) (1- (point-max)) + (when erc-stamp--permanent-cursor-sensor-functions + (add-text-properties (point-min) (max (point-min) (1- (point-max))) ;; It's important for the function to ;; be different on different entries (bug#22700). (list 'cursor-sensor-functions @@ -793,16 +803,18 @@ erc-munge-invisibility-spec (cursor-intangible-mode -1))) (if erc-echo-timestamps (progn - (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) - (unless (or erc-stamp--allow-unmanaged erc-stamp--csf-props-updated-p) - (setq erc-stamp--csf-props-updated-p t) - (let ((erc--msg-props (map-into '((erc-ts . t)) 'hash-table))) - (with-silent-modifications - (erc--traverse-inserted (point-min) erc-insert-marker - #'erc-stamp--add-csf-on-post-modify)))) + (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) + (unless erc-stamp--csf-props-updated-p + (setq erc-stamp--csf-props-updated-p t) + (let ((erc--msg-props (map-into '((erc-ts . t)) 'hash-table))) + (with-silent-modifications + (erc--traverse-inserted + (point-min) erc-insert-marker + #'erc-stamp--add-csf-on-post-modify))))) (cursor-sensor-mode +1) ; idempotent (when (>= emacs-major-version 29) (add-function :before-until (local 'clear-message-function) commit 781f950edab0509f12e3ec4880690ef6541841ee Author: F. Jason Park Date: Sat Nov 4 11:08:22 2023 -0700 Preserve user markers when inserting ERC date stamps * lisp/erc/erc-stamp.el (erc-stamp--insert-date-stamp-as-phony-message): Ensure existing user markers aren't displaced by date-stamp insertion. * lisp/erc/erc.el (erc--insert-line-function): New function-valued variable for overriding `insert'. (erc-insert-line): Call `erc--insert-line-function', when non-nil, to insert line specially. * test/lisp/erc/erc-scenarios-stamp.el (erc-scenarios-stamp--on-insert-modify): New assertion helper function. (erc-scenarios-stamp--date-mode/left-and-right): New test. (Bug#60936) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index b5224674783..b65c7adf676 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -670,6 +670,7 @@ erc-stamp--insert-date-stamp-as-phony-message (let ((erc-stamp--skip t) (erc-insert-modify-hook `(,@erc-insert-modify-hook erc-stamp--propertize-left-date-stamp)) + (erc--insert-line-function #'insert-before-markers) ;; Don't run hooks that aren't expecting a narrowed buffer. (erc-insert-pre-hook nil) (erc-insert-done-hook nil)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a5457601223..fd57cb9d6a0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3083,6 +3083,9 @@ erc--traverse-inserted (unless (eq end erc-insert-marker) (set-marker end nil))) +(defvar erc--insert-line-function nil + "When non-nil, an alterntive to `insert' for inserting messages.") + (defvar erc--insert-marker nil "Internal override for `erc-insert-marker'.") @@ -3134,7 +3137,9 @@ erc-insert-line (save-restriction (widen) (goto-char insert-position) - (insert string) + (if erc--insert-line-function + (funcall erc--insert-line-function string) + (insert string)) (erc--assert-input-bounds) ;; run insertion hook, with point at restored location (save-restriction diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index b98300d04be..49307dd228a 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -113,4 +113,69 @@ erc-scenarios-stamp--legacy-date-stamps (not (eq 'erc-timestamp (field-at-pos (point)))))) (should (erc--get-inserted-msg-prop 'erc-cmd))))))) +;; This user-owned hook member places a marker on the first message in +;; a buffer. Inserting a date stamp in front of it shouldn't move the +;; marker. +(defun erc-scenarios-stamp--on-insert-modify () + (unless (marker-position erc-scenarios-stamp--user-marker) + (set-marker erc-scenarios-stamp--user-marker (point-min)) + (save-excursion + (goto-char erc-scenarios-stamp--user-marker) + (should (looking-at "Opening")))) + + ;; Sometime after the first message ("Opening connection.."), assert + ;; that the marker we just placed hasn't moved. + (when (erc--check-msg-prop 'erc-cmd 2) + (save-restriction + (widen) + (ert-info ("Date stamp preserves opening user marker") + (goto-char erc-scenarios-stamp--user-marker) + (should-not (eq 'erc-timestamp (field-at-pos (point)))) + (should (looking-at "Opening")) + (should (eq 'unknown (get-text-property (point) 'erc-msg)))))) + + ;; On 003 ("*** This server was created on"), clear state to force a + ;; new date stamp on the next message. + (when (erc--check-msg-prop 'erc-cmd 3) + (setq erc-timestamp-last-inserted-left nil) + (set-marker erc-scenarios-stamp--user-marker erc-insert-marker))) + +(ert-deftest erc-scenarios-stamp--date-mode/left-and-right () + + (should (eq erc-insert-timestamp-function + #'erc-insert-timestamp-left-and-right)) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect)) + (port (process-contact dumb-server :service)) + (erc-scenarios-stamp--user-marker (make-marker)) + (erc-server-flood-penalty 0.1) + (erc-modules (if (zerop (random 2)) + (cons 'fill-wrap erc-modules) + erc-modules)) + (expect (erc-d-t-make-expecter)) + (erc-mode-hook + (cons (lambda () + (add-hook 'erc-insert-modify-hook + #'erc-scenarios-stamp--on-insert-modify -99 t)) + erc-mode-hook))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + + (funcall expect 5 "Welcome to the foonet") + (funcall expect 5 "*** AWAYLEN=390") + + (ert-info ("Date stamp preserves other user marker") + (goto-char erc-scenarios-stamp--user-marker) + (should-not (eq 'erc-timestamp (field-at-pos (point)))) + (should (looking-at (rx "*** irc.foonet.org oragono"))) + (should (eq 's004 (get-text-property (point) 'erc-msg)))) + + (funcall expect 5 "This server is in debug mode"))))) + ;;; erc-scenarios-stamp.el ends here commit f7c7f7ac20defe3ee8a32659a6799b20ddd58aeb Author: F. Jason Park Date: Wed Nov 1 19:22:49 2023 -0700 Don't over-truncate erc-timestamp-format-left * lisp/erc/erc-stamp.el (erc-timestamp-format-left): Fix typo in doc string and mention that changing the value mid-session requires cycling the minor mode. (erc-echo-timestamp-format): Add Custom :tag for choices. (erc-stamp--date-format-end): Revise doc string. (erc-stamp--format-date-stamp): Fix bug involving erroneous truncation parameter for `substring' when `erc-timestamp-format-left' doesn't end in a newline. Thanks to Emanuel Berg for catching this. (erc-stamp-prepend-date-stamps-p) Revise doc string. (erc-insert-timestamp-left-and-right): Add comment regarding compatibility concession. (Bug#60936) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 412740ac192..b5224674783 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -60,7 +60,7 @@ erc-timestamp-format-left Only considered when `erc-insert-timestamp-function' is set to `erc-insert-timestamp-left-and-right'. Used for displaying date stamps on their own line, between messages. ERC inserts this -flavor of stamp as a separate \"psuedo message\", so a final +flavor of stamp as a separate \"pseudo message\", so a final newline isn't necessary. For compatibility, only additional trailing newlines beyond the first become empty lines. For example, the default value results in an empty line after the @@ -69,7 +69,8 @@ erc-timestamp-format-left expects to display these stamps less frequently, so the formatting specifiers should reflect that. To omit these stamps entirely, use a different `erc-insert-timestamp-function', such -as `erc-timestamp-format-right'." +as `erc-timestamp-format-right'. Note that changing this value +during an ERC session requires cycling `erc-stamp-mode'." :type 'string) (defcustom erc-timestamp-format-right nil @@ -147,8 +148,9 @@ erc-echo-timestamp-format "Format string to be used when `erc-echo-timestamps' is non-nil. This string specifies the format of the timestamp being echoed in the minibuffer." - :type '(choice (const "Timestamped %A, %H:%M:%S") - (const "%Y-%m-%d %H:%M:%S %Z") + :type '(choice (const :tag "Timestamped Monday, 15:04:05" + "Timestamped %A, %H:%M:%S") + (const :tag "2006-01-02 15:04:05 MST" "%F %T %Z") string)) (defcustom erc-echo-timestamp-zone nil @@ -629,7 +631,11 @@ erc-stamp--insert-date-hook "Functions appended to send and modify hooks when inserting date stamp.") (defvar-local erc-stamp--date-format-end nil - "Substring index marking usable portion of date stamp format.") + "Tristate value indicating how and whether date stamps have been set up. +A non-nil value means the buffer has been initialized to use date +stamps. An integer marks the `substring' TO parameter for +truncating `erc-timestamp-format-left' prior to rendering. A +value of t means the option's value doesn't require trimming.") (defun erc-stamp--propertize-left-date-stamp () (add-text-properties (point-min) (1- (point-max)) @@ -645,12 +651,14 @@ erc-stamp--format-date-stamp (unless erc-stamp--date-format-end ;; Don't add text properties to the trailing newline. (setq erc-stamp--date-format-end - (if (string-suffix-p "\n" erc-timestamp-format-left) -1 0))) + (if (string-suffix-p "\n" erc-timestamp-format-left) -1 t))) ;; Ignore existing `invisible' prop value because date stamps should ;; never be hideable except via `timestamp'. (let (erc-stamp--invisible-property) - (erc-format-timestamp ct (substring erc-timestamp-format-left - 0 erc-stamp--date-format-end)))) + (erc-format-timestamp ct (if (numberp erc-stamp--date-format-end) + (substring erc-timestamp-format-left + 0 erc-stamp--date-format-end) + erc-timestamp-format-left)))) ;; Calling `erc-display-message' from within a hook it's currently ;; running is roundabout, but it's a definite means of ensuring hooks @@ -689,11 +697,13 @@ erc-stamp--lr-date-on-pre-modify (defvar erc-stamp-prepend-date-stamps-p nil "When non-nil, date stamps are not independent messages. -Users should think twice about enabling this escape hatch. It -will likely degraded the user experience by causing post-5.5 -features, like `fill-wrap', dynamic invisibility, etc., to -malfunction. Basic support for the default configuration may -expire earlier than normally expected.") +This flag restores pre-5.6 behavior in which date stamps formed +the leading portion of affected messages. Beware that enabling +this degrades the user experience by causing 5.6+ features, like +`fill-wrap', dynamic invisibility, etc., to malfunction. When +non-nil, none of the newline twiddling mentioned in the doc +string for `erc-timestamp-format-left' occurs. That is, ERC does +not append or remove trailing newlines.") (make-obsolete-variable 'erc-stamp-prepend-date-stamps-p "unsupported legacy behavior" "30.1") @@ -731,7 +741,10 @@ erc-insert-timestamp-left-and-right (if erc-timestamp-format-right (erc-format-timestamp ct erc-timestamp-format-right) string)))) - ;; Maybe insert legacy date stamp. + ;; We should arguably be ensuring a trailing newline on legacy + ;; "prepended" date stamps as well. However, since this is a + ;; compatibility oriented code path, and pre-5.6 did no such + ;; thing, better to punt. (when-let ((erc-stamp-prepend-date-stamps-p) (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) ((not (string= ts-left erc-timestamp-last-inserted-left)))) commit fb578ddfb25371621df6e300a98a1ea1463dd06b Author: F. Jason Park Date: Fri Nov 3 16:07:20 2023 -0700 Really fix off-by-one in erc--get-inserted-msg-bounds * lisp/erc/erc.el (erc--get-inserted-msg-bounds): Account for `previous-single-property-change' returning a position adjacent to that with an actual changed value. The prior attempt at addressing this was insufficient. * test/lisp/erc/erc-tests.el (erc--get-inserted-msg-bounds): New test. ; * test/lisp/erc/resources/base/local-modules/second.eld: Timeout. ; * test/lisp/erc/resources/base/local-modules/third.eld: Timeout. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0471ee0bbb8..a5457601223 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3026,16 +3026,19 @@ erc--get-inserted-msg-bounds "Return the bounds of a message in an ERC buffer. Return ONLY one side when the first arg is `end' or `beg'. With POINT, search from POINT instead of `point'." + ;; TODO add edebug spec. `(let* ((point ,(or point '(point))) (at-start-p (get-text-property point 'erc-msg))) (and-let* - (,@(and (member only '(nil 'beg)) + (,@(and (member only '(nil beg 'beg)) '((b (or (and at-start-p point) (and-let* ((p (previous-single-property-change point 'erc-msg))) - (if (= p (1- point)) p (1- p))))))) - ,@(and (member only '(nil 'end)) + (if (= p (1- point)) + (if (get-text-property p 'erc-msg) p (1- p)) + (1- p))))))) + ,@(and (member only '(nil end 'end)) '((e (1- (next-single-property-change (if at-start-p (1+ point) point) 'erc-msg nil erc-insert-marker)))))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 1af087e7e31..916b394c8ff 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1432,6 +1432,55 @@ erc-process-input-line (should-not calls)))))) +(ert-deftest erc--get-inserted-msg-bounds () + (erc-mode) + (erc--initialize-markers (point) nil) + (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi" + :sender "bob" + :command "PRIVMSG" + :command-args (list "#chan" "hi") + :contents "hi")) + (erc--msg-prop-overrides '((erc-ts . 0)))) + (erc-display-message parsed nil (current-buffer) + (erc-format-privmessage "bob" "hi" nil t))) + (goto-char 3) + (should (looking-at " hi")) + (goto-char 11) + (should (looking-back " hi")) + + (ert-info ("Parameter `only' being `beg'") + (dolist (i (number-sequence 3 11)) + (goto-char i) + (ert-info ((format "At %d (%c)" i (char-after i))) + (should (= 3 (erc--get-inserted-msg-bounds 'beg))))) + + (ert-info ("Parameter `point'") + (dolist (i (number-sequence 3 11)) + (ert-info ((format "At %d (%c)" i (char-after i))) + (should (= 3 (erc--get-inserted-msg-bounds 'beg i))))))) + + (ert-info ("Parameter `only' being `end'") + (dolist (i (number-sequence 3 11)) + (goto-char i) + (ert-info ((format "At %d (%c)" i (char-after i))) + (should (= 11 (erc--get-inserted-msg-bounds 'end))))) + + (ert-info ("Parameter `point'") + (dolist (i (number-sequence 3 11)) + (ert-info ((format "At %d (%c)" i (char-after i))) + (should (= 11 (erc--get-inserted-msg-bounds 'end i))))))) + + (ert-info ("Parameter `only' being nil") + (dolist (i (number-sequence 3 11)) + (goto-char i) + (ert-info ((format "At %d (%c)" i (char-after i))) + (should (equal '(3 . 11) (erc--get-inserted-msg-bounds nil))))) + + (ert-info ("Parameter `point'") + (dolist (i (number-sequence 3 11)) + (ert-info ((format "At %d (%c)" i (char-after i))) + (should (equal '(3 . 11) (erc--get-inserted-msg-bounds nil i)))))))) + (ert-deftest erc--delete-inserted-message () (erc-mode) (erc--initialize-markers (point) nil) diff --git a/test/lisp/erc/resources/base/local-modules/second.eld b/test/lisp/erc/resources/base/local-modules/second.eld index a96103b2aa1..5823d63b874 100644 --- a/test/lisp/erc/resources/base/local-modules/second.eld +++ b/test/lisp/erc/resources/base/local-modules/second.eld @@ -41,7 +41,7 @@ (0.07 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: To you that know them not. This to my mother.") (0.00 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Some enigma, some riddle: come, thy l'envoy; begin.")) -((quit 1 "QUIT :\2ERC\2") +((quit 10 "QUIT :\2ERC\2") (0.03 ":tester`!~u@u9iqi96sfwk9s.irc QUIT")) ((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/local-modules/third.eld b/test/lisp/erc/resources/base/local-modules/third.eld index 19bdd6efcce..e24825c3217 100644 --- a/test/lisp/erc/resources/base/local-modules/third.eld +++ b/test/lisp/erc/resources/base/local-modules/third.eld @@ -37,7 +37,7 @@ (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: No remedy, my lord, when walls are so wilful to hear without warning.") (0.01 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Let our reciprocal vows be remembered. You have many opportunities to cut him off; if your will want not, time and place will be fruitfully offered. There is nothing done if he return the conqueror; then am I the prisoner, and his bed my gaol; from the loathed warmth whereof deliver me, and supply the place for your labor.")) -((quit 1 "QUIT :\2ERC\2") +((quit 10 "QUIT :\2ERC\2") (0.03 ":tester`!~u@u9iqi96sfwk9s.irc QUIT :Quit")) ((drop 0 DROP)) commit 18e2de1bec9c2d49a9d7352db04b44deeea6a22b Author: Eli Zaretskii Date: Sat Nov 4 17:46:27 2023 +0200 ; * lisp/bindings.el (right-word, left-word): Doc fix. diff --git a/lisp/bindings.el b/lisp/bindings.el index e118fa1a35c..084e3a2060c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -942,6 +942,14 @@ right-word and \\[backward-word], which see. Value is normally t. + +The word boundaries are normally determined by the buffer's syntax +table and character script (according to `char-script-table'), but +`find-word-boundary-function-table', such as set up by `subword-mode', +can change that. If a Lisp program needs to move by words determined +strictly by the syntax table, it should use `forward-word-strictly' +instead. See Info node `(elisp) Word Motion' for details. + If an edge of the buffer or a field boundary is reached, point is left there and the function returns nil. Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil." @@ -958,6 +966,14 @@ left-word and \\[forward-word], which see. Value is normally t. + +The word boundaries are normally determined by the buffer's syntax +table and character script (according to `char-script-table'), but +`find-word-boundary-function-table', such as set up by `subword-mode', +can change that. If a Lisp program needs to move by words determined +strictly by the syntax table, it should use `forward-word-strictly' +instead. See Info node `(elisp) Word Motion' for details. + If an edge of the buffer or a field boundary is reached, point is left there and the function returns nil. Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil." commit 0b5e2ce7612f71365fe061b8a15648e7b4ee053f Author: Eli Zaretskii Date: Sat Nov 4 17:29:24 2023 +0200 ; Fix last change in the FAQ * doc/misc/efaq.texi (Start Emacs maximized, Common requests): Fix last change. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index c20ad87f5f9..70f434d4b99 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1721,7 +1721,7 @@ Common requests * Editing MS-DOS files:: * Filling paragraphs with a single space:: * Escape sequences in shell output:: -* Fullscreen mode on MS-Windows:: +* Start Emacs maximized:: * Emacs in a Linux console:: @end menu @@ -3113,7 +3113,7 @@ Escape sequences in shell output @code{ansi-color} package, which lets Shell mode recognize these escape sequences. It is enabled by default. -@node Start Emacs Maximized +@node Start Emacs maximized @section How can I start Emacs in full screen? @cindex Maximize frame @cindex Fullscreen mode commit 0e59541fa203d7ecb6afcf0ce7805e87d41bdc65 Author: Stefan Kangas Date: Sat Nov 4 14:51:33 2023 +0100 Make FAQ on starting Emacs maximized portable * doc/misc/efaq.texi (Start Emacs Maximized): Rename node from "Fullscreen mode on MS-Windows". Make advice portable to other platforms, and remove MS-Windows specific hacks. Ref: https://lists.gnu.org/r/emacs-devel/2023-10/msg00733.html Co-authored-by: David Hedlund diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 631d7016acf..c20ad87f5f9 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3113,45 +3113,22 @@ Escape sequences in shell output @code{ansi-color} package, which lets Shell mode recognize these escape sequences. It is enabled by default. -@node Fullscreen mode on MS-Windows -@section How can I start Emacs in fullscreen mode on MS-Windows? +@node Start Emacs Maximized +@section How can I start Emacs in full screen? @cindex Maximize frame @cindex Fullscreen mode -Beginning with Emacs 24.4 either run Emacs with the @samp{--maximized} -command-line option or put the following form in your init file -(@pxref{Setting up a customization file}): - -@lisp -(add-hook 'emacs-startup-hook 'toggle-frame-maximized) -@end lisp - -With older versions use the function @code{w32-send-sys-command}. For -example, you can put the following in your init file: - -@lisp -(add-hook 'emacs-startup-hook - (lambda () (w32-send-sys-command ?\xF030))) -@end lisp - -To avoid the slightly distracting visual effect of Emacs starting with -its default frame size and then growing to fullscreen, you can add an -@samp{Emacs.Geometry} entry to the Windows Registry settings. @xref{X -Resources,,, emacs, The GNU Emacs Manual}. To compute the correct -values for width and height you use in the Registry settings, first -maximize the Emacs frame and then evaluate @code{(frame-height)} and -@code{(frame-width)} with @kbd{M-:}. - -Alternatively, you can avoid the visual effect of Emacs changing its -frame size entirely in your init file (i.e., without using the -Registry), like this: +Run Emacs with the @samp{--maximized} command-line option or put the +following form in your early init file (@pxref{Early Init File,,, +emacs, The GNU Emacs Manual}). @lisp -(setq frame-resize-pixelwise t) -(set-frame-position nil 0 0) -(set-frame-size nil (display-pixel-width) (display-pixel-height) t) +(push '(fullscreen . maximized) default-frame-alist) @end lisp +Note that while some customizations of @code{default-frame-alist} +could have undesirable effects when modified in @file{early-init.el}, +it is okay to do it in this particular case. @node Emacs in a Linux console @section How can I alleviate the limitations of the Linux console? commit 3a17780b87b6ac07ff2e685a5f4b29e6abce29ef Author: Eli Zaretskii Date: Sat Nov 4 15:02:07 2023 +0200 ; Improve commentary in 'files-tests-save-buffer-read-only-file'. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 77a4c22ed6a..3492bd701b2 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1754,6 +1754,9 @@ files-tests-save-buffer-read-only-file (signal 'file-error "Write failed"))) (let* (;; Sanitize environment. + ;; The tests below test text for equality, so we need to + ;; disable any code- and EOL-conversions to avoid false + ;; positives and false negatives. (coding-system-for-read 'no-conversion) (coding-system-for-write 'no-conversion) (auto-save-default nil) commit ac59e30273b161d29f06d6e8155a2b4496412429 Author: Jens Schmidt Date: Wed Nov 1 19:56:06 2023 +0100 Add tests for saving to write-protected files * test/lisp/files-tests.el (files-tests--with-yes-or-no-p): Add macro. (files-tests-save-buffer-read-only-file): Add test for writing to write-protected files with `save-buffer'. (Bug#66546) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 63ce4dab7eb..77a4c22ed6a 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1717,6 +1717,154 @@ files-tests--save-some-buffers (set-buffer-modified-p nil) (kill-buffer buf))))))) +(defmacro files-tests--with-yes-or-no-p (reply &rest body) + "Execute BODY, providing replies to `yes-or-no-p' queries. +REPLY should be a cons (PROMPT . VALUE), and during execution of +BODY this macro provides VALUE as return value to all +`yes-or-no-p' calls prompting for PROMPT and nil to all other +`yes-or-no-p' calls. After execution of BODY, this macro ensures +that exactly one `yes-or-no-p' call prompting for PROMPT has been +executed during execution of BODY." + (declare (indent 1) (debug (sexp body))) + `(cl-letf* + ((reply ,reply) + (prompts nil) + ((symbol-function 'yes-or-no-p) + (lambda (prompt) + (let ((reply (cdr (assoc prompt (list reply))))) + (push (cons prompt reply) prompts) + reply)))) + ,@body + (should (equal prompts (list reply))))) + +(ert-deftest files-tests-save-buffer-read-only-file () + "Test writing to write-protected files with `save-buffer'. +Ensure that the issues from bug#66546 are fixed." + (ert-with-temp-directory dir + (cl-flet (;; Define convenience functions. + (file-contents (file) + (if (file-exists-p file) + (condition-case err + (with-temp-buffer + (insert-file-contents-literally file) + (buffer-string)) + (error err)) + 'missing)) + (signal-write-failed (&rest _) + (signal 'file-error "Write failed"))) + + (let* (;; Sanitize environment. + (coding-system-for-read 'no-conversion) + (coding-system-for-write 'no-conversion) + (auto-save-default nil) + (backup-enable-predicate nil) + (before-save-hook nil) + (write-contents-functions nil) + (write-file-functions nil) + (after-save-hook nil) + + ;; Set the name of the game. + (base "read-only-test") + (file (expand-file-name base dir)) + (backup (make-backup-file-name file)) + + (override-read-only-prompt + (format "File %s is write-protected; try to save anyway? " + base))) + + ;; Ensure that set-file-modes renders our test file read-only, + ;; otherwise skip this test. Use `file-writable-p' to test + ;; for read-only-ness, because that's what function + ;; `save-buffer' uses as well. + (with-temp-file file (insert "foo\n")) + (skip-unless (file-writable-p file)) + (set-file-modes file (logand (file-modes file) + (lognot #o0222))) + (skip-unless (not (file-writable-p file))) + + (with-current-buffer (find-file-noselect file) + ;; Prepare for tests backing up the file. + (setq buffer-read-only nil) + (goto-char (point-min)) + (insert "bar\n") + + ;; Save to read-only file with backup, declining prompt. + (files-tests--with-yes-or-no-p + (cons override-read-only-prompt nil) + (should-error + (save-buffer) + ;; "Attempt to save to a file that you aren't allowed to write" + :type 'error)) + (should-not buffer-backed-up) + (should (buffer-modified-p)) + (should-not (file-writable-p file)) + (should (equal (file-contents file) "foo\n")) + (should (equal (file-contents backup) 'missing)) + + ;; Save to read-only file with backup, accepting prompt, + ;; experiencing a write error. + (files-tests--with-yes-or-no-p + (cons override-read-only-prompt t) + (should-error + (cl-letf (((symbol-function 'write-region) + #'signal-write-failed)) + (save-buffer)) + ;; "Write failed" + :type 'file-error)) + (should-not buffer-backed-up) + (should (buffer-modified-p)) + (should-not (file-writable-p file)) + (should (equal (file-contents file) "foo\n")) + (should (equal (file-contents backup) 'missing)) + + ;; Save to read-only file with backup, accepting prompt. + (files-tests--with-yes-or-no-p + (cons override-read-only-prompt t) + (save-buffer)) + (should buffer-backed-up) + (should-not (buffer-modified-p)) + (should-not (file-writable-p file)) + (should-not (file-writable-p backup)) + (should (equal (file-contents file) "bar\nfoo\n")) + (should (equal (file-contents backup) "foo\n")) + + ;; Prepare for tests not backing up the file. + (setq buffer-backed-up nil) + (delete-file backup) + (goto-char (point-min)) + (insert "baz\n") + + ;; Save to read-only file without backup, accepting prompt, + ;; experiencing a write error. This tests that issue B of + ;; bug#66546 is fixed. The results of the "with backup" and + ;; "without backup" subtests are identical when a write + ;; error occurs, but the code paths to reach these results + ;; are not. In other words, this subtest is not redundant. + (files-tests--with-yes-or-no-p + (cons override-read-only-prompt t) + (should-error + (cl-letf (((symbol-function 'write-region) + #'signal-write-failed)) + (save-buffer 0)) + ;; "Write failed" + :type 'file-error)) + (should-not buffer-backed-up) + (should (buffer-modified-p)) + (should-not (file-writable-p file)) + (should (equal (file-contents file) "bar\nfoo\n")) + (should (equal (file-contents backup) 'missing)) + + ;; Save to read-only file without backup, accepting prompt. + ;; This tests that issue A of bug#66546 is fixed. + (files-tests--with-yes-or-no-p + (cons override-read-only-prompt t) + (save-buffer 0)) + (should-not buffer-backed-up) + (should-not (buffer-modified-p)) + (should-not (file-writable-p file)) + (should (equal (file-contents file) "baz\nbar\nfoo\n")) + (should (equal (file-contents backup) 'missing))))))) + (ert-deftest files-tests-save-some-buffers () "Test `save-some-buffers'. Test the 3 cases for the second argument PRED, i.e., nil, t, or commit 4f0fc3bfda3707fbf7f4296f29b8cfb8b8397390 Author: Po Lu Date: Sat Nov 4 13:03:27 2023 +0200 ; Document core input events problems with XInput2 * etc/PROBLEMS: Document problems with XInput2 and core input events. (Bug#66765) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index f0efbd6e411..126e876109a 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1997,6 +1997,16 @@ modern X servers have so many other ways to send input to clients without signifying that the event is synthesized that it does not matter. +*** Programs which use XSendEvent cannot send input events to Emacs. + +Emacs built to use the X Input Extension cannot receive core input +events sent through the SendEvent server request, since these events +intercepted by the X server when sent to input extension clients. + +For such programs to function again, Emacs must be run on an X server +where the input extension is disabled, or alternatively be configured +with the "--without-xinput2" option. + * Runtime problems on character terminals ** The meta key does not work on xterm. commit 2ba3ce27ebb4cfd478b56b05fae77ca545ee8b27 Author: Visuwesh Date: Sat Nov 4 08:09:14 2023 +0530 ; Update eww-suggest-uris :version. * lisp/net/eww.el (eww-suggest-uris): Bump it to 30.1 since it was changed. (Bug#66926) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index e43ef2bfe8b..d8a66b2ce32 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -100,7 +100,7 @@ eww-suggest-uris Each of the elements is a function returning either a string or a list of strings. The results will be joined into a single list with duplicate entries (if any) removed." - :version "27.1" + :version "30.1" :group 'eww :type 'hook :options '(eww-links-at-point commit 5ab5dfd64c85cee8c8d37e988519045e11f46a98 Author: Mattias Engdegård Date: Sat Nov 4 10:19:52 2023 +0100 Fix bytecomp-tests--dest-mountpoint test failure * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--dest-mountpoint): Add lexical cookie. Bug reported and fix suggested by Jens Schmidt (https://lists.gnu.org/archive/html/emacs-devel/2023-10/msg00719.html) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 4aa555f1e92..06918f5901c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1697,7 +1697,8 @@ bytecomp-tests--dest-mountpoint (byte-compile-error-on-warn t)) (should-not (file-remote-p input-file)) (should-not (file-remote-p output-file)) - (write-region "" nil input-file nil nil nil 'excl) + (write-region ";;; -*-lexical-binding:t-*-\n" + nil input-file nil nil nil 'excl) (write-region "" nil output-file nil nil nil 'excl) (unwind-protect (progn commit 7ad9891e949259a0c1c3fb9ac0bfccefe3d02e78 Merge: 050086931af 33fae4b02d6 Author: Eli Zaretskii Date: Sat Nov 4 05:21:39 2023 -0400 ; Merge from origin/emacs-29 The following commit was skipped: 33fae4b02d6 Suggest alternative reason for ERT test duplication error commit 050086931afa090947d2c0730a8a6eb0f33a7dd9 Merge: a201b334bec 196def4fa64 Author: Eli Zaretskii Date: Sat Nov 4 05:21:39 2023 -0400 Merge from origin/emacs-29 196def4fa64 Fix description of 'Package-Requires' library header c1778432790 ; * doc/misc/tramp.texi (FUSE setup): Fix typo. a64336cbb9c * lisp/emacs-lisp/cl-lib.el (cl--defalias): Improve&fix d... da8b85b577d Add two docstrings in cl-lib.el commit a201b334bec8a10b405fe9915525fb0a04393831 Merge: 5de5b7b418d 41939127457 Author: Eli Zaretskii Date: Sat Nov 4 05:21:38 2023 -0400 ; Merge from origin/emacs-29 The following commits were skipped: 41939127457 Fix Tramp (don't merge) c22eeba8277 ; Fix typo 4f57af7fccd * doc/misc/tramp.texi (Traces and Profiles): Fix indentat... ccaf801baad * doc/misc/tramp.texi (Traces and Profiles): Fix indentat... commit 5de5b7b418d1c1ae9c96709ea6f41a21ddc56c72 Merge: d8fcb9b711c d5e5ea4e36b Author: Eli Zaretskii Date: Sat Nov 4 05:21:38 2023 -0400 Merge from origin/emacs-29 d5e5ea4e36b Fix guessing commands for zstandard archives in Dired 90db29aff86 Fix eglot.texi (JSONRPC objects in Elisp) example 5ef48ad6a37 ; Fix one author's name. c4e9a6159a3 * doc/man/emacsclient.1: Fix --tramp option. 6dca3a8eab2 Improve `nsm-protocol-check--3des-cipher` docstring commit d8fcb9b711c410d31463e4e96a535bbf087289ad Merge: c0601fb534b 04215e616f5 Author: Eli Zaretskii Date: Sat Nov 4 05:21:38 2023 -0400 ; Merge from origin/emacs-29 The following commits were skipped: 04215e616f5 Recognize backslash in `dns-mode` quoted values 6629e861b35 Make `dns-mode` fontify quoted values correctly commit 33fae4b02d6ed86487ddd0e75f2b3f5e87f6e137 Author: Mattias Engdegård Date: Fri Nov 3 18:06:04 2023 +0100 Suggest alternative reason for ERT test duplication error * lisp/emacs-lisp/ert.el (ert-set-test): Amend error message; maybe the redefinition was caused by a file loaded twice. (Bug#66782) Suggested by Xiyue Deng. (cherry picked from commit 425d23fbeaede81ab4f50b4073949cc1c8a3fbd0) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index be9f013ebcf..5d001307125 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -151,7 +151,7 @@ ert-set-test (when (and noninteractive (get symbol 'ert--test)) ;; Make sure duplicated tests are discovered since the older test would ;; be ignored silently otherwise. - (error "Test `%s' redefined" symbol)) + (error "Test `%s' redefined (or loaded twice)" symbol)) (define-symbol-prop symbol 'ert--test definition) definition) commit c0601fb534b200fcaf2bc2a1dd0b7dc1090bbbe6 Author: Manuel Giraud Date: Wed Nov 1 13:59:37 2023 +0100 Don't need text properties when sending a mail * lisp/mail/smtpmail.el (smtpmail-send-data): Don't get text properties when sending mail data. (Bug#66880) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 78688d170cc..e30c69f2441 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -1057,8 +1057,8 @@ smtpmail-send-data (while data-continue (with-current-buffer buffer (progress-reporter-update pr (point)) - (setq sending-data (buffer-substring (line-beginning-position) - (line-end-position))) + (setq sending-data (buffer-substring-no-properties (line-beginning-position) + (line-end-position))) (end-of-line 2) (setq data-continue (not (eobp)))) (smtpmail-send-data-1 process sending-data)) commit ce4a62eece608f13db2449e5d4e2d38f253663c4 Author: Manuel Giraud Date: Tue Oct 24 14:51:04 2023 +0200 Fix desktop-save on remote dired (bug#66697) Do not gather "misc data" for dired buffer not meant to be desktop saved. lisp/dired.el (dired-desktop-save-p): New function to test if `dired-directory' should be desktop saved. (dired-desktop-buffer-misc-data): Use it. diff --git a/lisp/dired.el b/lisp/dired.el index 99156b28365..c710e06722f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4877,22 +4877,30 @@ dired-dnd-handle-file (eval-when-compile (require 'desktop)) (declare-function desktop-file-name "desktop" (filename dirname)) +(defun dired-desktop-save-p () + "Should `dired-directory' be desktop saved?" + (if (consp dired-directory) + (not (string-match-p desktop-files-not-to-save (car dired-directory))) + (not (string-match-p desktop-files-not-to-save dired-directory)))) + (defun dired-desktop-buffer-misc-data (dirname) "Auxiliary information to be saved in desktop file." - (cons - ;; Value of `dired-directory'. - (if (consp dired-directory) - ;; Directory name followed by list of files. - (cons (desktop-file-name (car dired-directory) dirname) - (cdr dired-directory)) - ;; Directory name, optionally with shell wildcard. - (desktop-file-name dired-directory dirname)) - ;; Subdirectories in `dired-subdir-alist'. - (cdr - (nreverse - (mapcar - (lambda (f) (desktop-file-name (car f) dirname)) - dired-subdir-alist))))) + (when (and (stringp desktop-files-not-to-save) + (dired-desktop-save-p)) + (cons + ;; Value of `dired-directory'. + (if (consp dired-directory) + ;; Directory name followed by list of files. + (cons (desktop-file-name (car dired-directory) dirname) + (cdr dired-directory)) + ;; Directory name, optionally with shell wildcard. + (desktop-file-name dired-directory dirname)) + ;; Subdirectories in `dired-subdir-alist'. + (cdr + (nreverse + (mapcar + (lambda (f) (desktop-file-name (car f) dirname)) + dired-subdir-alist)))))) (defun dired-restore-desktop-buffer (_file-name _buffer-name commit 196def4fa6411a32e26aa8e589a588f9cd0fbc95 Author: Eli Zaretskii Date: Sat Nov 4 09:59:45 2023 +0200 Fix description of 'Package-Requires' library header * doc/lispref/tips.texi (Library Headers): Update the description of the 'Package-Requires' header. (Bug#66677) diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index f594d684338..f760b2554f0 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -1169,6 +1169,21 @@ Library Headers ;; Package-Requires: ((gnus "1.0") (bubbles "2.7.2") cl-lib (seq)) @end smallexample +Packages that don't need to support Emacs versions older than Emacs 27 +can have the @samp{Package-Requires} header split across multiple +lines, like this: + +@smallexample +@group +;; Package-Requires: ((emacs "27.1") +;; (compat "29.1.4.1")) +@end group +@end smallexample + +@noindent +Note that with this format, you still need to start the list on the +same line as @samp{Package-Requires}. + The package code automatically defines a package named @samp{emacs} with the version number of the currently running Emacs. This can be used to require a minimal version of Emacs for a package. commit 5ee66620fd2af8c5f356e6e720777e16d6c2c050 Author: Eli Zaretskii Date: Sat Nov 4 09:33:33 2023 +0200 Remove unnecessary assertion added 2 days ago * src/xdisp.c (get_glyph_face_and_encoding): Remove unnecessary assertion. It triggers, for no good reason, when running the recipe of bug#66922 and typing C-p in the *Warnings* buffer after the recipe finishes, because the glyph passed to this function is a STRETCH_GLYPH, not a CHAR_GLYPH. diff --git a/src/xdisp.c b/src/xdisp.c index 9e8b4b130b9..041c7adfc50 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29649,7 +29649,6 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, struct face *face; unsigned code = 0; - eassert (glyph->type == CHAR_GLYPH); face = FACE_FROM_ID (f, glyph->face_id); /* Make sure X resources of the face are allocated. */ commit 08fed99ae862255f06ef2254b7cef3a5fab178b6 Author: Stephen Gildea Date: Fri Nov 3 15:24:21 2023 -0700 MH-E testing: find locally-installed GNU Mailutils libraries * test/lisp/mh-e/test-all-mh-variants.sh: LD_LIBRARY_PATH is sometimes necessary. This reverts part of commit f1fcd321ff of 24 Nov 2021. diff --git a/test/lisp/mh-e/test-all-mh-variants.sh b/test/lisp/mh-e/test-all-mh-variants.sh index 5e6b26fd2ec..602d831e28c 100755 --- a/test/lisp/mh-e/test-all-mh-variants.sh +++ b/test/lisp/mh-e/test-all-mh-variants.sh @@ -81,8 +81,10 @@ have_done_mocked_variant= fi echo "** Testing with PATH $path" ((++tests_total)) + # The LD_LIBRARY_PATH setting is needed + # to run locally installed Mailutils. TEST_MH_PATH=$path TEST_MH_DEBUG=$debug \ - HOME=/nonexistent \ + LD_LIBRARY_PATH=/usr/local/lib HOME=/nonexistent \ "${emacs[@]}" -l ert \ --eval "(setq load-prefer-newer t)" \ --eval "(load \"$PWD/test/lisp/mh-e/mh-utils-tests\" nil t)" \ commit 6218278a67b5ce87eb5e8b2c76daeb7475983d35 Author: Andrea Corallo Date: Fri Nov 3 18:34:05 2023 +0100 * lisp/emacs-lisp/comp-cstr.el (comp--direct-supertype): Remove unused. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 70213c9b13c..e47e93cda18 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -269,16 +269,6 @@ comp--sym-lessp (string-lessp (symbol-name x) (symbol-name y))) -(defun comp--direct-supertype (type) ;FIXME: There can be several! - "Return the direct supertype of TYPE." - (declare (obsolete comp--direct-supertype "30.1")) - (cl-loop - named outer - for i in (comp-cstr-ctxt-typeof-types comp-ctxt) - do (cl-loop for (j y) on i - when (eq j type) - do (cl-return-from outer y)))) - (defun comp--direct-supertypes (type) "Return the direct supertypes of TYPE." (let ((supers (comp-supertypes type))) commit 425d23fbeaede81ab4f50b4073949cc1c8a3fbd0 Author: Mattias Engdegård Date: Fri Nov 3 18:06:04 2023 +0100 Suggest alternative reason for ERT test duplication error * lisp/emacs-lisp/ert.el (ert-set-test): Amend error message; maybe the redefinition was caused by a file loaded twice (bug#66782). Suggested by Xiyue Deng. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d727bc94ec5..61d8341bdad 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -152,7 +152,7 @@ ert-set-test (when (and noninteractive (get symbol 'ert--test)) ;; Make sure duplicated tests are discovered since the older test would ;; be ignored silently otherwise. - (error "Test `%s' redefined" symbol)) + (error "Test `%s' redefined (or loaded twice)" symbol)) (define-symbol-prop symbol 'ert--test definition) definition) commit 12d1f33ceb37a2d0399af7e4054024c60a465ab8 Author: Eli Zaretskii Date: Fri Nov 3 09:41:11 2023 +0200 ; Fix recent changes in documentation * lisp/man.el (Man-header-file-path, man): Doc fix. * etc/NEWS: Fix wording. diff --git a/etc/NEWS b/etc/NEWS index 1390cb1cf6f..e29a787a0cc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -693,10 +693,10 @@ asynchronously (which is the default behavior). +++ *** New user option 'Man-support-remote-systems'. -This option controls whether the man page is taken from the remote -system when the current buffer is remote. You can invoke the 'man' -command with a prefix argument to reverse the value of this option -only for the current invocation. +This option controls whether the man page is formatted on the remote +system when the current buffer's default-directory is remote. You can +invoke the 'man' command with a prefix argument to countermand the +value of this option for the current invocation of 'man'. ** DocView diff --git a/lisp/man.el b/lisp/man.el index 28c71ba1e06..f18e2f50b7c 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -583,10 +583,11 @@ Man-shell-file-name "/bin/sh")) (defun Man-header-file-path () - "Return the C header file search path that Man uses. + "Return the C header file search path that Man should use. Normally, this is the value of the user option `Man-header-file-path', -but when the man page is retrieved from a remote system this -function tries to find the C header path on that system." +but when the man page is formatted on a remote system (see +`Man-support-remote-systems'), this function tries to figure out the +list of directories where the remote system has the C header files." (let ((remote-id (file-remote-p default-directory))) (if (null remote-id) ;; The local case. @@ -1091,7 +1092,7 @@ man If `default-directory' is remote, and `Man-support-remote-systems' is non-nil, this command formats the man page on the remote system. A prefix argument reverses the value of `Man-support-remote-systems' -for the current call." +for the current invocation." (interactive (list (let* ((default-entry (Man-default-man-entry)) commit 9867be2f6c2f9a94aa4778d72b598717a0925d73 Author: Po Lu Date: Fri Nov 3 15:20:04 2023 +0800 Round underline position and thickness * src/sfntfont.c (sfntfont_open): Round underline thickness instead of truncating it, as is proper according to several inquiries. diff --git a/src/sfntfont.c b/src/sfntfont.c index 80fbde9772c..39b250ac11e 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -3287,10 +3287,10 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, { font_info->font.underline_position = sfnt_coerce_fixed (-desc->underline_position - * font_info->scale); + * font_info->scale) + 0.5; font_info->font.underline_thickness = sfnt_coerce_fixed (desc->underline_thickness - * font_info->scale); + * font_info->scale) + 0.5; } /* Now try to set up grid fitting for this font. */ commit e06e61f45615f66d5e32fa23ea7ede7c4da77fda Author: Po Lu Date: Fri Nov 3 11:32:17 2023 +0800 Avoid moving point while analyzing text conversion * lisp/simple.el (analyze-text-conversion): If neither calling p-s-i-h nor calling p-t-c-h yields a change to point, return it to its location before analyze-text-conversion was called. * src/keyboard.c (kbd_buffer_get_event): See that text conversion events are uniformly delivered prior to keyboard events arriving in unison. diff --git a/lisp/simple.el b/lisp/simple.el index 30208debc2a..96cdedb4f38 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -11169,7 +11169,12 @@ analyze-text-conversion `undo-auto-current-boundary-timer' will run within the next 5 seconds." (interactive) - (let ((any-nonephemeral nil)) + ;; One important consideration to bear in mind when adjusting this + ;; code is to _never_ move point in reaction to an edit so long as + ;; the additional processing undertaken by this function does not + ;; also edit the buffer text. + (let ((any-nonephemeral nil) + point-moved) ;; The list must be processed in reverse. (dolist (edit (reverse text-conversion-edits)) ;; Filter out ephemeral edits and deletions after point. Here, we @@ -11177,6 +11182,9 @@ analyze-text-conversion ;; can be identified. (when (stringp (nth 3 edit)) (with-current-buffer (car edit) + ;; Record that the point hasn't been moved by the execution + ;; of a post command or text conversion hook. + (setq point-moved nil) (if (not (eq (nth 1 edit) (nth 2 edit))) ;; Process this insertion. (nth 3 edit) is the text which ;; was inserted. @@ -11192,7 +11200,8 @@ analyze-text-conversion ;; Save the current undo list to figure out ;; whether or not auto-fill has actually taken ;; place. - (old-undo-list buffer-undo-list)) + (old-undo-list buffer-undo-list) + (old-point (point))) (save-excursion (if (and auto-fill-function newline-p) (progn (goto-char (nth 2 edit)) @@ -11211,10 +11220,22 @@ analyze-text-conversion (not (eq old-undo-list buffer-undo-list))))) (goto-char (nth 2 edit)) - (let ((last-command-event end)) + (let ((last-command-event end) + (point (point))) (unless (run-hook-with-args-until-success 'post-text-conversion-hook) - (run-hooks 'post-self-insert-hook)))) + (run-hooks 'post-self-insert-hook)) + (when (not (eq (point) point)) + (setq point-moved t))) + ;; If post-self-insert-hook doesn't move the point, + ;; restore it to its previous location. Generally, + ;; the call to goto-char upon processing the last edit + ;; recorded text-conversion-edit will see to this, but + ;; if the input method sets point expressly, no edit + ;; will be recorded, and point will wind up away from + ;; where the input method believes it is. + (unless point-moved + (goto-char old-point))) ;; Process this deletion before point. (nth 2 edit) is the ;; text which was deleted. Input methods typically prefer ;; to edit words instead of deleting characters off their diff --git a/src/keyboard.c b/src/keyboard.c index 003340c3e58..13cb7835dff 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3993,6 +3993,19 @@ kbd_buffer_get_event (KBOARD **kbp, if (CONSP (Vunread_command_events)) break; +#ifdef HAVE_TEXT_CONVERSION + /* That text conversion events take priority over keyboard + events, since input methods frequently send them immediately + after edits, with the assumption that this order of events + will be observed. */ + + if (detect_conversion_events ()) + { + had_pending_conversion_events = true; + break; + } +#endif /* HAVE_TEXT_CONVERSION */ + if (kbd_fetch_ptr != kbd_store_ptr) break; if (some_mouse_moved ()) @@ -4020,13 +4033,6 @@ kbd_buffer_get_event (KBOARD **kbp, had_pending_selection_requests = true; break; } -#endif -#ifdef HAVE_TEXT_CONVERSION - if (detect_conversion_events ()) - { - had_pending_conversion_events = true; - break; - } #endif if (end_time) { commit fc8d225328d41c180b6997f6c25f904ca66211ac Author: Stefan Monnier Date: Thu Nov 2 23:12:00 2023 -0400 * lisp/emacs-lisp/oclosure.el (oclosure--lambda): Burp in dynbind mode The "fixes" bug#66867. diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index ae0038b45e6..c23dd5a36da 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -350,6 +350,7 @@ oclosure--lambda should be mutable. No checking is performed." (declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body))) + (cl-assert lexical-binding) ;Can't work in dynbind dialect. ;; FIXME: Fundamentally `oclosure-lambda' should be a special form. ;; We define it here as a macro which expands to something that ;; looks like "normal code" in order to avoid backward compatibility commit 9cbf0bb3ee8871942f781c539acdeae1b7071224 Author: Dmitry Gutov Date: Fri Nov 3 01:40:36 2023 +0200 Remove 'M-.' binding from js-mode and js-ts-mode * lisp/progmodes/js.el (js-mode-map, js-ts-mode-map): Remove. The global binding must be a lot more useful for most users (https://lists.gnu.org/archive/html/emacs-devel/2020-05/msg01295.html). diff --git a/etc/NEWS b/etc/NEWS index 54360e43322..1390cb1cf6f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1056,6 +1056,13 @@ additionally traverse the parent directories until a VCS root is found (if any), so that the ignore rules for that repository are used, and the file listing's performance is still optimized. +** 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 +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. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 6fd714940b6..5a669fdbd42 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -672,15 +672,6 @@ js-jsx-attribute-offset :type 'integer :safe 'integerp) -;;; Keymap - -(defvar-keymap js-mode-map - :doc "Keymap for `js-mode'." - "M-." #'js-find-symbol) - -(defvar js-ts-mode-map (copy-keymap js-mode-map) - "Keymap used in `js-ts-mode'.") - ;;; Syntax table and parsing (defvar js-mode-syntax-table commit f5b2d23fff6e77ab71e028c84e73b3a792c430bd Author: Michael Albinus Date: Thu Nov 2 12:14:13 2023 +0100 Adapt doc for man.el * etc/NEWS: Rephrase 'Man-support-remote-systems' entry. Fix typos. * lisp/man.el (Man-header-file-path, man): Adapt docstrings. diff --git a/etc/NEWS b/etc/NEWS index 00df004fd70..54360e43322 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -688,16 +688,15 @@ bound to 'C-c C-d' in 'go-ts-mode'. +++ *** New user option 'Man-prefer-synchronous-call'. -When this is non-nil, call the 'man' program synchronously rather than +When this is non-nil, run the 'man' command synchronously rather than asynchronously (which is the default behavior). +++ *** New user option 'Man-support-remote-systems'. -If the user option 'Man-support-remote-systems' is non-nil, and -'default-directory' indicates a remote system, the man page is taken -from the remote system. Calling the 'man' command with a prefix like -'C-u M-x man' reverts the value of 'Man-support-remote-systems' for -that call. +This option controls whether the man page is taken from the remote +system when the current buffer is remote. You can invoke the 'man' +command with a prefix argument to reverse the value of this option +only for the current invocation. ** DocView @@ -1011,7 +1010,7 @@ A major mode based on the tree-sitter library for editing Lua files. *** New commands 'previous-line-completion' and 'next-line-completion'. Bound to '' and '' arrow keys, respectively, they navigate -the *Completions* buffer vertically by lines, wrapping at the +the "*Completions*" buffer vertically by lines, wrapping at the top/bottom when 'completion-auto-wrap' is non-nil. +++ diff --git a/lisp/man.el b/lisp/man.el index d64a355e3d8..28c71ba1e06 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -583,9 +583,10 @@ Man-shell-file-name "/bin/sh")) (defun Man-header-file-path () - "C Header file search path used in Man. -In the local case, it is the value of `Man-header-file-path'. -Otherwise, it will be checked on the remote system." + "Return the C header file search path that Man uses. +Normally, this is the value of the user option `Man-header-file-path', +but when the man page is retrieved from a remote system this +function tries to find the C header path on that system." (let ((remote-id (file-remote-p default-directory))) (if (null remote-id) ;; The local case. @@ -1088,11 +1089,9 @@ man to auto-complete your input based on the installed manual pages. If `default-directory' is remote, and `Man-support-remote-systems' -is non-nil, the man page will be formatted on the corresponding -remote system. - -If `man' is called interactively with a prefix argument, the -value of `Man-support-remote-systems' is reverted." +is non-nil, this command formats the man page on the remote system. +A prefix argument reverses the value of `Man-support-remote-systems' +for the current call." (interactive (list (let* ((default-entry (Man-default-man-entry)) commit cb92eb404d73feca21666d2de1dd54b41fe34c53 Author: Eli Zaretskii Date: Thu Nov 2 09:56:55 2023 +0200 ; Improve documentation of recent changes * etc/NEWS: * lisp/simple.el (completion-auto-wrap, completion-auto-select) (first-completion, last-completion, previous-completion) (next-completion, previous-line-completion) (next-line-completion): Doc fixes. (Bug#59486) diff --git a/etc/NEWS b/etc/NEWS index c865c6b8891..00df004fd70 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1010,9 +1010,9 @@ A major mode based on the tree-sitter library for editing Lua files. ** Minibuffer and Completions *** New commands 'previous-line-completion' and 'next-line-completion'. -Bound to '' and '' respectively, they navigate the *Completions* -buffer vertically, wrapping at the top/bottom when 'completion-auto-wrap' -is non-nil. +Bound to '' and '' arrow keys, respectively, they navigate +the *Completions* buffer vertically by lines, wrapping at the +top/bottom when 'completion-auto-wrap' is non-nil. +++ *** New global minor mode 'minibuffer-regexp-mode'. diff --git a/lisp/simple.el b/lisp/simple.el index fd8f08bcb3d..30208debc2a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9883,7 +9883,7 @@ delete-completion-window (select-window (get-buffer-window buf)))))) (defcustom completion-auto-wrap t - "Non-nil means to wrap around when selecting completion options. + "Non-nil means to wrap around when selecting completion candidates. This affects the commands `next-completion', `previous-completion', `next-line-completion' and `previous-line-completion'. When `completion-auto-select' is t, it wraps through the minibuffer @@ -9893,12 +9893,12 @@ completion-auto-wrap :group 'completion) (defcustom completion-auto-select nil - "Non-nil means to automatically select the *Completions* buffer. + "If non-nil, automatically select the window showing the *Completions* buffer. When the value is t, pressing TAB will switch to the completion list buffer when Emacs pops up a window showing that buffer. If the value is `second-tab', then the first TAB will pop up the window showing the completions list buffer, and the next TAB will -switch to that window. +select that window. See `completion-auto-help' for controlling when the window showing the completions is popped up and down." :type '(choice (const :tag "Don't auto-select completions window" nil) @@ -9909,7 +9909,7 @@ completion-auto-select :group 'completion) (defun first-completion () - "Move to the first item in the completion list." + "Move to the first item in the completions buffer." (interactive) (goto-char (point-min)) (if (get-text-property (point) 'mouse-face) @@ -9921,7 +9921,7 @@ first-completion (goto-char pos)))) (defun last-completion () - "Move to the last item in the completion list." + "Move to the last item in the completions buffer." (interactive) (goto-char (previous-single-property-change (point-max) 'mouse-face nil (point-min))) @@ -9931,7 +9931,7 @@ last-completion (goto-char pos)))) (defun previous-completion (n) - "Move to the previous item in the completion list. + "Move to the previous item in the completions buffer. With prefix argument N, move back N items (negative N means move forward). @@ -9940,7 +9940,7 @@ previous-completion (next-completion (- n))) (defun next-completion (n) - "Move to the next item in the completion list. + "Move to the next item in the completions buffer. With prefix argument N, move N items (negative N means move backward). @@ -10004,18 +10004,16 @@ next-completion (switch-to-minibuffer)))) (defun previous-line-completion (&optional n) - "Move to the item on the previous line in the completion list. -With prefix argument N, move back N items line-wise (negative N -means move forward). + "Move to completion candidate on the previous line in the completions buffer. +With prefix argument N, move back N lines (negative N means move forward). Also see the `completion-auto-wrap' variable." (interactive "p") (next-line-completion (- n))) (defun next-line-completion (&optional n) - "Move to the item on the next line in the completion list. -With prefix argument N, move N items line-wise (negative N -means move backward). + "Move to completion candidate on the next line in the completions buffer. +With prefix argument N, move N lines forward (negative N means move backward). Also see the `completion-auto-wrap' variable." (interactive "p") commit dbcb4cedd0a78b7ea8447c84c3da104edc2d4b14 Author: Po Lu Date: Thu Nov 2 13:18:37 2023 +0800 Properly compute overhangs for overstruck text * src/xdisp.c (get_glyph_face_and_encoding): Account for non-character glyphs by not attempting to translate them to characters. (gui_get_glyph_overhangs, gui_produce_glyphs): If the face is overstruck, increase the right side bearing by 1 pixel. diff --git a/src/xdisp.c b/src/xdisp.c index 20c7634fc3e..9e8b4b130b9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29638,9 +29638,9 @@ get_char_face_and_encoding (struct frame *f, int c, int face_id, } -/* Get face and two-byte form of character glyph GLYPH on frame F. - The encoding of GLYPH->u.ch is returned in *CHAR2B. Value is - a pointer to a realized face that is ready for display. */ +/* Get face glyph GLYPH on frame F, and if a character glyph, its + multi-byte character form in *CHAR2B. Value is a pointer to a + realized face that is ready for display. */ static struct face * get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, @@ -29655,19 +29655,23 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, /* Make sure X resources of the face are allocated. */ prepare_face_for_display (f, face); - if (face->font) + if (glyph->type == CHAR_GLYPH) { - if (CHAR_BYTE8_P (glyph->u.ch)) - code = CHAR_TO_BYTE8 (glyph->u.ch); - else - code = face->font->driver->encode_char (face->font, glyph->u.ch); + if (face->font) + { + if (CHAR_BYTE8_P (glyph->u.ch)) + code = CHAR_TO_BYTE8 (glyph->u.ch); + else + code = face->font->driver->encode_char (face->font, glyph->u.ch); - if (code == FONT_INVALID_CODE) - code = 0; + if (code == FONT_INVALID_CODE) + code = 0; + } + + /* Ensure that the code is only 2 bytes wide. */ + *char2b = code & 0xFFFF; } - /* Ensure that the code is only 2 bytes wide. */ - *char2b = code & 0xFFFF; return face; } @@ -30167,17 +30171,28 @@ normal_char_height (struct font *font, int c) void gui_get_glyph_overhangs (struct glyph *glyph, struct frame *f, int *left, int *right) { + unsigned char2b; + struct face *face; + *left = *right = 0; + face = get_glyph_face_and_encoding (f, glyph, &char2b); if (glyph->type == CHAR_GLYPH) { - unsigned char2b; - struct face *face = get_glyph_face_and_encoding (f, glyph, &char2b); if (face->font) { - struct font_metrics *pcm = get_per_char_metric (face->font, &char2b); + struct font_metrics *pcm + = get_per_char_metric (face->font, &char2b); + if (pcm) { + /* Overstruck text is displayed twice, the second time + one pixel to the right. Increase the right-side + bearing to match. */ + + if (face->overstrike) + pcm->rbearing++; + if (pcm->rbearing > pcm->width) *right = pcm->rbearing - pcm->width; if (pcm->lbearing < 0) @@ -30190,8 +30205,18 @@ gui_get_glyph_overhangs (struct glyph *glyph, struct frame *f, int *left, int *r if (! glyph->u.cmp.automatic) { struct composition *cmp = composition_table[glyph->u.cmp.id]; + int rbearing; + + rbearing = cmp->rbearing; - if (cmp->rbearing > cmp->pixel_width) + /* Overstruck text is displayed twice, the second time one + pixel to the right. Increase the right-side bearing to + match. */ + + if (face->overstrike) + rbearing++; + + if (rbearing > cmp->pixel_width) *right = cmp->rbearing - cmp->pixel_width; if (cmp->lbearing < 0) *left = - cmp->lbearing; @@ -30203,6 +30228,14 @@ gui_get_glyph_overhangs (struct glyph *glyph, struct frame *f, int *left, int *r composition_gstring_width (gstring, glyph->slice.cmp.from, glyph->slice.cmp.to + 1, &metrics); + + /* Overstruck text is displayed twice, the second time one + pixel to the right. Increase the right-side bearing to + match. */ + + if (face->overstrike) + metrics.rbearing++; + if (metrics.rbearing > metrics.width) *right = metrics.rbearing - metrics.width; if (metrics.lbearing < 0) @@ -32311,6 +32344,14 @@ gui_produce_glyphs (struct it *it) if (get_char_glyph_code (it->char_to_display, font, &char2b)) { pcm = get_per_char_metric (font, &char2b); + + /* Overstruck text is displayed twice, the second time + one pixel to the right. Increase the right-side + bearing to match. */ + + if (pcm && face->overstrike) + pcm->rbearing++; + if (pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0) pcm = NULL; @@ -32703,6 +32744,13 @@ gui_produce_glyphs (struct it *it) /* Initialize the bounding box. */ if (pcm) { + /* Overstruck text is displayed twice, the second time + one pixel to the right. Increase the right-side + bearing to match. */ + + if (face->overstrike) + pcm->rbearing++; + width = cmp->glyph_len > 0 ? pcm->width : 0; ascent = pcm->ascent; descent = pcm->descent; @@ -32764,6 +32812,13 @@ gui_produce_glyphs (struct it *it) cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0; else { + /* Overstruck text is displayed twice, the second + time one pixel to the right. Increase the + right-side bearing to match. */ + + if (face->overstrike) + pcm->rbearing++; + width = pcm->width; ascent = pcm->ascent; descent = pcm->descent; commit 078cfe807295038fa321c9297e24de5145065622 Author: F. Jason Park Date: Tue Oct 31 16:50:16 2023 -0700 Preserve point when inserting date stamps in ERC * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-disable): Move remaining local teardown business to `erc-stamp--setup' and use `erc-buffer-do' instead of `erc-with-all-buffers-of-server' to emphasize that all ERC buffers are affected. (erc-stamp--insert-date-stamp-as-phony-message): Move `erc--msg-props' binding to `erc-stamp--lr-date-on-pre-modify'. (erc-stamp--lr-date-on-pre-modify): Bind `erc--msg-props' here so that the related guard condition in `erc-add-timestamp' is satisfied and `erc-insert-timestamp-function' runs. This fixes a regression new in ERC 5.6 and introduced by c68dc778 "Manage some text props for ERC insertion-hook members". Also, `save-excursion' when narrowing to prevent point from being dislodged after submitting input at the prompt. (erc-insert-timestamp-left-and-right): Don't initialize date stamps when `erc-timestamp-format-left' is nil or consists only of newlines, and enable fallback behavior in such cases on behalf of users without informing them. Allow global hook members to run first so that those owned by `scrolltobottom' and similar can see the unadulterated input. Fix wrong hook name. (erc-stamp--setup): Fix wrong hook name. Kill all local vars here instead of sharing this duty with the minor-mode toggle. (Bug#60936) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index b3812470a4d..412740ac192 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -187,12 +187,7 @@ stamp (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear) - (erc-with-all-buffers-of-server nil nil - (erc-stamp--setup) - (kill-local-variable 'erc-stamp--last-stamp) - (kill-local-variable 'erc-timestamp-last-inserted) - (kill-local-variable 'erc-timestamp-last-inserted-left) - (kill-local-variable 'erc-timestamp-last-inserted-right)))) + (erc-buffer-do #'erc-stamp--setup))) (defvar erc-stamp--invisible-property nil "Existing `invisible' property value and/or symbol `timestamp'.") @@ -664,11 +659,7 @@ erc-stamp--format-date-stamp (defun erc-stamp--insert-date-stamp-as-phony-message (string) (cl-assert (string-empty-p string)) (setq string erc-stamp--current-datestamp-left) - (cl-assert string) (let ((erc-stamp--skip t) - (erc--msg-props (map-into `((erc-msg . datestamp) - (erc-ts . ,(erc-stamp--current-time))) - 'hash-table)) (erc-insert-modify-hook `(,@erc-insert-modify-hook erc-stamp--propertize-left-date-stamp)) ;; Don't run hooks that aren't expecting a narrowed buffer. @@ -684,11 +675,17 @@ erc-stamp--lr-date-on-pre-modify (erc-stamp--current-datestamp-left rendered) (erc-insert-timestamp-function #'erc-stamp--insert-date-stamp-as-phony-message)) - (save-restriction - (narrow-to-region (or erc--insert-marker erc-insert-marker) - (or erc--insert-marker erc-insert-marker)) - (let (erc-timestamp-format erc-away-timestamp-format) - (erc-add-timestamp))))) + (save-excursion + (save-restriction + (narrow-to-region (or erc--insert-marker erc-insert-marker) + (or erc--insert-marker erc-insert-marker)) + ;; Forget current `erc-cmd', etc. + (let ((erc--msg-props + (map-into `((erc-msg . datestamp) + (erc-ts . ,(erc-stamp--current-time))) + 'hash-table)) + erc-timestamp-format erc-away-timestamp-format) + (erc-add-timestamp)))))) (defvar erc-stamp-prepend-date-stamps-p nil "When non-nil, date stamps are not independent messages. @@ -714,9 +711,13 @@ erc-insert-timestamp-left-and-right Additionally, ensure every date stamp is identifiable as such so that internal modules can easily distinguish between other left-sided stamps and date stamps inserted by this function." - (unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p) - (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t) - (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t) + (unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p + (and (or (null erc-timestamp-format-left) + (string-empty-p ; compat + (string-trim erc-timestamp-format-left "\n"))) + (setq erc-stamp-prepend-date-stamps-p t))) + (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify 10 t) + (add-hook 'erc-pre-send-functions #'erc-stamp--lr-date-on-pre-modify 10 t) (let ((erc--insert-marker (point-min-marker)) (end-marker (point-max-marker))) (set-marker-insertion-type erc--insert-marker t) @@ -817,7 +818,11 @@ erc-stamp--setup (erc-munge-invisibility-spec)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (remove-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify t) - (remove-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify t) + (remove-hook 'erc-pre-send-functions #'erc-stamp--lr-date-on-pre-modify t) + (kill-local-variable 'erc-stamp--last-stamp) + (kill-local-variable 'erc-timestamp-last-inserted) + (kill-local-variable 'erc-timestamp-last-inserted-left) + (kill-local-variable 'erc-timestamp-last-inserted-right) (kill-local-variable 'erc-stamp--date-format-end))) (defun erc-hide-timestamps () commit 11e42b405ca222a037b7b3d215ef5d14a97ab929 Author: F. Jason Park Date: Mon Oct 30 23:36:54 2023 -0700 ; Attempt to fix race in erc-buffer-display test * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--time-vals, erc-fill-tests--current-time-value): Rename former to latter and change type from function to natnum. (erc-fill-tests--wrap-populate, erc-fill-wrap--merge, erc-fill-wrap--merge-action): Use `erc-fill-tests--current-time-value' instead of function `erc-fill-tests--time-vals'. * test/lisp/erc/erc-scenarios-base-association.el (erc-scenarios-common--base-association-multi-net): Extend timeout. * test/lisp/erc/erc-scenarios-base-buffer-display.el (erc-scenarios-base-buffer-display--reconnect-common): Move some common assertions here from callers. (erc-scenarios-base-buffer-display--defwin-recbury-intbuf, erc-scenarios-base-buffer-display--count-reset-timeout): Factor out a couple common assertions. Clarify some comments. (erc-scenarios-base-buffer-display--defwino-recbury-intbuf): Factor out a couple common assertions and clarify some comments. Account for possible concurrency bug leading to intermittent test failures. * test/lisp/erc/erc-scenarios-base-misc-regressions.el (erc-scenarios-base-gapless-connect, erc-scenarios-base-channel-buffer-revival): Extend timeouts. * test/lisp/erc/resources/dcc/chat/accept.eld: Extend timeout. * test/lisp/erc/resources/base/reconnect/options-again.eld: Extend timeouts. * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--m): Prevent possible wrong-type error. * test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld: Extend timeouts. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--base-network-id-bouncer): Extend timeout. diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 92424d1e556..8179cbda2cb 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -27,7 +27,7 @@ (require 'erc-fill) (defvar erc-fill-tests--buffers nil) -(defvar erc-fill-tests--time-vals (lambda () 0)) +(defvar erc-fill-tests--current-time-value 0) (defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) @@ -49,7 +49,7 @@ erc-fill-tests--wrap-populate extended-command-history erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (cl-letf (((symbol-function 'erc-stamp--current-time) - (lambda () (funcall erc-fill-tests--time-vals))) + (lambda () erc-fill-tests--current-time-value)) ((symbol-function 'erc-server-connect) (lambda (&rest _) (setq erc-server-process @@ -261,7 +261,7 @@ erc-fill-wrap--merge ;; Set this here so that the first few messages are from 1970. ;; Following the current date stamp, the speaker isn't merged ;; even though it's continued: " zero." - (let ((erc-fill-tests--time-vals (lambda () 1680332400))) + (let ((erc-fill-tests--current-time-value 1680332400)) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "alice" "one.") (erc-fill-tests--insert-privmsg "alice" "two.") @@ -297,8 +297,8 @@ erc-fill-wrap--merge-action (erc-fill-tests--wrap-populate (lambda () - ;; Set this here so that the first few messages are from 1970 - (let ((erc-fill-tests--time-vals (lambda () 1680332400))) + ;; Allow prior messages to be from 1970. + (let ((erc-fill-tests--current-time-value 1680332400)) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "bob" "0.5") diff --git a/test/lisp/erc/erc-scenarios-base-association.el b/test/lisp/erc/erc-scenarios-base-association.el index a40a4cb7550..10abe14c43b 100644 --- a/test/lisp/erc/erc-scenarios-base-association.el +++ b/test/lisp/erc/erc-scenarios-base-association.el @@ -78,7 +78,7 @@ erc-scenarios-common--base-association-multi-net (with-current-buffer "#chan@foonet" (funcall expect 3 "bob") (funcall expect 3 "was created on") - (funcall expect 3 "prosperous"))) + (funcall expect 10 "prosperous"))) (ert-info ("All #chan@barnet output consumed") (with-current-buffer "#chan@barnet" diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index df292a8c113..6a80baeaaa9 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -27,7 +27,10 @@ (eval-when-compile (require 'erc-join)) ;; These first couple `erc-auto-reconnect-display' tests used to live -;; in erc-scenarios-base-reconnect but have since been renamed. +;; in erc-scenarios-base-reconnect but have since been renamed. Note +;; that these are somewhat difficult to reason about because the user +;; joins a second channel after reconnecting, and the first is +;; controlled by `autojoin'. (defun erc-scenarios-base-buffer-display--reconnect-common (assert-server assert-chan assert-rest) @@ -55,6 +58,7 @@ erc-scenarios-base-buffer-display--reconnect-common (ert-info ("Wait for some output in channels") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (funcall assert-chan expect) + (funcall expect 10 "welcome") (funcall expect 10 "welcome"))) (ert-info ("Server buffer shows connection failed") @@ -68,6 +72,10 @@ erc-scenarios-base-buffer-display--reconnect-common (ert-info ("Wait for auto reconnect") (with-current-buffer "FooNet" (funcall expect 10 "still in debug mode"))) + (ert-info ("Lone window still shows messages buffer") + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) + (funcall assert-rest expect) (ert-info ("Wait for activity to recommence in both channels") @@ -76,40 +84,50 @@ erc-scenarios-base-buffer-display--reconnect-common (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (funcall expect 10 "her elves come here anon"))))) +;; Interactively issuing a slash command resets the auto-reconnect +;; count, making ERC ignore the option `erc-auto-reconnect-display' +;; when next displaying a newly set up buffer. In the case of a +;; /JOIN, the option `erc-interactive-display' takes precedence. (ert-deftest erc-scenarios-base-buffer-display--defwin-recbury-intbuf () :tags '(:expensive-test) (should (eq erc-buffer-display 'bury)) (should (eq erc-interactive-display 'window)) (should-not erc-auto-reconnect-display) - (let ((erc-buffer-display 'window) - (erc-interactive-display 'buffer) - (erc-auto-reconnect-display 'bury)) + (let ((erc-buffer-display 'window) ; defwin + (erc-interactive-display 'buffer) ; intbuf + (erc-auto-reconnect-display 'bury)) ; recbury (erc-scenarios-base-buffer-display--reconnect-common (lambda (_) - (should (eq (window-buffer) (current-buffer))) - (should-not (frame-root-window-p (selected-window)))) + (ert-info ("New server buffer appears in a selected split") + (should (eq (window-buffer) (current-buffer))) + (should-not (frame-root-window-p (selected-window))))) (lambda (_) - (should (eq (window-buffer) (current-buffer))) - (should (equal (get-buffer "FooNet") (window-buffer (next-window))))) + (ert-info ("New channel buffer appears in other window") + (should (eq (window-buffer) (current-buffer))) ; selected + (should (equal (get-buffer "FooNet") (window-buffer (next-window)))))) + + (lambda (expect) + ;; If we /JOIN #spam now, we'll cancel the auto-reconnect + ;; timer, and "#chan" may well pop up in a split before we can + ;; verify that the lone window displays #spam (a race, IOW). + (ert-info ("Autojoined channel #chan buried on JOIN") + (with-current-buffer "#chan" + (funcall expect 10 "You have joined channel #chan")) + (should (frame-root-window-p (selected-window))) + (should (eq (window-buffer) (messages-buffer)))) - (lambda (_) - (with-current-buffer "FooNet" - (should (eq (window-buffer) (messages-buffer))) - (should (frame-root-window-p (selected-window)))) - - ;; A manual /JOIN command tells ERC we're done auto-reconnecting (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam")) - (ert-info ("#spam ignores `erc-auto-reconnect-display'") - ;; Uses `erc-interactive-display' instead. + (ert-info ("A /JOIN ignores `erc-auto-reconnect-display'") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (should (eq (window-buffer) (get-buffer "#spam"))) - ;; Option `buffer' replaces entire window (no split) - (erc-d-t-wait-for 5 (frame-root-window-p (selected-window))))))))) + ;; Option `erc-interactive-display' being `buffer' means + ;; Emacs reuses the selected window (no split). + (should (frame-root-window-p (selected-window))))))))) (ert-deftest erc-scenarios-base-buffer-display--defwino-recbury-intbuf () :tags '(:expensive-test) @@ -117,7 +135,7 @@ erc-scenarios-base-buffer-display--defwino-recbury-intbuf (should (eq erc-interactive-display 'window)) (should-not erc-auto-reconnect-display) - (let ((erc-buffer-display 'window-noselect) + (let ((erc-buffer-display 'window-noselect) ; defwino (erc-auto-reconnect-display 'bury) (erc-interactive-display 'buffer)) (erc-scenarios-base-buffer-display--reconnect-common @@ -139,26 +157,24 @@ erc-scenarios-base-buffer-display--defwino-recbury-intbuf (should (eq (current-buffer) (window-buffer (next-window))))) (lambda (_) - (with-current-buffer "FooNet" - (should (eq (window-buffer) (messages-buffer))) - (should (frame-root-window-p (selected-window)))) - - ;; A non-interactive JOIN command doesn't signal that we're - ;; done auto-reconnecting, and `erc-interactive-display' is - ;; ignored, so `erc-buffer-display' is again in charge (here, - ;; that means `window-noselect'). - (ert-info ("Join chan noninteractively and open a /QUERY") + ;; A JOIN command sent from lisp code is "non-interactive" and + ;; doesn't reset the auto-reconnect count, so ERC treats the + ;; response as possibly server-initiated or otherwise the + ;; result of an autojoin and continues to favor + ;; `erc-auto-reconnect-display'. + (ert-info ("Join chan non-interactively and open a /QUERY") (with-current-buffer "FooNet" - (erc-cmd-JOIN "#spam") - ;; However this will reset the option. - (erc-scenarios-common-say "/QUERY bob") + (erc-cmd-JOIN "#spam") ; "non-interactive" according to ERC + (erc-scenarios-common-say "/QUERY bob") ; resets count (should (eq (window-buffer) (get-buffer "bob"))) (should (frame-root-window-p (selected-window))))) + ;; The /QUERY above resets the count, and `erc-buffer-display' + ;; again decides how #spam is displayed. (ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (should (eq (window-buffer) (get-buffer "bob"))) - (should-not (frame-root-window-p (selected-window))) + (should-not (frame-root-window-p (selected-window))) ; noselect (should (eq (current-buffer) (window-buffer (next-window)))))))))) (ert-deftest erc-scenarios-base-buffer-display--count-reset-timeout () @@ -177,24 +193,22 @@ erc-scenarios-base-buffer-display--count-reset-timeout (lambda (_) (with-current-buffer "FooNet" - (should erc--server-reconnect-display-timer) - (should (eq (window-buffer) (messages-buffer))) - (should (frame-root-window-p (selected-window)))) + (should erc--server-reconnect-display-timer)) ;; A non-interactive JOIN command doesn't signal that we're - ;; done auto-reconnecting - (ert-info ("Join chan noninteractively") + ;; done auto-reconnecting. + (ert-info ("Join channel #spam non-interactively") (with-current-buffer "FooNet" (erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer)) - (erc-cmd-JOIN "#spam"))) + (erc-cmd-JOIN "#spam"))) ; not processed as a /JOIN - (ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'") - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) - (should (eq (window-buffer) (messages-buffer))) - ;; If `erc-auto-reconnect-display-timeout' were left alone, this - ;; would be (frame-root-window-p #). - (should-not (frame-root-window-p (selected-window))) - (should (eq (current-buffer) (window-buffer (next-window)))))))))) + (ert-info ("Option `erc-auto-reconnect-display' ignored w/o timer") + (should (eq (window-buffer) (messages-buffer))) + (erc-d-t-wait-for 10 (get-buffer "#spam")) + ;; If `erc-auto-reconnect-display-timeout' were left alone, + ;; this would be (frame-root-window-p #). + (should-not (frame-root-window-p (selected-window))) + (should (eq (get-buffer "#spam") (window-buffer (next-window))))))))) ;; This shows that the option `erc-interactive-display' overrides ;; `erc-join-buffer' during cold opens and interactive /JOINs. diff --git a/test/lisp/erc/erc-scenarios-base-misc-regressions.el b/test/lisp/erc/erc-scenarios-base-misc-regressions.el index c1915d088a0..42d7653d3ec 100644 --- a/test/lisp/erc/erc-scenarios-base-misc-regressions.el +++ b/test/lisp/erc/erc-scenarios-base-misc-regressions.el @@ -77,7 +77,7 @@ erc-scenarios-base-gapless-connect (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#bar")) (funcall expect 10 "was created on") - (funcall expect 2 "his second fit")) + (funcall expect 10 "his second fit")) (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#foo")) (funcall expect 10 "was created on") @@ -108,7 +108,7 @@ erc-scenarios-base-channel-buffer-revival (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) (ert-info ("Server buffer is unique and temp name is absent") - (erc-d-t-wait-for 1 (get-buffer "FooNet")) + (erc-d-t-wait-for 10 (get-buffer "FooNet")) (should-not (erc-scenarios-common-buflist "127.0.0.1")) (with-current-buffer erc-server-buffer-foo (erc-cmd-JOIN "#chan"))) diff --git a/test/lisp/erc/resources/base/reconnect/options-again.eld b/test/lisp/erc/resources/base/reconnect/options-again.eld index f1fcc439cc3..8a3264fda9c 100644 --- a/test/lisp/erc/resources/base/reconnect/options-again.eld +++ b/test/lisp/erc/resources/base/reconnect/options-again.eld @@ -32,13 +32,13 @@ (0 ":irc.foonet.org 353 tester = #spam :alice tester @bob") (0 ":irc.foonet.org 366 tester #spam :End of NAMES list")) -((~mode-chan 4 "MODE #chan") +((~mode-chan 10 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620104779") (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.") (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden.")) -((mode-spam 4 "MODE #spam") +((mode-spam 20 "MODE #spam") (0 ":irc.foonet.org 324 tester #spam +nt") (0 ":irc.foonet.org 329 tester #spam 1620104779") (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #spam :alice: Signior Iachimo will not from it. Pray, let us follow 'em.") diff --git a/test/lisp/erc/resources/dcc/chat/accept.eld b/test/lisp/erc/resources/dcc/chat/accept.eld index a23e9580bcc..463f931d26f 100644 --- a/test/lisp/erc/resources/dcc/chat/accept.eld +++ b/test/lisp/erc/resources/dcc/chat/accept.eld @@ -17,7 +17,7 @@ (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") (0 ":irc.foonet.org 422 tester :MOTD File is missing")) -((mode-user 1.2 "MODE tester +i") +((mode-user 10 "MODE tester +i") ;; No mode answer (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.") (0.2 ":dummy!~u@34n9brushbpj2.irc PRIVMSG tester :\C-aDCC CHAT chat 2130706433 " port "\C-a")) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index f072c6b93b2..a87904e5830 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -297,7 +297,7 @@ erc-d--m (when erc-d--m-debug (setq format-string (concat (format-time-string "%s.%N: ") format-string))) (let ((insertp (and process erc-d--in-process)) - (buffer (process-buffer (process-get process :server)))) + (buffer (and process (process-buffer (process-get process :server))))) (when (and insertp (buffer-live-p buffer)) (princ (concat (apply #'format format-string args) "\n") buffer)) (when (or erc-d--m-debug (not insertp)) 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 e5532980644..2db750e49da 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld @@ -17,7 +17,7 @@ (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 2 "MODE tester +i") +((mode-user 4 "MODE tester +i") (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") diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 9e134e6932f..802ccaeedaa 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -455,7 +455,7 @@ erc-scenarios-common--base-network-id-bouncer :id foo-id)) (setq erc-server-process-foo erc-server-process) (erc-scenarios-common-assert-initial-buf-name foo-id port) - (erc-d-t-wait-for 3 (eq (erc-network) 'foonet)) + (erc-d-t-wait-for 6 (eq (erc-network) 'foonet)) (erc-d-t-wait-for 3 (string= (buffer-name) serv-buf-foo)) (funcall expect 5 "foonet"))) commit 32ed6e610f4a29a6adebc89a7b37d1b4beb54ec1 Author: Dmitry Gutov Date: Wed Nov 1 22:48:23 2023 +0200 (project-switch-project): Fix the previous change * lisp/progmodes/project.el (project-switch-project): Clear the buffer-local value in the right buffer (bug#66317). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 5129dc98b82..57d9d8e99ab 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2029,12 +2029,14 @@ project-switch-project (interactive (list (funcall project-prompter))) (let ((command (if (symbolp project-switch-commands) project-switch-commands - (project--switch-project-command)))) + (project--switch-project-command))) + (buffer (current-buffer))) (unwind-protect (progn (setq-local project-current-directory-override dir) (call-interactively command)) - (kill-local-variable 'project-current-directory-override)))) + (with-current-buffer buffer + (kill-local-variable 'project-current-directory-override))))) ;;;###autoload (defun project-uniquify-dirname-transform (dirname) commit 8eb9b82ce58a8323af21f52625a401e19e279a9c Author: Juri Linkov Date: Wed Nov 1 19:45:05 2023 +0200 New commands previous-line-completion and next-line-completion (bug#59486) * lisp/simple.el (completion-list-mode-map): Bind [up] to 'previous-line-completion', and [down] to 'next-line-completion'. (completion-auto-wrap): Mention `next-line-completion' and `previous-line-completion' in the docstring. (previous-line-completion, next-line-completion): New commands. diff --git a/etc/NEWS b/etc/NEWS index 817d53baa78..c865c6b8891 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1007,8 +1007,15 @@ A major mode based on the tree-sitter library for editing Elixir files. *** New major mode 'lua-ts-mode'. A major mode based on the tree-sitter library for editing Lua files. +** Minibuffer and Completions + +*** New commands 'previous-line-completion' and 'next-line-completion'. +Bound to '' and '' respectively, they navigate the *Completions* +buffer vertically, wrapping at the top/bottom when 'completion-auto-wrap' +is non-nil. + +++ -** New global minor mode 'minibuffer-regexp-mode'. +*** New global minor mode 'minibuffer-regexp-mode'. This is a minor mode for editing regular expressions in the minibuffer. It highlights parens via ‘show-paren-mode’ and ‘blink-matching-paren’ in a user-friendly way, avoids reporting alleged paren mismatches and makes diff --git a/lisp/simple.el b/lisp/simple.el index ec14bec9e07..fd8f08bcb3d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9820,6 +9820,8 @@ completion-list-mode-map (define-key map "\C-m" 'choose-completion) (define-key map "\e\e\e" 'delete-completion-window) (define-key map [remap keyboard-quit] #'delete-completion-window) + (define-key map [up] 'previous-line-completion) + (define-key map [down] 'next-line-completion) (define-key map [left] 'previous-completion) (define-key map [right] 'next-completion) (define-key map [?\t] 'next-completion) @@ -9882,7 +9884,8 @@ delete-completion-window (defcustom completion-auto-wrap t "Non-nil means to wrap around when selecting completion options. -This affects the commands `next-completion' and `previous-completion'. +This affects the commands `next-completion', `previous-completion', +`next-line-completion' and `previous-line-completion'. When `completion-auto-select' is t, it wraps through the minibuffer for the commands bound to the TAB key." :type 'boolean @@ -10000,6 +10003,87 @@ next-completion (when (/= 0 n) (switch-to-minibuffer)))) +(defun previous-line-completion (&optional n) + "Move to the item on the previous line in the completion list. +With prefix argument N, move back N items line-wise (negative N +means move forward). + +Also see the `completion-auto-wrap' variable." + (interactive "p") + (next-line-completion (- n))) + +(defun next-line-completion (&optional n) + "Move to the item on the next line in the completion list. +With prefix argument N, move N items line-wise (negative N +means move backward). + +Also see the `completion-auto-wrap' variable." + (interactive "p") + (let (line column pos) + (when (and (bobp) + (> n 0) + (get-text-property (point) 'mouse-face) + (not (get-text-property (point) 'first-completion))) + (let ((inhibit-read-only t)) + (add-text-properties (point) (1+ (point)) '(first-completion t))) + (setq n (1- n))) + + (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))) + ;; Try to move to the previous completion. + (setq pos (previous-single-property-change (point) 'mouse-face)) + (if pos + ;; Move to the start of the previous completion. + (progn + (goto-char pos) + (unless (get-text-property (point) 'mouse-face) + (goto-char (previous-single-property-change + (point) 'mouse-face nil (point-min))))) + (cond ((> n 0) (setq n (1- n)) (first-completion)) + ((< n 0) (first-completion))))) + + (while (> n 0) + (setq pos nil column (current-column) line (line-number-at-pos)) + (when (and (or (not (eq (forward-line 1) 0)) + (eobp) + (not (eq (move-to-column column) column)) + (not (get-text-property (point) 'mouse-face))) + completion-auto-wrap) + (save-excursion + (goto-char (point-min)) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))) + (while (and (not pos) (> line (line-number-at-pos))) + (forward-line 1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos))) + (setq n (1- n))) + + (while (< n 0) + (setq pos nil column (current-column) line (line-number-at-pos)) + (when (and (or (not (eq (forward-line -1) 0)) + (not (eq (move-to-column column) column)) + (not (get-text-property (point) 'mouse-face))) + completion-auto-wrap) + (save-excursion + (goto-char (point-max)) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))) + (while (and (not pos) (< line (line-number-at-pos))) + (forward-line -1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos))) + (setq n (1+ n))))) + (defun choose-completion (&optional event no-exit no-quit) "Choose the completion at point. If EVENT, use EVENT's position to determine the starting position. commit 861ac933dd8aed1028edc4b9142400e3702874d5 Author: Michael Albinus Date: Wed Nov 1 16:54:31 2023 +0100 Run `man' also on remote systems This implements bug#66758 * doc/emacs/programs.texi (Man Page): Describe Man-support-remote-systems. * etc/NEWS: Mention user option 'Man-support-remote-systems'. Fix typos. * lisp/dired.el (Man-support-remote-systems): Declare. (dired-do-man): Use it. Use also `file-local-name'. * lisp/man.el (Man-support-remote-systems): New defcustom. (Man-xref-normal-file): Handle remote files. (Man-default-directory, Man-shell-file-name) (Man-header-file-path): New defuns. (Man-init-defvars): Use octal numbers. (Man-support-local-filenames): Handle remote files. (Man-completion-table): Use `Man-default-directory' and `process-file'. (man): Adapt docstring. (Man-start-calling): Use `Man-default-directory'. (Man-getpage-in-background): Use `Man-default-directory', `Man-shell-file-name', `start-file-process' and `process-file'. Adapt buffer name. (Man-update-manpage): Use `Man-shell-file-name' and `process-file'. (Man-view-header-file): Use `Man-header-file-path'. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 40746e03ecc..7746bc8bc23 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1402,6 +1402,13 @@ Man Page customizing @code{Man-prefer-synchronous-calls} to a non-@code{nil} value. +@vindex Man-support-remote-systems + If the user option @code{Man-support-remote-systems} is +non-@code{nil}, and @code{default-directory} indicates a remote system +(@pxref{Remote Files}), the man page is taken from the remote system. +Calling the @code{man} command with a prefix like @kbd{C-u M-x man} +reverts the value of @code{Man-support-remote-systems} for that call. + @findex woman @cindex manual pages, on MS-DOS/MS-Windows An alternative way of reading manual pages is the @kbd{M-x woman} diff --git a/etc/NEWS b/etc/NEWS index 9c0f28e3fa9..817d53baa78 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -62,15 +62,17 @@ more details. ** Emacs now supports Unicode Standard version 15.1. +** Network Security Manager + +++ -** The Network Security Manager now warns about 3DES by default. +*** The Network Security Manager now warns about 3DES by default. This cypher is no longer recommended owing to a major vulnerability disclosed in 2016, and its small 112 bit key size. Emacs now warns about its use also when 'network-security-level' is set to 'medium' (the default). See 'network-security-protocol-checks'. --- -** The Network Security Manager now warns about <2048 bits in DH key exchange. +*** The Network Security Manager now warns about <2048 bits in DH key exchange. Emacs used to warn for Diffie-Hellman key exchanges with prime numbers smaller than 1024 bits. Since more servers now support it, this number has been bumped to 2048 bits. @@ -149,11 +151,11 @@ When this minor mode is enabled, buttons representing modifier keys are displayed along the tool bar. +++ -** 'd' in the mode line now indicates that the window is dedicated. +** "d" in the mode line now indicates that the window is dedicated. Windows have always been able to be dedicated to a specific buffer; see 'window-dedicated-p'. Now the mode line indicates the dedicated -status of a window, with 'd' appearing in the mode line if a window is -dedicated and 'D' if the window is strongly dedicated. This indicator +status of a window, with "d" appearing in the mode line if a window is +dedicated and "D" if the window is strongly dedicated. This indicator appears before the buffer name, and after the buffer modification and remote buffer indicators (usually "---" together). @@ -164,11 +166,6 @@ dedicated, so it won't be reused by 'display-buffer'. This can be useful for complicated window setups. It is bound to 'C-x w d' globally. -** cl-print -*** You can expand the "..." truncation everywhere. -The code that allowed "..." to be expanded in the *Backtrace* should -now work anywhere the data is generated by `cl-print`. - --- ** New user option 'uniquify-dirname-transform'. This can be used to customize how buffer names are uniquified, by @@ -202,12 +199,14 @@ should now work anywhere the data is generated by 'cl-print'. *** Modes can control the expansion via 'cl-print-expand-ellipsis-function'. +++ -*** There is a new setting 'raw' for 'cl-print-compiled' which causes -byte-compiled functions to be printed in full by 'prin1'. A button on -this output can be activated to disassemble the function. +*** New setting 'raw' for 'cl-print-compiled'. +This setting causes byte-compiled functions to be printed in full by +'prin1'. A button on this output can be activated to disassemble the +function. +++ *** There is a new chapter in the CL manual documenting cl-print.el. +See the Info node "(cl) Printing". ** Modeline elements can now be right-aligned. Anything following the symbol 'mode-line-format-right-align' in @@ -222,10 +221,11 @@ It can be used to add, remove and reorder functions that change the appearance of every tab on the tab bar. +++ -** New optional argument for modifying directory local variables +** New optional argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and 'copy-file-locals-to-dir-locals' now take an optional prefix argument, to enter the file you want to modify. + ** Miscellaneous --- @@ -336,7 +336,7 @@ functions in CJK locales. +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. Note that -you might want to add these settings to your .lldbinit file, to reduce +you might want to add these settings to your ".lldbinit" file, to reduce the output in the LLDB output when stepping through source files. settings set stop-line-count-before 0 @@ -396,7 +396,7 @@ switches for shortlogs, such as the one produced by 'C-x v L'. *** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'. The command was previously obsoleted and unbound in Emacs 28. -** Diff Mode +** Diff mode +++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. @@ -563,7 +563,7 @@ The command 'makefile-switch-to-browser' command is now obsolete, together with related commands used in the "*Macros and Targets*" buffer. We recommend using an alternative like 'imenu' instead. -** Prog Mode +** Prog mode +++ *** New command 'prog-fill-reindent-defun'. @@ -572,10 +572,10 @@ docstring, or a comment, or (re)indents the surrounding defun if point is not in a comment or a string. It is by default bound to 'M-q' in 'prog-mode' and all its descendants. -** Which Function Mode +** Which Function mode +++ -*** Which Function Mode can now display function names on the header line. +*** Which Function mode can now display function names on the header line. The new user option 'which-func-display' allows choosing where the function name is displayed. The default is 'mode' to display in the mode line. 'header' will display in the header line; @@ -684,13 +684,21 @@ This command adds a docstring comment to the current defun. If a comment already exists, point is only moved to the comment. It is bound to 'C-c C-d' in 'go-ts-mode'. -** Man-mode +** Man mode +++ *** New user option 'Man-prefer-synchronous-call'. When this is non-nil, call the 'man' program synchronously rather than asynchronously (which is the default behavior). ++++ +*** New user option 'Man-support-remote-systems'. +If the user option 'Man-support-remote-systems' is non-nil, and +'default-directory' indicates a remote system, the man page is taken +from the remote system. Calling the 'man' command with a prefix like +'C-u M-x man' reverts the value of 'Man-support-remote-systems' for +that call. + ** DocView --- @@ -757,7 +765,7 @@ 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. -** Python Mode +** Python mode --- *** New user option 'python-indent-block-paren-deeper'. @@ -790,7 +798,7 @@ This keyword enables the user to install packages using 'package-vc'. *** The 'nnweb-type' option 'gmane' has been removed. 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 the 'gmane'. +the user option 'nnweb-type' to 'gmane'. ** Rmail @@ -875,14 +883,13 @@ CPerl mode supports the new keywords for exception handling and the object oriented syntax which were added in Perl 5.36 and 5.38. *** New user option 'cperl-fontify-trailer'. -This user option takes the values "perl-code" or "comment" and treats +This user option takes the values 'perl-code' or 'comment' and treats text after an "__END__" or "__DATA__" token accordingly. The default -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. +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. *** 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 read with 'cperl-perldoc' instead. @@ -942,11 +949,11 @@ neither of which have been supported by Emacs since version 23.1. The user option 'url-gateway-nslookup-program' and the function 'url-gateway-nslookup-host' are consequently also obsolete. -** socks +** Socks +++ -*** SOCKS supports version 4a. -The 'socks-server' option accepts '4a' as a value for its version +*** Socks supports version 4a. +The 'socks-server' user option accepts '4a' as a value for its version field. ** Edmacro @@ -973,9 +980,10 @@ previously assumed that they should be prefixed with "http://". Such URIs are now prefixed with "https://" instead. ** Customize + +++ -*** New command customize-dirlocals -This command pops up a buffer to edit the settings in .dir-locals.el +*** New command 'customize-dirlocals'. +This command pops up a buffer to edit the settings in ".dir-locals.el". * New Modes and Packages in Emacs 30.1 @@ -1045,8 +1053,8 @@ the file listing's performance is still optimized. * Incompatible Lisp Changes in Emacs 30.1 -** `buffer-match-p and `match-buffers` take `&rest args` -They used to take a single `&optional arg` and were documented to use +** 'buffer-match-p' and 'match-buffers' take '&rest args'. +They used to take a single '&optional arg' and were documented to use an unreliable hack to try and support condition predicates that don't accept this optional arg. The new semantics makes no such accommodation, but the code still @@ -1130,7 +1138,7 @@ The compatibility aliases 'x-defined-colors', 'x-color-defined-p', Use 'define-minor-mode' and 'define-globalized-minor-mode' instead. ** The obsolete calling convention of 'sit-for' has been removed. -That convention was: (sit-for SECONDS MILLISEC &optional NODISP) +That convention was: '(sit-for SECONDS MILLISEC &optional NODISP)'. ** The 'millisec' argument of 'sleep-for' has been declared obsolete. Use a float value for the first argument instead. @@ -1147,7 +1155,7 @@ values. It is now possible for drag-and-drop handler functions to respond to drops incorporating more than one URL. Functions capable of this must set their 'dnd-multiple-handler' symbol properties to a non-nil value. -See the Info node "(elisp)Drag and Drop". +See the Info node "(elisp) Drag and Drop". Incident to this change, the function 'dnd-handle-one-url' has been made obsolete, for it cannot take these new handlers into account. @@ -1165,8 +1173,8 @@ Other features in Emacs which employ XLFDs have been modified to produce and understand XLFDs larger than 255 characters. ** 'defadvice' is marked as obsolete. -See the "(elisp) Porting Old Advice" node for help converting them -to use 'advice-add' or 'define-advice' instead. +See the "(elisp) Porting Old Advice" Info node for help converting +them to use 'advice-add' or 'define-advice' instead. ** 'cl-old-struct-compat-mode' is marked as obsolete. You may need to recompile our code if it was compiled with Emacs < 24.3. @@ -1469,10 +1477,11 @@ When supplied with ':default-language LANGUAGE', rules after it will default to use 'LANGUAGE'. --- -** New optional argument to 'modify-dir-local-variable' +** New optional argument to 'modify-dir-local-variable'. A 5th argument, optional, has been added to 'modify-dir-local-variable'. It can be used to specify which dir-locals file to modify. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/dired.el b/lisp/dired.el index 231d305210b..99156b28365 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4998,6 +4998,7 @@ dired-jump-map ;;; Miscellaneous commands (declare-function Man-getpage-in-background "man" (topic)) +(defvar Man-support-remote-systems) ; from man.el (defvar manual-program) ; from man.el (defun dired-do-man () @@ -5005,10 +5006,11 @@ dired-do-man (interactive nil dired-mode) (require 'man) (let* ((file (dired-get-file-for-visit)) + (Man-support-remote-systems (file-remote-p file)) (manual-program (string-replace "*" "%s" (dired-guess-shell-command "Man command: " (list file))))) - (Man-getpage-in-background file))) + (Man-getpage-in-background (file-local-name file)))) (defun dired-do-info () "In Dired, run `info' on this file." diff --git a/lisp/man.el b/lisp/man.el index 506d6060269..d64a355e3d8 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -105,6 +105,13 @@ Man-prefer-synchronous-call :group 'man :version "30.1") +(defcustom Man-support-remote-systems nil + "Whether to call the Un*x \"man\" program on remote systems. +When this is non-nil, call the \"man\" program on the remote +system determined by `default-directory'." + :type 'boolean + :version "30.1") + (defcustom Man-filter-list nil "Manpage cleaning filter command phrases. This variable contains a list of the following form: @@ -531,8 +538,9 @@ 'Man-xref-header-file (define-button-type 'Man-xref-normal-file 'action (lambda (button) - (let ((f (substitute-in-file-name - (button-get button 'Man-target-string)))) + (let ((f (concat (file-remote-p default-directory) + (substitute-in-file-name + (button-get button 'Man-target-string))))) (if (file-exists-p f) (if (file-readable-p f) (view-file f) @@ -545,6 +553,63 @@ 'Man-xref-normal-file ;; ====================================================================== ;; utilities +(defun Man-default-directory () + "Return a default directory according to `Man-support-remote-systems'." + ;; Ensure that `default-directory' exists and is readable. + ;; We assume, that this function is always called inside the `man' + ;; command, so that we can check `current-prefix-arg' for reverting + ;; `Man-support-remote-systems'. + (let ((result default-directory) + (remote (if current-prefix-arg + (not Man-support-remote-systems) + Man-support-remote-systems))) + + ;; Use a local directory if remote isn't possible. + (when (and (file-remote-p default-directory) + (not (and remote + ;; TODO:: Test that remote processes are supported. + ))) + (setq result (expand-file-name "~/"))) + + ;; Check, whether the directory is accessible. + (if (file-accessible-directory-p result) + result + (expand-file-name (concat (file-remote-p result) "~/"))))) + +(defun Man-shell-file-name () + "Return a proper shell file name, respecting remote directories." + (or ; This works also in the local case. + (with-connection-local-variables shell-file-name) + "/bin/sh")) + +(defun Man-header-file-path () + "C Header file search path used in Man. +In the local case, it is the value of `Man-header-file-path'. +Otherwise, it will be checked on the remote system." + (let ((remote-id (file-remote-p default-directory))) + (if (null remote-id) + ;; The local case. + Man-header-file-path + ;; The remote case. Use connection-local variables. + (mapcar + (lambda (elt) (concat remote-id elt)) + (with-connection-local-variables + (or (and (local-variable-p 'Man-header-file-path (current-buffer)) + Man-header-file-path) + (setq-connection-local + Man-header-file-path + (let ((arch (with-temp-buffer + (when (zerop (ignore-errors + (process-file "gcc" nil '(t nil) nil + "-print-multiarch"))) + (goto-char (point-min)) + (buffer-substring (point) (line-end-position))))) + (base '("/usr/include" "/usr/local/include"))) + (if (zerop (length arch)) + base + (append + base (list (expand-file-name arch "/usr/include")))))))))))) + (defun Man-init-defvars () "Used for initializing variables based on display's color support. This is necessary if one wants to dump man.el with Emacs." @@ -583,7 +648,9 @@ Man-init-defvars (if Man-sed-script (concat "-e '" Man-sed-script "'") "") - "-e '/^[\001-\032][\001-\032]*$/d'" + ;; Use octal numbers. Otherwise, \032 (Ctrl-Z) would + ;; suspend remote connections. + "-e '/^[\\o001-\\o032][\\o001-\\o032]*$/d'" "-e '/\e[789]/s///g'" "-e '/Reformatting page. Wait/d'" "-e '/Reformatting entry. Wait/d'" @@ -717,22 +784,23 @@ Man-support-local-filenames a \"/\" as a local filename. The function returns either `man-db' `man', or nil." (if (eq Man-support-local-filenames 'auto-detect) - (setq Man-support-local-filenames - (with-temp-buffer - (let ((default-directory - ;; Ensure that `default-directory' exists and is readable. - (if (file-accessible-directory-p default-directory) - default-directory - (expand-file-name "~/")))) - (ignore-errors - (call-process manual-program nil t nil "--help"))) - (cond ((search-backward "--local-file" nil 'move) - 'man-db) - ;; This feature seems to be present in at least ver 1.4f, - ;; which is about 20 years old. - ;; I don't know if this version has an official name? - ((looking-at "^man, versione? [1-9]") - 'man)))) + (with-connection-local-variables + (or (and (local-variable-p 'Man-support-local-filenames (current-buffer)) + Man-support-local-filenames) + (setq-connection-local + Man-support-local-filenames + (with-temp-buffer + (let ((default-directory (Man-default-directory))) + (ignore-errors + (process-file manual-program nil t nil "--help"))) + (cond ((search-backward "--local-file" nil 'move) + 'man-db) + ;; This feature seems to be present in at least + ;; ver 1.4f, which is about 20 years old. I + ;; don't know if this version has an official + ;; name? + ((looking-at "^man, versione? [1-9]") + 'man)))))) Man-support-local-filenames)) @@ -918,7 +986,8 @@ Man-completion-table (unless (and Man-completion-cache (string-prefix-p (car Man-completion-cache) prefix)) (with-temp-buffer - (setq default-directory "/") ;; in case inherited doesn't exist + ;; In case inherited doesn't exist. + (setq default-directory (Man-default-directory)) ;; Actually for my `man' the arg is a regexp. ;; POSIX says it must be ERE and "man-db" seems to agree, ;; whereas under macOS it seems to be BRE-style and doesn't @@ -932,7 +1001,7 @@ Man-completion-table ;; error later. (when (eq 0 (ignore-errors - (call-process + (process-file manual-program nil '(t nil) nil "-k" (concat (when (or Man-man-k-use-anchor (string-equal prefix "")) @@ -1016,7 +1085,14 @@ man Note that in some cases you will need to use \\[quoted-insert] to quote the SPC character in the above examples, because this command attempts -to auto-complete your input based on the installed manual pages." +to auto-complete your input based on the installed manual pages. + +If `default-directory' is remote, and `Man-support-remote-systems' +is non-nil, the man page will be formatted on the corresponding +remote system. + +If `man' is called interactively with a prefix argument, the +value of `Man-support-remote-systems' is reverted." (interactive (list (let* ((default-entry (Man-default-man-entry)) @@ -1082,12 +1158,7 @@ Man-start-calling Man-coding-system locale-coding-system)) ;; Avoid possible error by using a directory that always exists. - (default-directory - (if (and (file-directory-p default-directory) - (not (find-file-name-handler default-directory - 'file-directory-p))) - default-directory - "/"))) + (default-directory (Man-default-directory))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") ;; In Debian Woody, at least, we get overlong lines under X @@ -1116,9 +1187,13 @@ Man-start-calling (defun Man-getpage-in-background (topic) "Use TOPIC to build and fire off the manpage and cleaning command. Return the buffer in which the manpage will appear." - (let* ((man-args topic) - (bufname (concat "*Man " man-args "*")) - (buffer (get-buffer bufname))) + (let* ((default-directory (Man-default-directory)) + (man-args topic) + (bufname + (if (file-remote-p default-directory) + (format "*Man %s %s *" (file-remote-p default-directory) man-args) + (format "*Man %s *" man-args))) + (buffer (get-buffer bufname))) (if buffer (Man-notify-when-ready buffer) (message "Invoking %s %s in the background" manual-program man-args) @@ -1137,20 +1212,19 @@ Man-getpage-in-background (Man-start-calling (if (and (fboundp 'make-process) (not Man-prefer-synchronous-call)) - (let ((proc (start-process + (let ((proc (start-file-process manual-program buffer - (if (memq system-type '(cygwin windows-nt)) - shell-file-name - "sh") + (Man-shell-file-name) shell-command-switch (format (Man-build-man-command) man-args)))) (set-process-sentinel proc 'Man-bgproc-sentinel) (set-process-filter proc 'Man-bgproc-filter)) (let* ((inhibit-read-only t) (exit-status - (call-process shell-file-name nil (list buffer nil) nil - shell-command-switch - (format (Man-build-man-command) man-args))) + (process-file + (Man-shell-file-name) nil (list buffer nil) nil + shell-command-switch + (format (Man-build-man-command) man-args))) (msg "")) (or (and (numberp exit-status) (= exit-status 0)) @@ -1178,9 +1252,10 @@ Man-update-manpage (buffer-read-only nil)) (erase-buffer) (Man-start-calling - (call-process shell-file-name nil (list (current-buffer) nil) nil - shell-command-switch - (format (Man-build-man-command) Man-arguments))) + (process-file + (Man-shell-file-name) nil (list (current-buffer) nil) nil + shell-command-switch + (format (Man-build-man-command) Man-arguments))) (if Man-fontify-manpage-flag (Man-fontify-manpage) (Man-cleanup-manpage)) @@ -1944,7 +2019,7 @@ Man-previous-manpage ;; Header file support (defun Man-view-header-file (file) "View a header file specified by FILE from `Man-header-file-path'." - (let ((path Man-header-file-path) + (let ((path (Man-header-file-path)) complete-path) (while path (setq complete-path (expand-file-name file (car path)) commit 8160485953e1439f4da28fac35b918822407436b Author: Mattias Engdegård Date: Wed Nov 1 14:34:30 2023 +0100 Non-recursive marking of buffer-local variables * src/alloc.c (mark_localized_symbol): Inline into... (process_mark_stack): ...this code and do don't use recursion. diff --git a/src/alloc.c b/src/alloc.c index 45a950c4f81..cda8ba1ad46 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6962,20 +6962,6 @@ mark_face_cache (struct face_cache *c) } } -NO_INLINE /* To reduce stack depth in mark_object. */ -static void -mark_localized_symbol (struct Lisp_Symbol *ptr) -{ - struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); - Lisp_Object where = blv->where; - /* If the value is set up for a killed buffer restore its global binding. */ - if ((BUFFERP (where) && !BUFFER_LIVE_P (XBUFFER (where)))) - swap_in_global_binding (ptr); - mark_object (blv->where); - mark_object (blv->valcell); - mark_object (blv->defcell); -} - /* Remove killed buffers or items whose car is a killed buffer from LIST, and mark other items. Return changed LIST, which is marked. */ @@ -7377,7 +7363,17 @@ #define CHECK_ALLOCATED_AND_LIVE_SYMBOL() ((void) 0) break; } case SYMBOL_LOCALIZED: - mark_localized_symbol (ptr); + { + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); + Lisp_Object where = blv->where; + /* If the value is set up for a killed buffer, + restore its global binding. */ + if (BUFFERP (where) && !BUFFER_LIVE_P (XBUFFER (where))) + swap_in_global_binding (ptr); + mark_stack_push_value (blv->where); + mark_stack_push_value (blv->valcell); + mark_stack_push_value (blv->defcell); + } break; case SYMBOL_FORWARDED: /* If the value is forwarded to a buffer or keyboard field, commit 445029da580c8194c2400d6959911117b2ba665a Author: Jeremy Bryant Date: Tue Oct 31 23:37:10 2023 +0000 Add two docstrings in cl-macs.el * lisp/emacs-lisp/cl-macs.el (cl--simple-exprs-p) (cl--const-expr-p): Add docstrings diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index a4a241d9c63..71a9ad33f98 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -101,6 +101,7 @@ cl--simple-expr-p (and (> size 0) (1- size)))) (defun cl--simple-exprs-p (xs) + "Map `cl--simple-expr-p' to each element of list XS." (while (and xs (cl--simple-expr-p (car xs))) (setq xs (cdr xs))) (not xs)) @@ -116,8 +117,10 @@ cl--safe-expr-p (while (and (setq x (cdr x)) (cl--safe-expr-p (car x)))) (null x))))) -;;; Check if constant (i.e., no side effects or dependencies). (defun cl--const-expr-p (x) + "Check if X is constant (i.e., no side effects or dependencies). + +See `macroexp-const-p' for similar functionality without cl-lib dependency." (cond ((consp x) (or (eq (car x) 'quote) (and (memq (car x) '(function cl-function)) commit a61cc138edeee269e8cf62c13058d5258310d7bc Author: Po Lu Date: Wed Nov 1 11:15:24 2023 +0800 Prevent errors when generating events above menu bar windows * src/keyboard.c (make_lispy_position): Pass false to w_f_c, for the subsequent code is not prepared to encounter menu bar windows. diff --git a/src/keyboard.c b/src/keyboard.c index c00f48d7836..003340c3e58 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5561,9 +5561,10 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, /* Coordinate pixel positions to return. */ int xret = 0, yret = 0; /* The window or frame under frame pixel coordinates (x,y) */ - Lisp_Object window_or_frame = f - ? window_from_coordinates (f, mx, my, &part, true, true, true) - : Qnil; + Lisp_Object window_or_frame = (f != NULL + ? window_from_coordinates (f, mx, my, &part, + false, true, true) + : Qnil); #ifdef HAVE_WINDOW_SYSTEM bool tool_bar_p = false; bool menu_bar_p = false; commit ffe894d0f358b94999e642b5167a3e43de7e0bc7 Author: Dmitry Gutov Date: Wed Nov 1 04:01:53 2023 +0200 Only override the current project buffer-locally * lisp/progmodes/project.el (project-switch-project): Only override the current project buffer-locally. This is mostly for the the mode-line indicator (https://debbugs.gnu.org/66317#53). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 76c5144b484..5129dc98b82 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2030,8 +2030,11 @@ project-switch-project (let ((command (if (symbolp project-switch-commands) project-switch-commands (project--switch-project-command)))) - (let ((project-current-directory-override dir)) - (call-interactively command)))) + (unwind-protect + (progn + (setq-local project-current-directory-override dir) + (call-interactively command)) + (kill-local-variable 'project-current-directory-override)))) ;;;###autoload (defun project-uniquify-dirname-transform (dirname) commit 8439f834493805017e0c44fa88a6b2e9b1a893eb Author: Dmitry Gutov Date: Wed Nov 1 03:58:45 2023 +0200 Catch 'permission-denied' during project lookup * lisp/progmodes/project.el (project--find-in-directory): Catch 'permission-denied' (bug#66317). Co-Authored-By: Spencer Baugh diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ac230bd0b83..76c5144b484 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -245,7 +245,12 @@ project-current pr)) (defun project--find-in-directory (dir) - (run-hook-with-args-until-success 'project-find-functions dir)) + ;; Use 'ignore-error' when 27.1 is the minimum supported. + (condition-case nil + (run-hook-with-args-until-success 'project-find-functions dir) + ;; Maybe we'd like to continue to the next backend instead? Let's + ;; see if somebody ever ends up in that situation. + (permission-denied nil))) (defvar project--within-roots-fallback nil) commit 60bf6288cf44fe84332141f90baa70a83733552d Author: Stefan Kangas Date: Wed Nov 1 01:39:27 2023 +0100 Respect `browse-url-default-scheme` on Android * lisp/net/browse-url.el (browse-url-default-android-browser): Respect 'browse-url-default-scheme'. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index dfb2243988d..74740af3bd6 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1337,7 +1337,7 @@ browse-url-default-android-browser (setq url (browse-url-encode-url url))) ;; Make sure the URL starts with an appropriate scheme. (unless (string-match "\\(.+\\):/" url) - (setq url (concat "http://" url))) + (setq url (concat browse-url-default-scheme "://" url))) (android-browse-url url browse-url-android-share)) (function-put 'browse-url-default-android-browser commit b93f931e9e96e3f8be004e2631e4aa4db447a642 Author: Stefan Monnier Date: Tue Oct 31 19:20:58 2023 -0400 lisp/emacs-lisp/comp-cstr.el: Fix bootstrap * lisp/emacs-lisp/comp-cstr.el: Remove redundant require of `cl-macs` and add missing require of `cl-extra`. * lisp/emacs-lisp/cl-generic.el: Improve warning message. * lisp/emacs-lisp/cl-extra.el (cl--print-table): Remove redundant arg. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index a89bbc3a748..15be51bd651 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -872,7 +872,7 @@ cl--print-table "%s") formats) (cl-incf col (+ col-space (aref cols i)))) - (let ((format (mapconcat #'identity (nreverse formats) ""))) + (let ((format (mapconcat #'identity (nreverse formats)))) (insert (apply #'format format (mapcar (lambda (str) (propertize str 'face 'italic)) header)) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index dec14bd5df6..5346678dab0 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -272,7 +272,7 @@ cl-defgeneric (list (macroexp-warn-and-return (format "Non-symbol arguments to cl-defgeneric: %s" - (mapconcat #'prin1-to-string nonsymargs "")) + (mapconcat #'prin1-to-string nonsymargs " ")) nil nil nil nonsymargs))))) next-head) (while (progn (setq next-head (car-safe (car options-and-methods))) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index f4c1ac85b13..42ff3e105c0 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -533,7 +533,12 @@ cl-pairlis (unless (load "cl-loaddefs" 'noerror 'quiet) ;; When bootstrapping, cl-loaddefs hasn't been built yet! (require 'cl-macs) - (require 'cl-seq)) + (require 'cl-seq) + ;; FIXME: Arguably we should also load `cl-extra', except that this + ;; currently causes more bootstrap troubles, and `cl-extra' is + ;; rarely used, so instead we explicitly (require 'cl-extra) at + ;; those rare places where we do need it. + ) (defun cl--old-struct-type-of (orig-fun object) (or (and (vectorp object) (> (length object) 0) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 82d48e59a23..70213c9b13c 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -36,7 +36,7 @@ ;;; Code: (require 'cl-lib) -(require 'cl-macs) +(require 'cl-extra) ;HACK: For `cl-find-class' when `cl-loaddefs' is missing. (defconst comp--typeof-builtin-types (mapcar (lambda (x) (append x '(t))) commit c1778432790f140ba8ab942c2cdf7fcb2834188a Author: Michael Albinus Date: Tue Oct 31 17:32:23 2023 +0100 ; * doc/misc/tramp.texi (FUSE setup): Fix typo. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index df966040a1b..0571c91115c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2960,7 +2960,7 @@ FUSE setup @cindex rclone setup The default arguments of the @command{rclone} operations -@command{mount}, @command{coopyto}, @command{moveto} and +@command{mount}, @command{copyto}, @command{moveto} and @command{about} are declared in the variable @code{tramp-methods} as method specific parameters. Usually, they don't need to be overwritten. commit 5f371ca07be891cc41e8e80b8a1bc9ffcc909363 Author: Stefan Monnier Date: Tue Oct 31 12:24:51 2023 -0400 * lisp/emacs-lisp/comp.el: Remove redundant requires diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index bdc59703de9..7fd9543d2ba 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -29,10 +29,7 @@ ;;; Code: (require 'bytecomp) -(require 'cl-extra) (require 'cl-lib) -(require 'cl-macs) -(require 'cl-seq) (require 'gv) (require 'rx) (require 'subr-x) commit 090ac50d79fbba9c6587dfeb3c1ca8264f90c8eb Author: Po Lu Date: Tue Oct 31 21:04:11 2023 +0800 Don't round underline metrics * src/sfntfont.c (sfntfont_open): Don't round underline position or thickness, much as the other font drivers don't either. diff --git a/src/sfntfont.c b/src/sfntfont.c index 822e4b20ee7..80fbde9772c 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -3286,11 +3286,11 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, else { font_info->font.underline_position - = sfnt_coerce_fixed (SFNT_CEIL_FIXED (-desc->underline_position - * font_info->scale)); + = sfnt_coerce_fixed (-desc->underline_position + * font_info->scale); font_info->font.underline_thickness - = sfnt_coerce_fixed (SFNT_CEIL_FIXED (desc->underline_thickness - * font_info->scale)); + = sfnt_coerce_fixed (desc->underline_thickness + * font_info->scale); } /* Now try to set up grid fitting for this font. */ commit d3b0162b8020518e0a8dc7a21f95c20ded317a89 Author: Po Lu Date: Tue Oct 31 18:41:59 2023 +0800 Extract underline positions from PostScript metrics tables * src/sfntfont.c (struct sfnt_font_desc): Introduce fields where the font's underline position is recorded. (sfnt_enum_font_1): Compute the underline position with information in the post table whenever it exists. (sfntfont_open): Scale the recorded position and save it into the font object. diff --git a/src/sfntfont.c b/src/sfntfont.c index 8d87df477ea..822e4b20ee7 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -136,9 +136,6 @@ Copyright (C) 2023 Free Software Foundation, Inc. present in the font. */ Lisp_Object char_cache; - /* Whether or not the character map can't be used by Emacs. */ - bool cmap_invalid; - /* The header of the cmap being used. May be invalid, in which case platform_id will be 500. */ struct sfnt_cmap_encoding_subtable subtable; @@ -146,6 +143,9 @@ Copyright (C) 2023 Free Software Foundation, Inc. /* The offset of the table directory within PATH. */ off_t offset; + /* List of font tables. */ + struct sfnt_font_tables *tables; + /* The number of glyphs in this font. Used to catch invalid cmap tables. This is actually the number of glyphs - 1. */ int num_glyphs; @@ -153,8 +153,15 @@ Copyright (C) 2023 Free Software Foundation, Inc. /* The number of references to the font tables below. */ int refcount; - /* List of font tables. */ - struct sfnt_font_tables *tables; + /* The underline position and thickness if a post table supplies + this information. */ + sfnt_fword underline_position, underline_thickness; + + /* Whether an underline position is available. */ + bool_bf underline_position_set : 1; + + /* Whether or not the character map can't be used by Emacs. */ + bool cmap_invalid : 1; }; /* List of fonts. */ @@ -1050,6 +1057,9 @@ sfnt_enum_font_1 (int fd, const char *file, if (post) { desc->spacing = (post->is_fixed_pitch ? 100 : 0); + desc->underline_position = post->underline_position; + desc->underline_thickness = post->underline_thickness; + desc->underline_position_set = true; xfree (post); } else @@ -3267,8 +3277,21 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, font_info->font.relative_compose = 0; font_info->font.default_ascent = 0; font_info->font.vertical_centering = 0; - font_info->font.underline_position = -1; - font_info->font.underline_thickness = 0; + + if (!desc->underline_position_set) + { + font_info->font.underline_position = -1; + font_info->font.underline_thickness = 0; + } + else + { + font_info->font.underline_position + = sfnt_coerce_fixed (SFNT_CEIL_FIXED (-desc->underline_position + * font_info->scale)); + font_info->font.underline_thickness + = sfnt_coerce_fixed (SFNT_CEIL_FIXED (desc->underline_thickness + * font_info->scale)); + } /* Now try to set up grid fitting for this font. */ dpyinfo = FRAME_DISPLAY_INFO (f); commit dd92ccc7ee12807bbc1c30f0d6576fad738bd104 Author: Juri Linkov Date: Tue Oct 31 09:34:03 2023 +0200 * lisp/progmodes/project.el (project-menu-entry): Add 'bound-and-true-p'. This is needed for compatibility with older versions (bug#66317). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 580394a22ed..ac230bd0b83 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2058,7 +2058,7 @@ project-mode-line :version "30.1") (defvar project-menu-entry - `(menu-item "Project" ,menu-bar-project-menu)) + `(menu-item "Project" ,(bound-and-true-p menu-bar-project-menu))) (defvar project-mode-line-map (let ((map (make-sparse-keymap))) commit dec79825baf9cbd07f9cf5e8533897f53c436a26 Author: Juri Linkov Date: Tue Oct 31 09:22:28 2023 +0200 Fix project-mode-line-format breaking buffer-file-coding-system (bug#66825) * lisp/progmodes/project.el (project-mode-line-format): Let-bind 'last-coding-system-used' to prevent changing 'buffer-file-coding-system' in 'basic-save-buffer'. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index bb44cfefa54..580394a22ed 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2074,14 +2074,21 @@ project-mode-line-format (defun project-mode-line-format () "Compose the project mode-line." (when-let ((project (project-current))) - (concat - " " - (propertize - (project-name project) - 'face project-mode-line-face - 'mouse-face 'mode-line-highlight - 'help-echo "mouse-1: Project menu" - 'local-map project-mode-line-map)))) + ;; Preserve the global value of 'last-coding-system-used' + ;; that 'write-region' needs to set for 'basic-save-buffer', + ;; but updating the mode line might occur at the same time + ;; during saving the buffer and 'project-name' can change + ;; 'last-coding-system-used' when reading the project name + ;; from .dir-locals.el also enables flyspell-mode (bug#66825). + (let ((last-coding-system-used last-coding-system-used)) + (concat + " " + (propertize + (project-name project) + 'face project-mode-line-face + 'mouse-face 'mode-line-highlight + 'help-echo "mouse-1: Project menu" + 'local-map project-mode-line-map))))) (provide 'project) ;;; project.el ends here commit a64336cbb9c95663067da9a2a09a9c281e602161 Author: Stefan Monnier Date: Mon Oct 30 18:50:47 2023 -0400 * lisp/emacs-lisp/cl-lib.el (cl--defalias): Improve&fix docstring diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 96197d43c3d..ac986adc722 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -185,8 +185,7 @@ 'cl--block-throw (defun cl--defalias (cl-f el-f &optional doc) "Define function CL-F as definition EL-F. - -For example, (cl--defalias 'cl-first 'car)." +Like `defalias' but marks the alias itself as inlinable." (defalias cl-f el-f doc) (put cl-f 'byte-optimizer 'byte-compile-inline-expand)) commit 31acbcd405c5bfb3a2d2b1bcde54fbf0d3fe8901 Author: Harald Jörg Date: Mon Oct 30 17:19:42 2023 +0100 ; cperl-mode.el: Obey comment conventions * lisp/progmodes/cperl-mode.el: Use ;;; only for "chapter headings". Eliminate some redundant and misleading comments. Fix an over-wide line. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 1a2ad15f5b2..5b3395b77d2 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2710,7 +2710,7 @@ cperl-look-for-prop (defun cperl-beginning-of-property (p prop &optional lim) "Given that P has a property PROP, find where the property starts. Will not look before LIM." -;;; XXXX What to do at point-max??? +;; XXXX What to do at point-max??? (or (previous-single-property-change (cperl-1+ p) prop lim) (point-min)) ;; (cond ((eq p (point-min)) @@ -3061,7 +3061,7 @@ cperl-calculate-indent (error nil)) (current-column)) ((eq 'indentable (elt i 0)) ; Indenter for REGEXP qw() etc - (cond ;;; [indentable terminator start-pos is-block] + (cond ; [indentable terminator start-pos is-block] ((eq 'terminator (elt i 1)) ; Lone terminator of "indentable string" (goto-char (elt i 2)) ; After opening parens (1- (current-column))) @@ -3948,8 +3948,6 @@ cperl-find-pods-heres "\\|" ;; Second variant: Identifier or \ID (same as 'ID') "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\)" ; 5 + 1, 6 + 1 - ;; Do not have <<= or << 30 or <<30 or << $blah. - ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 "\\)" "\\|" ;; -------- format capture groups 8-9 @@ -4137,20 +4135,10 @@ cperl-find-pods-heres ;; Here document ;; We can do many here-per-line; ;; but multiline quote on the same line as < (point) max) (setq tmpend tb)) (put-text-property b (point) 'syntax-type 'format)) - ;; qq-like String or Regexp: + ;; quotelike operator or regexp: capture groups 10 or 11 + ;; matches some false postives, to be eliminated here ((or (match-beginning 10) (match-beginning 11)) - ;; 1+6+2=9 extra () before this: - ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" - ;; "\\|" - ;; "\\([/<]\\)" ; /blah/ or (setq b1 (if (match-beginning 10) 10 11) argument (buffer-substring (match-beginning b1) (match-end b1)) @@ -4281,13 +4264,23 @@ cperl-find-pods-heres (and (eq (char-syntax (preceding-char)) ?w) (progn (forward-sexp -1) -;; After these keywords `/' starts a RE. One should add all the -;; functions/builtins which expect an argument, but ... + ;; After these keywords `/' + ;; starts a RE. One should + ;; add all the + ;; functions/builtins which + ;; expect an argument, but + ;; ... (and (not (memq (preceding-char) '(?$ ?@ ?& ?%))) (looking-at - "\\(while\\|if\\|unless\\|until\\|for\\(each\\)?\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))) + (regexp-opt + '("while" "if" "unless" + "until" "for" "foreach" + "and" "or" "not" + "xor" "split" "grep" "map" + "print" "say" "return") + 'symbols))))) (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) @@ -4487,12 +4480,13 @@ cperl-find-pods-heres (1- e) e 'face my-cperl-delimiters-face))) (if (and is-REx cperl-regexp-scan) ;; Process RExen: embedded comments, charclasses and ] -;;;/\3333\xFg\x{FFF}a\ppp\PPP\qqq\C\99f(?{ foo })(??{ foo })/; -;;;/a\.b[^a[:ff:]b]x$ab->$[|$,$ab->[cd]->[ef]|$ab[xy].|^${a,b}{c,d}/; -;;;/(?<=foo)(?$[|$,$ab->[cd]->[ef]|$ab[xy].|^${a,b}{c,d}/; + ;;/(?<=foo)(? Date: Sun Oct 29 21:56:54 2023 +0000 Add two docstrings in cl-lib.el * lisp/emacs-lisp/cl-lib.el (cl--set-buffer-substring) (cl--defalias): Add docstrings. (Bug#66828) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 152a1fe9434..96197d43c3d 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -157,6 +157,7 @@ cl-pushnew `(cl-callf2 cl-adjoin ,x ,place ,@keys))) (defun cl--set-buffer-substring (start end val) + "Delete region from START to END and insert VAL." (save-excursion (delete-region start end) (goto-char start) (insert val) @@ -183,6 +184,9 @@ 'cl--block-throw ;; the target form to return the values as a list. (defun cl--defalias (cl-f el-f &optional doc) + "Define function CL-F as definition EL-F. + +For example, (cl--defalias 'cl-first 'car)." (defalias cl-f el-f doc) (put cl-f 'byte-optimizer 'byte-compile-inline-expand)) commit 0d452d61d0542cac710360f92fcb7c4fff92445b Author: Mattias Engdegård Date: Mon Oct 30 11:48:04 2023 +0100 ; * lisp/emacs-lisp/comp-cstr.el (comp-subtype-p): Hoist above use. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index ee0ae10539d..82d48e59a23 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -293,6 +293,14 @@ comp--direct-supertypes (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." + (let ((types (cons type1 type2))) + (or (gethash types (comp-cstr-ctxt-subtype-p-mem comp-ctxt)) + (puthash types + (memq type2 (comp-supertypes type1)) + (comp-cstr-ctxt-subtype-p-mem comp-ctxt))))) + (defun comp--normalize-typeset0 (typeset) ;; For every type search its supertypes. If all the subtypes of a ;; supertype are presents remove all of them, add the identified @@ -373,14 +381,6 @@ comp-supertypes (if above (comp--intersection x above) x))))) finally return above)) -(defsubst comp-subtype-p (type1 type2) - "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise." - (let ((types (cons type1 type2))) - (or (gethash types (comp-cstr-ctxt-subtype-p-mem comp-ctxt)) - (puthash types - (memq type2 (comp-supertypes type1)) - (comp-cstr-ctxt-subtype-p-mem comp-ctxt))))) - (defun comp-union-typesets (&rest typesets) "Union types present into TYPESETS." (or (gethash typesets (comp-cstr-ctxt-union-typesets-mem comp-ctxt)) commit ecc8870981ef1a802f9504b1d0f261d19ab372b1 Author: Po Lu Date: Mon Oct 30 15:32:58 2023 +0800 Ascertain font spacing from post table if present * src/sfnt.c (sfnt_table_names): Introduce name of post table. (sfnt_read_post_table): New function. (main): New tests. * src/sfnt.h (struct sfnt_post_table): New struct. * src/sfntfont.c (sfnt_enum_font_1): Read post table, and set spacing from its is_fixed_pitch value. (sfntfont_list_1): Compare spacing between both fonts if supplied in the font spec. (sfntfont_open): Set FONT_FILE_INDEX as well as FONT_FULLNAME_INDEX. diff --git a/src/sfnt.c b/src/sfnt.c index 7559055e8c2..8ec19290859 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -158,6 +158,7 @@ #define MAX(a, b) ((a) > (b) ? (a) : (b)) [SFNT_TABLE_CVAR] = 0x63766172, [SFNT_TABLE_AVAR] = 0x61766172, [SFNT_TABLE_OS_2] = 0x4f532f32, + [SFNT_TABLE_POST] = 0x706f7374, }; /* Swap values from TrueType to system byte order. */ @@ -15474,6 +15475,69 @@ sfnt_read_OS_2_table (int fd, struct sfnt_offset_subtable *subtable) +/* PostScript metadata retrieval. + + TrueType fonts electively incorporate a table of miscellaneous + information concerning such matters as the underline position or + whether the font is fixed pitch. This table also assigns + human-readable names to glyphs, subject to the table format, but + these names are not read by the functions defined below. */ + +/* Read the header of a post table from the given font FD. Refer to + the table directory SUBTABLE for its location. + + Return the post table header if successful, NULL otherwise. */ + +TEST_STATIC struct sfnt_post_table * +sfnt_read_post_table (int fd, struct sfnt_offset_subtable *subtable) +{ + struct sfnt_post_table *post; + struct sfnt_table_directory *directory; + ssize_t rc; + + /* Search for the post table within SUBTABLE. */ + + directory = sfnt_find_table (subtable, SFNT_TABLE_POST); + + if (!directory) + return NULL; + + /* Although the size of the table is affected by its format, this + function is meant to read only its header; guarantee that the + directory is that large. */ + + if (directory->length < sizeof *post) + return NULL; + + /* Seek to the location given in the directory. */ + if (lseek (fd, directory->offset, SEEK_SET) == (off_t) -1) + return NULL; + + post = xmalloc (sizeof *post); + rc = read (fd, post, sizeof *post); + + if (rc == -1 || rc != sizeof *post) + { + xfree (post); + return NULL; + } + + /* Byte swap the data retrieved. */ + sfnt_swap32 (&post->format); + sfnt_swap32 (&post->italic_angle); + sfnt_swap16 (&post->underline_position); + sfnt_swap16 (&post->underline_thickness); + sfnt_swap32 (&post->is_fixed_pitch); + sfnt_swap32 (&post->min_mem_type_42); + sfnt_swap32 (&post->max_mem_type_42); + sfnt_swap32 (&post->min_mem_type_1); + sfnt_swap32 (&post->max_mem_type_1); + + return post; +} + + + #ifdef TEST struct sfnt_test_dcontext @@ -19359,6 +19423,7 @@ main (int argc, char **argv) struct sfnt_avar_table *avar; struct sfnt_cvar_table *cvar; struct sfnt_OS_2_table *OS_2; + struct sfnt_post_table *post; sfnt_fixed scale; char *fancy; int *advances; @@ -19495,6 +19560,7 @@ #define EASY_PPEM 18 gvar = sfnt_read_gvar_table (fd, font); avar = sfnt_read_avar_table (fd, font); OS_2 = sfnt_read_OS_2_table (fd, font); + post = sfnt_read_post_table (fd, font); cvar = NULL; hmtx = NULL; @@ -19515,6 +19581,17 @@ #define EASY_PPEM 18 fprintf (stderr, "OS/2 table found!\nach_vendor_id: %.4s\n", OS_2->ach_vendor_id); + if (post) + fprintf (stderr, "post table: format: %g; italic-angle: %g;\n" + "underline_position: %"PRIi16"; underline_thickness: %" + PRIi16";\n" + "is_fixed_pitch: %"PRIu32"\n", + sfnt_coerce_fixed (post->format), + sfnt_coerce_fixed (post->italic_angle), + post->underline_position, + post->underline_thickness, + post->is_fixed_pitch); + if (fvar) { fprintf (stderr, "FVAR table found!\n" @@ -20178,6 +20255,7 @@ #define FG sfnt_test_free_glyph xfree (avar); xfree (cvar); xfree (OS_2); + xfree (post); return 0; } diff --git a/src/sfnt.h b/src/sfnt.h index 41c1f6f74e8..f6ab6a6eebd 100644 --- a/src/sfnt.h +++ b/src/sfnt.h @@ -53,6 +53,7 @@ #define _SFNT_H_ SFNT_TABLE_CVAR, SFNT_TABLE_AVAR, SFNT_TABLE_OS_2, + SFNT_TABLE_POST, }; #define SFNT_ENDOF(type, field, type1) \ @@ -1413,6 +1414,45 @@ #define sfnt_coerce_fixed(fixed) ((sfnt_fixed) (fixed) / 65535.0) +/* PostScript metadata. */ + +struct sfnt_post_table +{ + /* Format of this table. This is a fixed point number rather than + an integer. */ + sfnt_fixed format; + + /* Italic angle in degrees. */ + sfnt_fixed italic_angle; + + /* Underline position. */ + sfnt_fword underline_position; + + /* Underline thickness. */ + sfnt_fword underline_thickness; + + /* Whether the font is monospaced. */ + uint32_t is_fixed_pitch; + + /* Minimum memory usage (on a PostScript printer) when a TrueType + font is downloaded as a Type 42 font. */ + uint32_t min_mem_type_42; + + /* Maximum memory usage (on a PostScript printer) when a TrueType + font is downloaded as a Type 42 font. */ + uint32_t max_mem_type_42; + + /* Minimum memory usage (on a PostScript printer) when a TrueType + font is downloaded as a Type 42 font. */ + uint32_t min_mem_type_1; + + /* Maximum memory usage (on a PostScript printer) when a TrueType + font is downloaded as a Type 42 font. */ + uint32_t max_mem_type_1; +}; + + + #define SFNT_CEIL_FIXED(fixed) (((fixed) + 0177777) & 037777600000) #define SFNT_FLOOR_FIXED(fixed) ((fixed) & 037777600000) @@ -1594,6 +1634,14 @@ #define PROTOTYPE int, struct sfnt_offset_subtable * #undef PROTOTYPE + + +#define PROTOTYPE int, struct sfnt_offset_subtable * + +extern struct sfnt_post_table *sfnt_read_post_table (PROTOTYPE); + +#undef PROTOTYPE + #endif /* TEST */ diff --git a/src/sfntfont.c b/src/sfntfont.c index 35b37396ccd..8d87df477ea 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -962,6 +962,7 @@ sfnt_enum_font_1 (int fd, const char *file, struct sfnt_maxp_table *maxp; struct sfnt_fvar_table *fvar; struct sfnt_OS_2_table *OS_2; + struct sfnt_post_table *post; struct sfnt_font_desc temp; Lisp_Object family, style, instance, style1; int i; @@ -1041,12 +1042,25 @@ sfnt_enum_font_1 (int fd, const char *file, if (meta) sfnt_parse_languages (meta, desc); - /* Figure out the spacing. Some fancy test like what Fontconfig - does is probably in order but not really necessary. */ - if (!NILP (Fstring_search (Fdowncase (family), - build_string ("mono"), - Qnil))) - desc->spacing = 100; /* FC_MONO */ + /* Check whether the font claims to be a fixed pitch font and forgo + the rudimentary detection below if so. */ + + post = sfnt_read_post_table (fd, subtables); + + if (post) + { + desc->spacing = (post->is_fixed_pitch ? 100 : 0); + xfree (post); + } + else + { + /* Figure out the spacing. Some fancy test like what Fontconfig + does is probably in order but not really necessary. */ + if (!NILP (Fstring_search (Fdowncase (family), + build_string ("mono"), + Qnil))) + desc->spacing = 100; /* FC_MONO */ + } /* Finally add mac-style flags. Allow them to override styles that have not been found. */ @@ -1654,6 +1668,12 @@ sfntfont_list_1 (struct sfnt_font_desc *desc, Lisp_Object spec, && !sfntfont_registries_compatible_p (tem, desc->registry)) return 0; + /* If the font spacings disagree, reject this font also. */ + + tem = AREF (spec, FONT_SPACING_INDEX); + if (FIXNUMP (tem) && (XFIXNUM (tem) != desc->spacing)) + return 0; + /* Check the style. If DESC is a fixed font, just check once. Otherwise, check each instance. */ @@ -1869,8 +1889,7 @@ sfntfont_desc_to_entity (struct sfnt_font_desc *desc, int instance) /* Size of 0 means the font is scalable. */ ASET (entity, FONT_SIZE_INDEX, make_fixnum (0)); ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); - ASET (entity, FONT_SPACING_INDEX, - make_fixnum (desc->spacing)); + ASET (entity, FONT_SPACING_INDEX, make_fixnum (desc->spacing)); if (instance >= 1) { @@ -3227,8 +3246,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, /* Size of 0 means the font is scalable. */ ASET (font_object, FONT_SIZE_INDEX, make_fixnum (0)); ASET (font_object, FONT_AVGWIDTH_INDEX, make_fixnum (0)); - ASET (font_object, FONT_SPACING_INDEX, - make_fixnum (desc->spacing)); + ASET (font_object, FONT_SPACING_INDEX, make_fixnum (desc->spacing)); /* Set the font style. */ @@ -3354,6 +3372,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, /* And set a reasonable full name, namely the name of the font file. */ font->props[FONT_FULLNAME_INDEX] + = font->props[FONT_FILE_INDEX] = DECODE_FILE (build_unibyte_string (desc->path)); /* All done. */ commit bdec2d2d464919572ae948ba8150e014aa649191 Author: Stefan Monnier Date: Mon Oct 30 00:59:19 2023 -0400 comp-cstr.el: The type hierarchy is a DAG, not a tree Adjust the type operations to account for the fact that types can have several parents. * lisp/emacs-lisp/comp-cstr.el (comp--cl-class-hierarchy): Use `cl--class-allparents`. Add FIXME. (comp--direct-supertype): Declare obsolete. (comp--direct-supertypes): New function. (comp--normalize-typeset0): Rewrite to use `comp--direct-supertypes`; adjust to account for the DAG structure; use `cl-set-difference`. (comp--direct-subtypes): Rewrite. (comp--intersection): New function. (comp-supertypes): Rewrite and change return type. (comp-subtype-p): Simplify. (comp-union-typesets): Use `comp-supertypes` instead of iterating over `comp-cstr-ctxt-typeof-types`. * lisp/emacs-lisp/comp.el (comp--native-compile): Don't catch errors if we're debugging. * test/lisp/emacs-lisp/comp-cstr-tests.el: Adjust tests. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Fix mishap when we evaluate (cl-defstruct cl-structure-object ..) during the compilation of `cl-preloaded.el`. * lisp/emacs-lisp/cl-preloaded.el: Add corresponding assertion. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 722d561b9f4..a4a241d9c63 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3092,7 +3092,11 @@ cl-defstruct descs))) (t (error "Structure option %s unrecognized" opt))))) - (unless (or include-name type) + (unless (or include-name type + ;; Don't create a bogus parent to `cl-structure-object' + ;; while compiling the (cl-defstruct cl-structure-object ..) + ;; in `cl-preloaded.el'. + (eq name cl--struct-default-parent)) (setq include-name cl--struct-default-parent)) (when include-name (setq include (cl--struct-get-class include-name))) (if print-func @@ -3331,7 +3335,7 @@ cl-defstruct ;;; Add cl-struct support to pcase ;;In use by comp.el -(defun cl--struct-all-parents (class) +(defun cl--struct-all-parents (class) ;FIXME: Merge with `cl--class-allparents' (when (cl--struct-class-p class) (let ((res ()) (classes (list class))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 27603ae8626..03068639575 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -333,6 +333,9 @@ cl--class-allparents (cl--class-parents class))))) (nreverse parents))) +(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. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index d23304c8874..ee0ae10539d 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -89,8 +89,10 @@ comp-cstr-f (defun comp--cl-class-hierarchy (x) "Given a class name `x' return its hierarchy." - `(,@(mapcar #'cl--struct-class-name (cl--struct-all-parents - (cl--struct-get-class x))) + `(,@(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)) @@ -267,8 +269,9 @@ comp--sym-lessp (string-lessp (symbol-name x) (symbol-name y))) -(defun comp--direct-supertype (type) +(defun comp--direct-supertype (type) ;FIXME: There can be several! "Return the direct supertype of TYPE." + (declare (obsolete comp--direct-supertype "30.1")) (cl-loop named outer for i in (comp-cstr-ctxt-typeof-types comp-ctxt) @@ -276,24 +279,50 @@ comp--direct-supertype when (eq j type) do (cl-return-from outer 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))) + (defun comp--normalize-typeset0 (typeset) - ;; For every type search its supertype. If all the subtypes of that + ;; For every type search its supertypes. If all the subtypes of a ;; supertype are presents remove all of them, add the identified ;; supertype and restart. + ;; FIXME: The intention is to return a 100% equivalent but simpler + ;; typeset, but this is only the case when the supertype is abstract + ;; and "final/closed" (i.e. can't have new subtypes). (when typeset (while (eq 'restart (cl-loop named main - for i in typeset - for sup = (comp--direct-supertype i) + for sup in (cl-remove-duplicates + (apply #'append + (mapcar #'comp--direct-supertypes typeset))) for subs = (comp--direct-subtypes sup) - when (and sup - (length> subs 1) - (cl-every (lambda (x) (member x typeset)) subs)) - do (cl-loop for s in subs - do (setq typeset (cl-delete s typeset)) - finally (progn (push sup typeset) - (cl-return-from main 'restart)))))) + 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'. + (cl-every (lambda (sub) + (cl-some (lambda (type) + (comp-subtype-p sub type)) + typeset)) + subs)) + do (progn + (setq typeset (cons sup (cl-set-difference typeset subs))) + (cl-return-from main 'restart))))) typeset)) (defun comp-normalize-typeset (typeset) @@ -303,56 +332,53 @@ comp-normalize-typeset (defun comp--direct-subtypes (type) "Return all the direct subtypes of TYPE." ;; TODO: memoize. - (cl-sort - (cl-loop for j in (comp-cstr-ctxt-typeof-types comp-ctxt) - for res = (cl-loop for i in j - with last = nil - when (eq i type) - return last - do (setq last i)) - when res - collect res) - #'comp--sym-lessp)) + (let ((subtypes ())) + (dolist (j (comp-cstr-ctxt-typeof-types comp-ctxt)) + (let ((occur (memq type j))) + (when occur + (while (not (eq j occur)) + (let ((candidate (pop j))) + (when (and (not (memq candidate subtypes)) + (memq type (comp--direct-supertypes candidate))) + (push candidate subtypes))))))) + (cl-sort subtypes #'comp--sym-lessp))) + +(defun comp--intersection (list1 list2) + "Like `cl-intersection` but preserves the order of one of its args." + (if (equal list1 list2) list1 + (let ((res nil)) + (while list2 + (if (memq (car list2) list1) + (push (car list2) res)) + (pop list2)) + (nreverse res)))) (defun comp-supertypes (type) - "Return a list of pairs (supertype . hierarchy-level) for 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 outer - with found = nil - for l in (comp-cstr-ctxt-typeof-types comp-ctxt) - do (cl-loop - for x in l - for i from (length l) downto 0 - when (eq type x) - do (setf found t) - when found - collect `(,x . ,i) into res - finally (when found - (cl-return-from outer res))))) - -(defun comp-common-supertype-2 (type1 type2) - "Return the first common supertype of TYPE1 TYPE2." - (when-let ((types (cl-intersection - (comp-supertypes type1) - (comp-supertypes type2) - :key #'car))) - (car (cl-reduce (lambda (x y) - (if (> (cdr x) (cdr y)) x y)) - types)))) - -(defun comp-common-supertype (&rest types) - "Return the first common supertype of TYPES." - (or (gethash types (comp-cstr-ctxt-common-supertype-mem comp-ctxt)) - (puthash types - (cl-reduce #'comp-common-supertype-2 types) - (comp-cstr-ctxt-common-supertype-mem comp-ctxt)))) + 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)) (defsubst comp-subtype-p (type1 type2) "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise." (let ((types (cons type1 type2))) (or (gethash types (comp-cstr-ctxt-subtype-p-mem comp-ctxt)) (puthash types - (eq (comp-common-supertype-2 type1 type2) type2) + (memq type2 (comp-supertypes type1)) (comp-cstr-ctxt-subtype-p-mem comp-ctxt))))) (defun comp-union-typesets (&rest typesets) @@ -360,16 +386,18 @@ comp-union-typesets (or (gethash typesets (comp-cstr-ctxt-union-typesets-mem comp-ctxt)) (puthash typesets (cl-loop - with types = (apply #'append typesets) + ;; List of (TYPE . SUPERTYPES)", ordered from + ;; "most general" to "least general" + with typess = (sort (mapcar #'comp-supertypes + (apply #'append typesets)) + (lambda (l1 l2) + (<= (length l1) (length l2)))) with res = '() - for lane in (comp-cstr-ctxt-typeof-types comp-ctxt) - do (cl-loop - with last = nil - for x in lane - when (memq x types) - do (setf last x) - finally (when last - (push last res))) + for types in typess + ;; Don't keep this type if it's a subtype of one of + ;; the other types. + unless (comp--intersection types res) + do (push (car types) res) finally return (comp-normalize-typeset res)) (comp-cstr-ctxt-union-typesets-mem comp-ctxt)))) @@ -863,7 +891,7 @@ comp-cstr-intersection-no-mem (comp-subtype-p neg-type pos-type)) do (cl-loop with found - for (type . _) in (comp-supertypes neg-type) + for type in (comp-supertypes neg-type) when found collect type into res when (eq type pos-type) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 181e5ca96a1..bdc59703de9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4180,7 +4180,7 @@ comp--native-compile (comp-log "\n \n" 1) (unwind-protect (progn - (condition-case err + (condition-case-unless-debug err (cl-loop with report = nil for t0 = (current-time) @@ -4199,7 +4199,8 @@ comp--native-compile (comp-log (format "Done compiling %s" data) 0) (cl-loop for (pass . time) in (reverse report) do (comp-log (format "Pass %s took: %fs." - pass time) 0)))) + pass time) + 0)))) (native-compiler-skip) (t (let ((err-val (cdr err))) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index d2f552af6fa..cbedce0c47d 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -42,14 +42,14 @@ ',expected-type-spec)))) (defconst comp-cstr-typespec-tests-alist - `(;; 1 + '(;; 1 (symbol . symbol) ;; 2 ((or string array) . array) ;; 3 ((or symbol number) . (or number symbol)) ;; 4 - ((or cons atom) . (or atom cons)) ;; SBCL return T + ((or cons atom) . t) ;; SBCL return T ;; 5 ((or integer number) . number) ;; 6 @@ -219,14 +219,18 @@ ;; 88 ((and (or (member a b c)) (not (or (member a b)))) . (member c)) ;; 89 - ((or cons symbol) . list) + ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'? ;; 90 ((or string char-table bool-vector vector) . array) ;; 91 ((or string char-table bool-vector vector number) . (or array number)) ;; 92 ((or string char-table bool-vector vector cons symbol number) . - (or number sequence))) + (or number sequence symbol)) + ;; 93? + ;; FIXME: I get `cons' rather than `list'? + ;;((or null cons) . list) + ) "Alist type specifier -> expected type specifier.")) (defmacro comp-cstr-synthesize-tests () commit 271d8b70f8d772807484454d3369f515fdff350a Author: Jim Porter Date: Sat Oct 28 22:20:41 2023 -0700 Exclude Git submodules from 'project-files' * lisp/progmodes/project.el (project--vc-list-files): Exclude Git submodules (bug#66806). (project-search, project-query-replace-regexp): Remove now-unneeded workaround. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index fda1081eb62..bb44cfefa54 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -647,6 +647,7 @@ project--vc-list-files (include-untracked (project--value-in-dir 'project-vc-include-untracked dir)) + (submodules (project--git-submodules)) files) (setq args (append args '("-c" "--exclude-standard") @@ -678,23 +679,25 @@ project--vc-list-files i))) extra-ignores))))) (setq files - (mapcar - (lambda (file) (concat default-directory file)) - (split-string - (apply #'vc-git--run-command-string nil "ls-files" args) - "\0" t))) + (delq nil + (mapcar + (lambda (file) + (unless (member file submodules) + (concat default-directory file))) + (split-string + (apply #'vc-git--run-command-string nil "ls-files" args) + "\0" t)))) (when (project--vc-merge-submodules-p default-directory) ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. - (let* ((submodules (project--git-submodules)) - (sub-files - (mapcar - (lambda (module) - (when (file-directory-p module) - (project--vc-list-files - (concat default-directory module) - backend - extra-ignores))) - submodules))) + (let ((sub-files + (mapcar + (lambda (module) + (when (file-directory-p module) + (project--vc-list-files + (concat default-directory module) + backend + extra-ignores))) + submodules))) (setq files (apply #'nconc files sub-files)))) ;; 'git ls-files' returns duplicate entries for merge conflicts. @@ -1326,8 +1329,7 @@ project-search (interactive "sSearch (regexp): ") (fileloop-initialize-search regexp - ;; XXX: See the comment in project-query-replace-regexp. - (cl-delete-if-not #'file-regular-p (project-files (project-current t))) + (project-files (project-current t)) 'default) (fileloop-continue)) @@ -1348,10 +1350,7 @@ project-query-replace-regexp (list from to)))) (fileloop-initialize-replace from to - ;; XXX: Filter out Git submodules, which are not regular files. - ;; `project-files' can return those, which is arguably suboptimal, - ;; but removing them eagerly has performance cost. - (cl-delete-if-not #'file-regular-p (project-files (project-current t))) + (project-files (project-current t)) 'default) (fileloop-continue)) commit 1eae0e7edf485bdaa9fb76b905275cf08a1910e2 Author: Spencer Baugh Date: Sat Oct 21 14:35:53 2023 -0400 Teach ffap to look for relative file names under project-root Now file-name-at-point-functions, which runs ffap-guess-file-name-at-point, will pick up on a file name at point if that file name is a relative file name which exists when looked up from the root of the project. For example, in test/lisp/progmodes/eglot-tests.el there is the string lisp/progmodes/eglot.el; if you put point on that and C-x C-f, lisp/progmodes/eglot.el under the root of the Emacs repo will now be part of future history. * lisp/ffap.el (ffap-alist): Add entry for ffap-in-project. (ffap-in-project): Add. (bug#66668) diff --git a/lisp/ffap.el b/lisp/ffap.el index 942e218bf23..530e3da182e 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -730,6 +730,7 @@ ffap-locate-file (defvar ffap-alist '( ("" . ffap-completable) ; completion, slow on some systems + ("" . ffap-in-project) ; maybe in the root of the project ("\\.info\\'" . ffap-info) ; gzip.info ("\\`info/" . ffap-info-2) ; info/emacs ("\\`[-[:lower:]]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses] @@ -793,6 +794,11 @@ ffap-completable (cmp (file-name-completion (file-name-nondirectory name) dir))) (and cmp (concat dir cmp)))) +(declare-function project-root "project" (project)) +(defun ffap-in-project (name) + (when-let (project (project-current)) + (file-name-concat (project-root project) name))) + (defun ffap-home (name) (ffap-locate-file name t '("~"))) (defun ffap-info (name) commit b27e2bbb347c981ad12e05161d2bee195d110dd4 Author: Stefan Monnier Date: Sun Oct 29 14:12:22 2023 -0400 Use OClosure to drop `advice--buffer-local-function-sample` hack * lisp/emacs-lisp/nadvice.el (advice--forward): New OClosure, to replace `advice--buffer-local-function-sample`. (advice--set-buffer-local, advice--buffer-local): Adjust accordingly. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index cd80df2c41d..ce5467f3c5c 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -292,14 +292,13 @@ advice--remove-function (equal function (cdr (assq 'name props)))) (list (advice--remove-function rest function))))))) -(defvar advice--buffer-local-function-sample nil - "Keeps an example of the special \"run the default value\" functions. -These functions play the same role as t in buffer-local hooks, and to recognize -them, we keep a sample here against which to compare. Each instance is -different, but `function-equal' will hopefully ignore those differences.") +(oclosure-define (advice--forward + (:predicate advice--forward-p)) + "Redirect to the global value of a var. +These functions act like the t special value in buffer-local hooks.") (defun advice--set-buffer-local (var val) - (if (function-equal val advice--buffer-local-function-sample) + (if (advice--forward-p val) (kill-local-variable var) (set (make-local-variable var) val))) @@ -308,11 +307,10 @@ advice--buffer-local "Buffer-local value of VAR, presumed to contain a function." (declare (gv-setter advice--set-buffer-local)) (if (local-variable-p var) (symbol-value var) - (setq advice--buffer-local-function-sample - ;; This function acts like the t special value in buffer-local hooks. - ;; FIXME: Provide an `advice-bottom' function that's like - ;; `advice-cd*r' but also follows through this proxy. - (lambda (&rest args) (apply (default-value var) args))))) + ;; FIXME: Provide an `advice-bottom' function that's like + ;; `advice--cd*r' but also follows through this proxy. + (oclosure-lambda (advice--forward) (&rest args) + (apply (default-value var) args)))) (eval-and-compile (defun advice--normalize-place (place) commit 99d4d65cc2cd98537ef58afeace81a11ad2ff6c2 Author: Stefan Monnier Date: Sun Oct 29 14:07:04 2023 -0400 Require `cl-lib` rather than directly some of its subfiles * test/src/filelock-tests.el: * lisp/net/tramp-sh.el: Require `cl-lib` rather than `cl-seq` or `cl-macs`. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ba6dbdf0c39..49acf8395c5 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -31,8 +31,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) -(require 'cl-seq) +(require 'cl-lib) (require 'tramp) ;; `dired-*' declarations can be removed, starting with Emacs 29.1. diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index f4376b2a5b0..f4ae7192796 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -26,7 +26,7 @@ ;;; Code: -(require 'cl-macs) +(require 'cl-lib) (require 'ert) (require 'ert-x) (require 'seq) commit 67977ae5974e54d34034aa7990cf22dd162c179b Author: Mattias Engdegård Date: Thu Oct 5 14:06:24 2023 +0200 Eliminate some nested repetitions in regexps Nested repetitions such as (A*)* potentially take exponential time but can usually be rewritten in a faster and more readable way without much trouble. These were all found by Relint. * lisp/obsolete/terminal.el (te-parse-program-and-args): * lisp/org/org.el (org-make-tags-matcher): Apply the transform (A+B*)+ -> A(A|B)* * lisp/textmodes/fill.el (adaptive-fill-regexp): Apply the transform A*(B+A*)* -> (A|B)* * lisp/progmodes/idlw-shell.el (idlwave-shell-filter): Find the last newline or CR in a more direct way. * lisp/progmodes/vhdl-mode.el (vhdl-port-copy, vhdl-subprog-copy): Trim trailing whitespace from a string in a more direct way. All-whitespace strings are left unchanged as before. diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el index 4e23fc3c710..31c1ebead14 100644 --- a/lisp/obsolete/terminal.el +++ b/lisp/obsolete/terminal.el @@ -1154,7 +1154,7 @@ terminal-emulator (defun te-parse-program-and-args (s) - (cond ((string-match "\\`\\([-a-zA-Z0-9+=_.@/:]+[ \t]*\\)+\\'" s) + (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:][-a-zA-Z0-9+=_.@/: \t]*\\'" s) (let ((l ()) (p 0)) (while p (setq l (cons (if (string-match diff --git a/lisp/org/org.el b/lisp/org/org.el index 8b02721a859..49f62d0f43b 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -11346,7 +11346,7 @@ org-make-tags-matcher (let ((match0 match) (re (concat "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)" - "\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)" + "\\([0-9]+\\)\\|\\([[:alnum:]_]\\(?:[[:alnum:]_]\\|\\\\-\\)*\\)" "\\([<>=]\\{1,2\\}\\)" "\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)" "\\|" org-tag-re "\\)")) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index e50e1226b43..37c501ae4e2 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1454,9 +1454,7 @@ idlwave-shell-filter (concat idlwave-shell-accumulation string))) (setq idlwave-shell-accumulation (substring string - (progn (string-match "\\(.*[\n\r]+\\)*" - string) - (match-end 0))))) + (string-match "[^\n\r]*\\'" string)))) (setq idlwave-shell-accumulation (concat idlwave-shell-accumulation string))) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 8d0a10c0918..b55fae3374a 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -11769,8 +11769,8 @@ vhdl-port-copy (setq comment (substring type (match-beginning 2))) (setq type (substring type 0 (match-beginning 1)))) ;; strip of trailing group-comment - (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) - (setq type (substring type 0 (match-end 1))) + (when (string-match "\\S-\\s-*\\'" type) + (setq type (substring type 0 (1+ (match-beginning 0))))) ;; parse initialization expression (setq init nil) (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) @@ -11844,8 +11844,8 @@ vhdl-port-copy (setq comment (substring type (match-beginning 2))) (setq type (substring type 0 (match-beginning 1)))) ;; strip of trailing group-comment - (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) - (setq type (substring type 0 (match-end 1))) + (when (string-match "\\S-\\s-*\\'" type) + (setq type (substring type 0 (1+ (match-beginning 0))))) (vhdl-forward-syntactic-ws) (setq end-of-list (vhdl-parse-string ")" t)) (vhdl-parse-string "\\s-*;\\s-*") @@ -12580,8 +12580,8 @@ vhdl-subprog-copy (setq comment (substring type (match-beginning 2))) (setq type (substring type 0 (match-beginning 1)))) ;; strip off trailing group-comment - (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) - (setq type (substring type 0 (match-end 1))) + (when (string-match "\\S-\\s-*\\'" type) + (setq type (substring type 0 (1+ (match-beginning 0))))) ;; parse initialization expression (setq init nil) (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) @@ -12621,8 +12621,9 @@ vhdl-subprog-copy (setq return-comment (substring return-type (match-beginning 2))) (setq return-type (substring return-type 0 (match-beginning 1)))) ;; strip of trailing group-comment - (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type) - (setq return-type (substring return-type 0 (match-end 1))) + (when (string-match "\\S-\\s-*\\'" return-type) + (setq return-type + (substring return-type 0 (1+ (match-beginning 0))))) ;; parse return comment (unless return-comment (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 2fde2ff6c4d..4d6c73bfdd6 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -103,7 +103,7 @@ adaptive-fill-regexp ;; Added `%' for TeX comments. ;; RMS: deleted the code to match `1.' and `(1)'. ;; Update mail-mode's paragraph-separate if you change this. - (purecopy "[ \t]*\\([-–!|#%;>*·•‣⁃◦]+[ \t]*\\)*") + (purecopy "[-–!|#%;>*·•‣⁃◦ \t]*") "Regexp to match text at start of line that constitutes indentation. If Adaptive Fill mode is enabled, a prefix matching this pattern on the first and second lines of a paragraph is used as the commit 7e47d88499f3296eb314a12f483292d9154307de Author: Mattias Engdegård Date: Sun Oct 29 17:16:35 2023 +0100 Fix broken gdb-control-commands-regexp (bug#66363) * lisp/progmodes/gdb-mi.el (gdb-python-guile-commands-regexp): Remove, integrate into... (gdb-control-commands-regexp): ...this. Translate into rx. Remove useless submatches which broke earlier attempts at using other submatches. Rewrite tail expression to avoid superlinear nested repetition, eliminating a Relint complaint. * lisp/progmodes/gdb-mi.el (gdb-send): Simplify use of the regexp above, and use the correct submatch this time. Remove unnecessary and incorrect second regexp matching. diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index bc0070d2630..3afdc59a67e 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1960,19 +1960,23 @@ breakpoint-disabled :group 'gdb) -(defvar gdb-python-guile-commands-regexp - "python\\|python-interactive\\|pi\\|guile\\|guile-repl\\|gr" - "Regexp that matches Python and Guile commands supported by GDB.") - (defvar gdb-control-commands-regexp - (concat - "^\\(" - "comm\\(a\\(n\\(ds?\\)?\\)?\\)?\\|if\\|while" - "\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|" - gdb-python-guile-commands-regexp - "\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions" - "\\|expl\\(o\\(re?\\)?\\)?" - "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)*$") + (rx bol + (or + (or "comm" "comma" "comman" "command" "commands" + "if" "while" + "def" "defi" "defin" "define" + "doc" "docu" "docum" "docume" "documen" "document" + "while-stepping" + "stepp" "steppi" "steppin" "stepping" + "ws" "actions" + "expl" "explo" "explor" "explore") + (group ; group 1: Python and Guile commands + (or "python" "python-interactive" "pi" "guile" "guile-repl" "gr"))) + (? (+ blank) + (group ; group 2: command arguments + (* nonl))) + eol) "Regexp matching GDB commands that enter a recursive reading loop. As long as GDB is in the recursive reading loop, it does not expect commands to be prefixed by \"-interpreter-exec console\".") @@ -2032,15 +2036,13 @@ gdb-send (setq gdb-continuation nil))) ;; Python and Guile commands that have an argument don't enter the ;; recursive reading loop. - (let* ((control-command-p (string-match gdb-control-commands-regexp string)) - (command-arg (and control-command-p (match-string 3 string))) - (python-or-guile-p (string-match gdb-python-guile-commands-regexp - string))) - (if (and control-command-p - (or (not python-or-guile-p) - (null command-arg) - (zerop (length command-arg)))) - (setq gdb-control-level (1+ gdb-control-level))))) + (when (string-match gdb-control-commands-regexp string) + (let ((python-or-guile-p (match-beginning 1)) + (command-arg (match-string 2 string))) + (when (or (not python-or-guile-p) + (null command-arg) + (zerop (length command-arg))) + (setq gdb-control-level (1+ gdb-control-level)))))) (defun gdb-mi-quote (string) "Return STRING quoted properly as an MI argument. commit c71c949618dba7a371f94a8f0d1668e717c69fb2 Author: Michael Albinus Date: Sun Oct 29 15:29:32 2023 +0100 ; Fix typo in tramp.texi diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 1853886596a..2f2c166cf8c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -6096,7 +6096,7 @@ Traces and Profiles @item @w{ 0} Silent (no @value{tramp} messages at all) @item @w{ 1} Errors @item @w{ 2} Warnings -@item @w{ 3} Connectioncccc to remote hosts (default verbosity) +@item @w{ 3} Connection to remote hosts (default verbosity) @item @w{ 4} Activities @item @w{ 5} Internal @item @w{ 6} Sent and received strings commit 4a579e047124fe1dbf24ee712f4debb47e357b8b Merge: 3d25a9fccfa 3bc09227002 Author: Michael Albinus Date: Sun Oct 29 15:28:11 2023 +0100 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 3bc092270027660a4edbbb8c5a4e5a37f114076c Author: Stefan Kangas Date: Sun Oct 29 14:06:32 2023 +0100 Make nnrss suggest HTTPS instead of HTTP * lisp/gnus/nnrss.el (nnrss-check-group): Suggest HTTPS instead of HTTP when prompting for URL. diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index c5f2cb672d7..06a0bc7e799 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -629,7 +629,7 @@ nnrss-check-group (assoc 'href (nnrss-discover-feed (read-string - (format "URL to search for %s: " group) "http://"))))) + (format "URL to search for %s: " group) "https://"))))) (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcdr (cdr pair) (list url)) commit cb86120272042df9420a726b3a754d58f300f350 Author: Eli Zaretskii Date: Sun Oct 29 14:19:39 2023 +0200 ; Fix documentation of last change * etc/NEWS: * doc/emacs/misc.texi (emacsclient Options): Fix wording. (Bug#65902) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 9c7c5dcd5da..d3c5712099d 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2079,13 +2079,16 @@ emacsclient Options evaluate, @emph{not} as a list of files to visit. @vindex server-eval-args-left -If you have arbitrary data which you want to provide as input to one -of your expressions, you can pass the data as another argument to -@command{emacsclient} and use @var{server-eval-args-left} in the -expression to access the data. Be careful to have your expression -remove the data from @var{server-eval-args-left} regardless of whether -your code succeeds, such as by using @code{pop}, otherwise Emacs will -attempt to evaluate the data as a Lisp expression. +Passing complex Lisp expression via the @option{--eval} command-line +option sometimes requires elaborate escaping of characters special to +the shell. To avoid this, you can pass arguments to Lisp functions in +your expression as additional separate arguments to +@command{emacsclient}, and use @var{server-eval-args-left} in the +expression to access those arguments. Be careful to have your +expression remove the processed arguments from +@var{server-eval-args-left} regardless of whether your code succeeds, +for example by using @code{pop}, otherwise Emacs will attempt to +evaluate those arguments as separate Lisp expressions. @item -f @var{server-file} @itemx --server-file=@var{server-file} diff --git a/etc/NEWS b/etc/NEWS index 84a03495798..9c0f28e3fa9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -236,12 +236,13 @@ displayed on the mode line when 'appt-display-mode-line' is non-nil. ** Emacs Server and Client --- -*** 'server-eval-args-left' can be used to pop subsequent eval args +*** 'server-eval-args-left' can be used to pop and eval subsequent args. When '--eval' is passed to emacsclient and Emacs is evaluating each -argument, this variable is set to those which have not yet been -evaluated. It can be used to 'pop' arguments to prevent them from -being evaluated, which is useful when those arguments contain -arbitrary data. +argument, this variable is set to those arguments not yet evaluated. +It can be used to 'pop' arguments and process them by the function +called in the '--eval' expression, which is useful when those +arguments contain arbitrary characters that otherwise might require +elaborate and error-prone escaping (to protect them from the shell). * Editing Changes in Emacs 30.1 commit 683efb8de5ac3a2ba5ecc073d8c912ec6a61191d Author: Spencer Baugh Date: Thu Sep 21 21:35:50 2023 -0400 Add 'server-eval-args-left' to server.el Passing arbitrary arguments to functions through "emacsclient --eval" sometimes requires complicated escaping to avoid them being parsed as Lisp (as seen in emacsclient-mail.desktop before this change). The new variable 'server-eval-args-left' allows access to the arguments before they are parsed as Lisp. By removing arguments from the variable before they're parsed, a snippet of Lisp can consume arguments, as in emacsclient-mail.desktop. org-protocol might be able to use this as well, which might allow it to drop its current advice on server-visit-files. * etc/emacsclient-mail.desktop: Use 'server-eval-args-left'. * lisp/server.el (server-eval-args-left): New variable. (server-process-filter, server-execute): Make '-eval' arguments available through 'server-eval-args-left'. * lisp/startup.el (argv): Mention 'server-eval-args-left' in docstring. * etc/NEWS: Announce 'server-eval-args-left'. * doc/emacs/misc.texi (emacsclient Options): Document 'server-eval-args-left'. (Bug#65902) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index d7168fa1ca0..9c7c5dcd5da 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2078,6 +2078,15 @@ emacsclient Options @command{emacsclient} are interpreted as a list of expressions to evaluate, @emph{not} as a list of files to visit. +@vindex server-eval-args-left +If you have arbitrary data which you want to provide as input to one +of your expressions, you can pass the data as another argument to +@command{emacsclient} and use @var{server-eval-args-left} in the +expression to access the data. Be careful to have your expression +remove the data from @var{server-eval-args-left} regardless of whether +your code succeeds, such as by using @code{pop}, otherwise Emacs will +attempt to evaluate the data as a Lisp expression. + @item -f @var{server-file} @itemx --server-file=@var{server-file} Specify a server file (@pxref{TCP Emacs server}) for connecting to an diff --git a/etc/NEWS b/etc/NEWS index 8ae7b89e830..84a03495798 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -233,6 +233,16 @@ to enter the file you want to modify. It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. +** Emacs Server and Client + +--- +*** 'server-eval-args-left' can be used to pop subsequent eval args +When '--eval' is passed to emacsclient and Emacs is evaluating each +argument, this variable is set to those which have not yet been +evaluated. It can be used to 'pop' arguments to prevent them from +being evaluated, which is useful when those arguments contain +arbitrary data. + * Editing Changes in Emacs 30.1 diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop index 0a2420ddead..4f7f00ebefd 100644 --- a/etc/emacsclient-mail.desktop +++ b/etc/emacsclient-mail.desktop @@ -1,10 +1,7 @@ [Desktop Entry] Categories=Network;Email; Comment=GNU Emacs is an extensible, customizable text editor - and more -# We want to pass the following commands to the shell wrapper: -# u=$(echo "$1" | sed 's/[\"]/\\&/g'); exec emacsclient --alternate-editor= --display="$DISPLAY" --eval "(message-mailto \"$u\")" -# Special chars '"', '$', and '\' must be escaped as '\\"', '\\$', and '\\\\'. -Exec=sh -c "u=\\$(echo \\"\\$1\\" | sed 's/[\\\\\\"]/\\\\\\\\&/g'); exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\"" sh %u +Exec=emacsclient --alternate-editor= --eval "(message-mailto (pop server-eval-args-left))" %u Icon=emacs Name=Emacs (Mail, Client) MimeType=x-scheme-handler/mailto; @@ -16,7 +13,7 @@ Actions=new-window;new-instance; [Desktop Action new-window] Name=New Window -Exec=sh -c "u=\\$(echo \\"\\$1\\" | sed 's/[\\\\\\"]/\\\\\\\\&/g'); exec emacsclient --alternate-editor= --create-frame --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\"" sh %u +Exec=emacsclient --alternate-editor= --create-frame --eval "(message-mailto (pop server-eval-args-left))" %u [Desktop Action new-instance] Name=New Instance diff --git a/lisp/server.el b/lisp/server.el index ce68e9aebc9..a2671165bfc 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1199,6 +1199,7 @@ server-process-filter parent-id ; Window ID for XEmbed dontkill ; t if client should not be killed. commands + evalexprs dir use-current-frame frame-parameters ;parameters for newly created frame @@ -1332,8 +1333,7 @@ server-process-filter (let ((expr (pop args-left))) (if coding-system (setq expr (decode-coding-string expr coding-system))) - (push (lambda () (server-eval-and-print expr proc)) - commands) + (push expr evalexprs) (setq filepos nil))) ;; -env NAME=VALUE: An environment variable. @@ -1358,7 +1358,7 @@ server-process-filter ;; arguments, use an existing frame. (and nowait (not (eq tty-name 'window-system)) - (or files commands) + (or files commands evalexprs) (setq use-current-frame t)) (setq frame @@ -1407,7 +1407,7 @@ server-process-filter (let ((default-directory (if (and dir (file-directory-p dir)) dir default-directory))) - (server-execute proc files nowait commands + (server-execute proc files nowait commands evalexprs dontkill frame tty-name))))) (when (or frame files) @@ -1417,22 +1417,35 @@ server-process-filter ;; condition-case (t (server-return-error proc err)))) -(defun server-execute (proc files nowait commands dontkill frame tty-name) +(defvar server-eval-args-left nil + "List of eval args not yet processed. + +Adding or removing strings from this variable while the Emacs +server is processing a series of eval requests will affect what +Emacs evaluates. + +See also `argv' for a similar variable which works for +invocations of \"emacs\".") + +(defun server-execute (proc files nowait commands evalexprs dontkill frame tty-name) ;; This is run from timers and process-filters, i.e. "asynchronously". ;; But w.r.t the user, this is not really asynchronous since the timer ;; is run after 0s and the process-filter is run in response to the ;; user running `emacsclient'. So it is OK to override the - ;; inhibit-quit flag, which is good since `commands' (as well as + ;; inhibit-quit flag, which is good since `evalexprs' (as well as ;; find-file-noselect via the major-mode) can run arbitrary code, ;; including code that needs to wait. (with-local-quit (condition-case err (let ((buffers (server-visit-files files proc nowait))) (mapc 'funcall (nreverse commands)) + (let ((server-eval-args-left (nreverse evalexprs))) + (while server-eval-args-left + (server-eval-and-print (pop server-eval-args-left) proc))) ;; If we were told only to open a new client, obey ;; `initial-buffer-choice' if it specifies a file ;; or a function. - (unless (or files commands) + (unless (or files commands evalexprs) (let ((buf (cond ((stringp initial-buffer-choice) (find-file-noselect initial-buffer-choice)) diff --git a/lisp/startup.el b/lisp/startup.el index 6329e3ea8d0..37843eab176 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -120,7 +120,10 @@ command-switch-alist "List of command-line args not yet processed. This is a convenience alias, so that one can write (pop argv) inside of --eval command line arguments in order to access -following arguments.")) +following arguments. + +See also `server-eval-args-left' for a similar variable which +works for invocations of \"emacsclient --eval\".")) (internal-make-var-non-special 'argv) (defvar command-line-args-left nil commit f3a27180b7b22e8220f9d92d91ece835545da4aa Author: Eli Zaretskii Date: Sun Oct 29 14:06:29 2023 +0200 ; Fix a recent change in documentation of 'selection-coding-system' * doc/lispref/frames.texi (Window System Selections): Fix description of the effect of 'selection-coding-system' on MS-Windows and MS-DOS. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index fc36346f773..6193a4fe1cd 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4058,20 +4058,29 @@ Window System Selections @defopt selection-coding-system This variable provides a coding system (@pxref{Coding Systems}) which -is used to encode selection data, and takes effect on MS-DOS, -MS-Windows and X@. - -Under MS-DOS and MS-Windows, it is the coding system by which all -non-ASCII clipboard text will be encoded and decoded; if set under X, -it provides the coding system calls to @code{gui-get-selection} will -decode selection data for a subset of text data types by, and also -forces replies to selection requests for the polymorphic @code{TEXT} -data type to be encoded by the @code{compound-text-with-extensions} -coding system rather than Unicode. - -Its default value is the system code page under MS-Windows 95, 98 or -Me, @code{utf-16le-dos} under NT/W2K/XP, @code{iso-latin-1-dos} on -MS-DOS, and @code{nil} elsewhere. +is used to encode selection data, and takes effect on MS-Windows and +X@. It is also used in the MS-DOS port when it runs on MS-Windows and +can access the Windows clipboard text. + +On X, the value of this variable provides the coding system which +@code{gui-get-selection} will use to decode selection data for a +subset of text data types, and also forces replies to selection +requests for the polymorphic @code{TEXT} data type to be encoded by +the @code{compound-text-with-extensions} coding system rather than +Unicode. + +On MS-Windows, this variable is generally ignored, as the MS-Windows +clipboard provides the information about decoding as part of the +clipboard data, and uses either UTF-16 or locale-specific encoding +automatically as appropriate. We recommend to set the value of this +variable only on the older Windows 9X, as it is otherwise used only in +the very rare cases when the information provided by the clipboard +data is unusable for some reason. + +The default value of this variable is the system code page under +MS-Windows 95, 98 or Me, @code{utf-16le-dos} on Windows +NT/W2K/XP/Vista/7/8/10/11, @code{iso-latin-1-dos} on MS-DOS, and +@code{nil} elsewhere. @end defopt For backward compatibility, there are obsolete aliases commit f80889b7247d42adb09f345bb6aa24010a6af33b Author: Eli Zaretskii Date: Sun Oct 29 13:40:27 2023 +0200 ; Fix last change (bug#66614). diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 665d4f9a8dc..d05b0b36475 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1508,11 +1508,12 @@ Case Conversion word is converted to upper case, and the rest are converted to lower case. +@vindex case-symbols-as-words The definition of a word is any sequence of consecutive characters that are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} -is non-nil, also characters assigned to the symbol constituent syntax -class. +table (@pxref{Syntax Class Table}); if @code{case-symbols-as-words} +is non-nil, characters assigned to the symbol constituent syntax +class are also considered as word constituent. When @var{string-or-char} is a character, this function does the same thing as @code{upcase}. @@ -1542,11 +1543,9 @@ Case Conversion contents are a copy of @var{string-or-char}, in which each word has had its initial letter converted to upper case. -The definition of a word is any sequence of consecutive characters that -are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} -is non-nil, also characters assigned to the symbol constituent syntax -class. +The definition of a word for this function is the same as described +for @code{capitalize} above, and @code{case-symbols-as-words} has the +same effect on word constituent characters. When the argument to @code{upcase-initials} is a character, @code{upcase-initials} has the same result as @code{upcase}. diff --git a/etc/NEWS b/etc/NEWS index 269346b5917..8ae7b89e830 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1199,7 +1199,7 @@ If non-nil, then case operations such as 'upcase-initials' or 'replace-match' (with nil FIXEDCASE) will treat the entire symbol name as a single word. This is useful for programming languages and styles where only the first letter of a symbol's name is ever capitalized. -It defaults to nil. +The default value of this variable is nil. +++ ** 'x-popup-menu' now understands touch screen events. commit 5c8fc0b0594b1e3af43d86c0bc96e10d03bc75a2 Author: Spencer Baugh Date: Sat Oct 21 11:09:39 2023 -0400 Add 'case-symbols-as-words' to configure symbol case behavior In some programming languages and styles, a symbol (or every symbol in a sequence of symbols) might be capitalized, but the individual words making up the symbol should never be capitalized. For example, in OCaml, type names Look_like_this and variable names look_like_this, but it is basically never correct for something to Look_Like_This. And one might have "aa_bb cc_dd ee_ff" or "Aa_bb Cc_dd Ee_ff", but never "Aa_Bb Cc_Dd Ee_Ff". To support this, the new variable 'case-symbols-as-words' causes symbol constituents to be treated as part of words only for case operations. * src/casefiddle.c (case_ch_is_word): New function. (case_character_impl, case_character): Use 'case_ch_is_word'. (syms_of_casefiddle): Define 'case-symbols-as-words'. * src/search.c (Freplace_match): Use 'case-symbols-as-words' when calculating case pattern. * test/src/casefiddle-tests.el (casefiddle-tests--check-syms) (casefiddle-case-symbols-as-words): Test 'case-symbols-as-words'. * etc/NEWS: Announce 'case-symbols-as-words'. * doc/lispref/strings.texi (Case Conversion): Document 'case-symbols-as-words'. (Bug#66614) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 7d11db49def..665d4f9a8dc 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1510,7 +1510,9 @@ Case Conversion The definition of a word is any sequence of consecutive characters that are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}). +table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} +is non-nil, also characters assigned to the symbol constituent syntax +class. When @var{string-or-char} is a character, this function does the same thing as @code{upcase}. @@ -1542,7 +1544,9 @@ Case Conversion The definition of a word is any sequence of consecutive characters that are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}). +table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} +is non-nil, also characters assigned to the symbol constituent syntax +class. When the argument to @code{upcase-initials} is a character, @code{upcase-initials} has the same result as @code{upcase}. diff --git a/etc/NEWS b/etc/NEWS index ed9f1a2124c..269346b5917 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1193,6 +1193,14 @@ instead of "ctags", "ebrowse", "etags", "hexl", "emacsclient", and "rcs2log", when starting one of these built in programs in a subprocess. ++++ +** New variable 'case-symbols-as-words' affects case operations for symbols. +If non-nil, then case operations such as 'upcase-initials' or +'replace-match' (with nil FIXEDCASE) will treat the entire symbol name +as a single word. This is useful for programming languages and styles +where only the first letter of a symbol's name is ever capitalized. +It defaults to nil. + +++ ** 'x-popup-menu' now understands touch screen events. When a 'touchscreen-begin' or 'touchscreen-end' event is passed as the diff --git a/src/casefiddle.c b/src/casefiddle.c index d567a5e353a..3afb131c50e 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -92,6 +92,12 @@ prepare_casing_context (struct casing_context *ctx, SETUP_BUFFER_SYNTAX_TABLE (); /* For syntax_prefix_flag_p. */ } +static bool +case_ch_is_word (enum syntaxcode syntax) +{ + return syntax == Sword || (case_symbols_as_words && syntax == Ssymbol); +} + struct casing_str_buf { unsigned char data[max (6, MAX_MULTIBYTE_LENGTH)]; @@ -115,7 +121,7 @@ case_character_impl (struct casing_str_buf *buf, /* Update inword state */ bool was_inword = ctx->inword; - ctx->inword = SYNTAX (ch) == Sword && + ctx->inword = case_ch_is_word (SYNTAX (ch)) && (!ctx->inbuffer || was_inword || !syntax_prefix_flag_p (ch)); /* Normalize flag so its one of CASE_UP, CASE_DOWN or CASE_CAPITALIZE. */ @@ -222,7 +228,7 @@ case_character (struct casing_str_buf *buf, struct casing_context *ctx, has a word syntax (i.e. current character is end of word), use final sigma. */ if (was_inword && ch == GREEK_CAPITAL_LETTER_SIGMA && changed - && (!next || SYNTAX (STRING_CHAR (next)) != Sword)) + && (!next || !case_ch_is_word (SYNTAX (STRING_CHAR (next))))) { buf->len_bytes = CHAR_STRING (GREEK_SMALL_LETTER_FINAL_SIGMA, buf->data); buf->len_chars = 1; @@ -720,6 +726,21 @@ syms_of_casefiddle (void) 3rd argument. */); Vregion_extract_function = Qnil; /* simple.el sets this. */ + DEFVAR_BOOL ("case-symbols-as-words", case_symbols_as_words, + doc: /* If non-nil, case functions treat symbol syntax as part of words. + +Functions such as `upcase-initials' and `replace-match' check or modify +the case pattern of sequences of characters. Normally, these operate on +sequences of characters whose syntax is word constituent. If this +variable is non-nil, then they operate on sequences of characters whose +syntax is either word constituent or symbol constituent. + +This is useful for programming languages and styles where only the first +letter of a symbol's name is ever capitalized.*/); + case_symbols_as_words = 0; + DEFSYM (Qcase_symbols_as_words, "case-symbols-as-words"); + Fmake_variable_buffer_local (Qcase_symbols_as_words); + defsubr (&Supcase); defsubr (&Sdowncase); defsubr (&Scapitalize); diff --git a/src/search.c b/src/search.c index e9b29bb7179..692d8488049 100644 --- a/src/search.c +++ b/src/search.c @@ -2365,7 +2365,7 @@ DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0, convert NEWTEXT to all caps. Otherwise if all words are capitalized in the replaced text, capitalize each word in NEWTEXT. Note that what exactly is a word is determined by the syntax tables in effect -in the current buffer. +in the current buffer, and the variable `case-symbols-as-words'. If optional third arg LITERAL is non-nil, insert NEWTEXT literally. Otherwise treat `\\' as special: @@ -2479,7 +2479,8 @@ DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0, /* Cannot be all caps if any original char is lower case */ some_lowercase = 1; - if (SYNTAX (prevc) != Sword) + if (SYNTAX (prevc) != Sword + && !(case_symbols_as_words && SYNTAX (prevc) == Ssymbol)) some_nonuppercase_initial = 1; else some_multiletter_word = 1; @@ -2487,7 +2488,8 @@ DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0, else if (uppercasep (c)) { some_uppercase = 1; - if (SYNTAX (prevc) != Sword) + if (SYNTAX (prevc) != Sword + && !(case_symbols_as_words && SYNTAX (prevc) == Ssymbol)) ; else some_multiletter_word = 1; @@ -2496,7 +2498,8 @@ DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0, { /* If the initial is a caseless word constituent, treat that like a lowercase initial. */ - if (SYNTAX (prevc) != Sword) + if (SYNTAX (prevc) != Sword + && !(case_symbols_as_words && SYNTAX (prevc) == Ssymbol)) some_nonuppercase_initial = 1; } diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el index e7f4348b0c6..12984d898b9 100644 --- a/test/src/casefiddle-tests.el +++ b/test/src/casefiddle-tests.el @@ -294,4 +294,16 @@ casefiddle-turkish ;;(should (string-equal (capitalize "indIá") "İndıa")) )) +(defun casefiddle-tests--check-syms (init with-words with-symbols) + (let ((case-symbols-as-words nil)) + (should (string-equal (upcase-initials init) with-words))) + (let ((case-symbols-as-words t)) + (should (string-equal (upcase-initials init) with-symbols)))) + +(ert-deftest casefiddle-case-symbols-as-words () + (casefiddle-tests--check-syms "Aa_bb Cc_dd" "Aa_Bb Cc_Dd" "Aa_bb Cc_dd") + (casefiddle-tests--check-syms "Aa_bb cc_DD" "Aa_Bb Cc_DD" "Aa_bb Cc_DD") + (casefiddle-tests--check-syms "aa_bb cc_dd" "Aa_Bb Cc_Dd" "Aa_bb Cc_dd") + (casefiddle-tests--check-syms "Aa_Bb Cc_Dd" "Aa_Bb Cc_Dd" "Aa_Bb Cc_Dd")) + ;;; casefiddle-tests.el ends here commit 3dca52dd422c50ebf24a304e7c3d36cf5f1c55cf Author: Spencer Baugh Date: Sat Oct 21 10:41:42 2023 -0400 Remove the header line after disabling 'which-function-mode' Previously, the header line would stay around even when after disabling 'which-function-mode', although it may be empty. Now the 'which-function-mode' element is properly removed from 'header-line-format', so the header line will disappear if there's nothing else in 'header-line-format'. Also, previously, when we ran (which-function-mode), we would enable 'which-function-mode' for all buffers even if they didn't support imenu. We didn't run the normal logic in 'which-func-ff-hook' to disable 'which-func-mode' if imenu wasn't present. Now we do run that logic, by just calling 'which-func-ff-hook'. This is especially important when the header line is enabled, because otherwise there's a very noticeable header line added to every buffer, including e.g. *Help* and *Buffer List*. Also, we now check that 'header-line-format' is a list before trying to add to it; this makes us work properly when enabling and disabling 'which-function-mode' for modes which set 'header-line-format' to a string or symbol, such as eww. * lisp/progmodes/which-func.el (which-func-try-to-enable): Re-add 'which-func-format' to the header line. (which-func--header-line-remove): New function. (which-func--disable): Call 'which-func--header-line-remove'. (which-function-mode): Call 'which-func-ff-hook' and 'which-func--header-line-remove'. (bug#66283) * test/lisp/progmodes/which-func-tests.el: New test. diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 09d0250515f..0e04bab6ea4 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -208,21 +208,28 @@ which-func--use-mode-line (add-hook 'after-change-major-mode-hook #'which-func-ff-hook t) (defun which-func-try-to-enable () - (unless (or (not which-function-mode) - (local-variable-p 'which-func-mode)) - (setq which-func-mode (or (eq which-func-modes t) - (member major-mode which-func-modes))) - (setq which-func--use-mode-line - (member which-func-display '(mode mode-and-header))) - (setq which-func--use-header-line - (member which-func-display '(header mode-and-header))) - (when (and which-func-mode which-func--use-header-line) + (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))) + (setq which-func--use-mode-line + (member which-func-display '(mode mode-and-header))) + (setq which-func--use-header-line + (member which-func-display '(header mode-and-header)))) + ;; We might need to re-add which-func-format to the header line, + ;; if which-function-mode was toggled off and on. + (when (and which-func-mode which-func--use-header-line + (listp header-line-format)) (add-to-list 'header-line-format '("" which-func-format " "))))) -(defun which-func--disable () - (when (and which-func-mode which-func--use-header-line) +(defun which-func--header-line-remove () + (when (and which-func-mode which-func--use-header-line + (listp header-line-format)) (setq header-line-format - (delete '("" which-func-format " ") header-line-format))) + (delete '("" which-func-format " ") header-line-format)))) + +(defun which-func--disable () + (which-func--header-line-remove) (setq which-func-mode nil)) (defun which-func-ff-hook () @@ -288,9 +295,11 @@ which-function-mode (when which-function-mode ;;Turn it on. (setq which-func-update-timer - (run-with-idle-timer idle-update-delay t #'which-func-update)) - (dolist (buf (buffer-list)) - (with-current-buffer buf (which-func-try-to-enable))))) + (run-with-idle-timer idle-update-delay t #'which-func-update))) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (which-func--header-line-remove) + (which-func-ff-hook)))) (defvar which-function-imenu-failed nil "Locally t in a buffer if `imenu--make-index-alist' found nothing there.") diff --git a/test/lisp/progmodes/which-func-tests.el b/test/lisp/progmodes/which-func-tests.el new file mode 100644 index 00000000000..73709f1c5e5 --- /dev/null +++ b/test/lisp/progmodes/which-func-tests.el @@ -0,0 +1,58 @@ +;;; which-func-tests.el --- tests for which-func -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Spencer Baugh + +;; 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 GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: +(require 'ert) +(require 'which-func) + +(ert-deftest which-func-tests-toggle () + (let ((which-func-display 'mode-and-header) buf-code buf-not) + (setq buf-code (find-file-noselect "which-func-tests.el")) + (setq buf-not (get-buffer-create "fundamental")) + (with-current-buffer buf-code + (should-not which-func-mode) (should-not header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (which-function-mode 1) + (with-current-buffer buf-code + (should which-func-mode) (should header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (which-function-mode -1) + ;; which-func-mode stays set even when which-function-mode is off. + (with-current-buffer buf-code + (should which-func-mode) (should-not header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (kill-buffer buf-code) + (kill-buffer buf-not) + (which-function-mode 1) + (setq buf-code (find-file-noselect "which-func-tests.el")) + (setq buf-not (get-buffer-create "fundamental")) + (with-current-buffer buf-code + (should which-func-mode) (should header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)))) + +(provide 'which-func-tests) +;;; which-func-tests.el ends here commit 27ccf2230bced7248a86e3741b45734bde77cb42 Author: Manuel Giraud Date: Fri Oct 6 14:27:02 2023 +0200 Set non-text mouse cursor on menu bar * src/xdisp.c (note_mouse_highlight): Set non-text mouse cursor on menu bar. diff --git a/src/xdisp.c b/src/xdisp.c index 578131a4005..20c7634fc3e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35537,6 +35537,16 @@ note_mouse_highlight (struct frame *f, int x, int y) w = XWINDOW (window); frame_to_window_pixel_xy (w, &x, &y); +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_MENU_BAR) + /* Handle menu-bar window differently since it doesn't display a + buffer. */ + if (EQ (window, f->menu_bar_window)) + { + cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; + goto set_cursor; + } +#endif + #if defined (HAVE_WINDOW_SYSTEM) /* Handle tab-bar window differently since it doesn't display a buffer. */ commit 59a3edc3559057e6f0346e3f1b3b13e8ef3e1683 Author: Po Lu Date: Sun Oct 29 12:59:45 2023 +0800 Avert a crash and file descriptor leak in yank-media * java/org/gnu/emacs/EmacsNative.java (close): New declaration. * java/org/gnu/emacs/EmacsSdk11Clipboard.java (getClipboardData): Catch SecurityException and guarantee file descriptors are closed even if exceptions arise. * src/android.c (dup): Export another function. diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 7d7e1e5d831..f15927bb3a7 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -39,6 +39,9 @@ public final class EmacsNative /* Like `dup' in C. */ public static native int dup (int fd); + /* Like `close' in C. */ + public static native int close (int fd); + /* Obtain the fingerprint of this build of Emacs. The fingerprint can be used to determine the dump file name. */ public static native String getFingerprint (); diff --git a/java/org/gnu/emacs/EmacsSdk11Clipboard.java b/java/org/gnu/emacs/EmacsSdk11Clipboard.java index b8a43496b6d..b068a89831e 100644 --- a/java/org/gnu/emacs/EmacsSdk11Clipboard.java +++ b/java/org/gnu/emacs/EmacsSdk11Clipboard.java @@ -245,6 +245,8 @@ public final class EmacsSdk11Clipboard extends EmacsClipboard if (data == null || data.getItemCount () < 1) return null; + fd = -1; + try { uri = data.getItemAt (0).getUri (); @@ -267,12 +269,34 @@ public final class EmacsSdk11Clipboard extends EmacsClipboard /* Close the original offset. */ assetFd.close (); } + catch (SecurityException e) + { + /* Guarantee a file descriptor duplicated or detached is + ultimately closed if an error arises. */ + + if (fd != -1) + EmacsNative.close (fd); + + return null; + } catch (FileNotFoundException e) { + /* Guarantee a file descriptor duplicated or detached is + ultimately closed if an error arises. */ + + if (fd != -1) + EmacsNative.close (fd); + return null; } catch (IOException e) { + /* Guarantee a file descriptor duplicated or detached is + ultimately closed if an error arises. */ + + if (fd != -1) + EmacsNative.close (fd); + return null; } diff --git a/src/android.c b/src/android.c index 3344a773d5f..79f16568fd4 100644 --- a/src/android.c +++ b/src/android.c @@ -1260,6 +1260,14 @@ NATIVE_NAME (dup) (JNIEnv *env, jobject object, jint fd) return dup (fd); } +JNIEXPORT jint JNICALL +NATIVE_NAME (close) (JNIEnv *env, jobject object, jint fd) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + return close (fd); +} + JNIEXPORT jstring JNICALL NATIVE_NAME (getFingerprint) (JNIEnv *env, jobject object) { commit 3624e9bd409075d4f78b240ebdb356f93fd9c3e4 Author: Stefan Kangas Date: Sun Oct 29 01:40:25 2023 +0200 Prefer seq-filter in hanja-util.el Benchmarking shows seq-filter to be ~30% faster on this machine. * lisp/language/hanja-util.el (hanja-filter): Make into obsolete alias for 'seq-filter'. Update single caller. diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el index be0364b1c23..b5ef9230d27 100644 --- a/lisp/language/hanja-util.el +++ b/lisp/language/hanja-util.el @@ -6479,11 +6479,7 @@ hanja-keymap map) "Keymap for Hanja (Korean Hanja Converter).") -(defun hanja-filter (condp lst) - "Construct a list from the elements of LST for which CONDP returns true." - (delq - nil - (mapcar (lambda (x) (and (funcall condp x) x)) lst))) +(define-obsolete-function-alias 'hanja-filter #'seq-filter "30.1") (defun hanja-list-prev-group () "Select the previous group of hangul->hanja conversions." @@ -6570,12 +6566,12 @@ hangul-to-hanja-char 0 0 ;; Filter characters that can not be decoded. ;; Maybe it can not represent characters in current terminal coding. - (hanja-filter (lambda (x) (car x)) - (mapcar (lambda (c) - (if (listp c) - (cons (car c) (cdr c)) - (list c))) - (aref hanja-table char))))) + (seq-filter #'car + (mapcar (lambda (c) + (if (listp c) + (cons (car c) (cdr c)) + (list c))) + (aref hanja-table char))))) (unwind-protect (when (aref hanja-conversions 2) (catch 'exit-input-loop commit e08238cdd74719d4cd99cf5a4f743eb8c6d1d251 Author: Morgan J. Smith Date: Tue Sep 6 21:18:51 2022 -0400 Speed up Eshell smart display module em-smart was forcibly re-displaying the screen upwards of 500 times per screen of output. This caused the Eshell to feel quite slow when the module was in use. By using fewer hooks and never explicitly calling 'redisplay' (which was unnecessary) the performance issues go away (bug#57367). lisp/eshell/em-smart.el: (em-smart-unload-hook, eshell-smart-unload-hook): Remove 'eshell-smart-scroll' instead of the now deleted 'eshell-refresh-windows'. (eshell-smart-displayed, eshell-currently-handling-window) (eshell-refresh-windows): Delete. (eshell-smart-scroll-window): Rename to 'eshell-smart-scroll-windows' and add a bunch of logic originally from 'eshell-refresh-windows'. (eshell-smart-initialize): Don't add a hook onto 'window-scroll-functions'. Replace 'eshell-refresh-windows' with 'eshell-smart-scroll-windows'. (eshell-smart-display-setup): Don't refresh windows. (eshell-smart-redisplay): Rename to 'eshell-smart-scroll'. Delete 'eobp' case. diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index 4c39a991ec6..fc283547519 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -95,7 +95,7 @@ eshell-smart-unload-hook (list (lambda () (remove-hook 'window-configuration-change-hook - 'eshell-refresh-windows))) + 'eshell-smart-scroll))) "A hook that gets run when `eshell-smart' is unloaded." :type 'hook :group 'eshell-smart) @@ -159,9 +159,7 @@ eshell-where-to-jump ;;; Internal Variables: -(defvar eshell-smart-displayed nil) (defvar eshell-smart-command-done nil) -(defvar eshell-currently-handling-window nil) ;;; Functions: @@ -174,10 +172,9 @@ eshell-smart-initialize (setq-local eshell-scroll-to-bottom-on-input nil) (setq-local eshell-scroll-show-maximum-output t) - (add-hook 'window-scroll-functions 'eshell-smart-scroll-window nil t) - (add-hook 'window-configuration-change-hook 'eshell-refresh-windows) + (add-hook 'window-configuration-change-hook 'eshell-smart-scroll nil t) - (add-hook 'eshell-output-filter-functions 'eshell-refresh-windows t t) + (add-hook 'eshell-output-filter-functions 'eshell-smart-scroll-windows 90 t) (add-hook 'after-change-functions 'eshell-disable-after-change nil t) @@ -193,28 +190,15 @@ eshell-smart-initialize (add-hook 'eshell-post-command-hook 'eshell-smart-maybe-jump-to-end nil t)))) -;; This is called by window-scroll-functions with two arguments. -(defun eshell-smart-scroll-window (wind _start) - "Scroll the given Eshell window WIND accordingly." - (unless eshell-currently-handling-window - (let ((eshell-currently-handling-window t)) - (with-selected-window wind - (eshell-smart-redisplay))))) - -(defun eshell-refresh-windows (&optional frame) - "Refresh all visible Eshell buffers." - (let (affected) - (walk-windows - (lambda (wind) - (with-current-buffer (window-buffer wind) - (if eshell-mode - (let (window-scroll-functions) ;;FIXME: Why? - (eshell-smart-scroll-window wind (window-start)) - (setq affected t))))) - 0 frame) - (if affected - (let (window-scroll-functions) ;;FIXME: Why? - (redisplay))))) +(defun eshell-smart-scroll-windows () + "Scroll all eshell windows to display as much output as possible, smartly." + (walk-windows + (lambda (wind) + (with-current-buffer (window-buffer wind) + (if eshell-mode + (with-selected-window wind + (eshell-smart-scroll))))) + 0 t)) (defun eshell-smart-display-setup () "Set the point to somewhere in the beginning of the last command." @@ -231,8 +215,7 @@ eshell-smart-display-setup (t (error "Invalid value for `eshell-where-to-jump'"))) (setq eshell-smart-command-done nil) - (add-hook 'pre-command-hook 'eshell-smart-display-move nil t) - (eshell-refresh-windows)) + (add-hook 'pre-command-hook 'eshell-smart-display-move nil t)) ;; Called from after-change-functions with 3 arguments. (defun eshell-disable-after-change (_b _e _l) @@ -254,28 +237,22 @@ eshell-smart-maybe-jump-to-end (goto-char (point-max)) (remove-hook 'pre-command-hook 'eshell-smart-display-move t))) -(defun eshell-smart-redisplay () - "Display as much output as possible, smartly." - (if (eobp) +(defun eshell-smart-scroll () + "Scroll WINDOW to display as much output as possible, smartly." + (let ((top-point (point))) + (and (memq 'eshell-smart-display-move pre-command-hook) + (>= (point) eshell-last-input-start) + (< (point) eshell-last-input-end) + (set-window-start (selected-window) + (pos-bol) t)) + (when (pos-visible-in-window-p (point-max) (selected-window)) (save-excursion - (recenter -1) - ;; trigger the redisplay now, so that we catch any attempted - ;; point motion; this is to cover for a redisplay bug - (redisplay)) - (let ((top-point (point))) - (and (memq 'eshell-smart-display-move pre-command-hook) - (>= (point) eshell-last-input-start) - (< (point) eshell-last-input-end) - (set-window-start (selected-window) - (line-beginning-position) t)) - (if (pos-visible-in-window-p (point-max)) - (save-excursion - (goto-char (point-max)) - (recenter -1) - (unless (pos-visible-in-window-p top-point) - (goto-char top-point) - (set-window-start (selected-window) - (line-beginning-position) t))))))) + (goto-char (point-max)) + (recenter -1) + (unless (pos-visible-in-window-p top-point (selected-window)) + (goto-char top-point) + (set-window-start (selected-window) + (pos-bol) t)))))) (defun eshell-smart-goto-end () "Like `end-of-buffer', but do not push a mark." @@ -323,7 +300,7 @@ eshell-smart-display-move (remove-hook 'pre-command-hook 'eshell-smart-display-move t)))) (defun em-smart-unload-hook () - (remove-hook 'window-configuration-change-hook #'eshell-refresh-windows)) + (remove-hook 'window-configuration-change-hook #'eshell-smart-scroll)) (provide 'em-smart) commit 72d040ce7db94979dd2baa951919478faef928a0 Author: Stefan Kangas Date: Sun Oct 29 00:38:02 2023 +0200 Prefer seq-filter in rcirc.el Benchmarking shows seq-filter to be ~30% faster on this machine. * lisp/net/rcirc.el (rcirc-condition-filter): Make into an obsolete alias for 'seq-filter'. Update single caller. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 7cc7adc45c7..ecfeb9f8f84 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2974,20 +2974,13 @@ rcirc-url-regexp browse-url-button-regexp) "Regexp matching URLs. Set to nil to disable URL features in rcirc.") -;; cf cl-remove-if-not -(defun rcirc-condition-filter (condp lst) - "Remove all items not satisfying condition CONDP in list LST. -CONDP is a function that takes a list element as argument and returns -non-nil if that element should be included. Returns a new list." - (delq nil (mapcar (lambda (x) (and (funcall condp x) x)) lst))) - (defun rcirc-browse-url (&optional arg) "Prompt for URL to browse based on URLs in buffer before point. If ARG is given, opens the URL in a new browser window." (interactive "P") (let* ((point (point)) - (filtered (rcirc-condition-filter + (filtered (seq-filter (lambda (x) (>= point (cdr x))) rcirc-urls)) (completions (mapcar (lambda (x) (car x)) filtered)) @@ -4008,6 +4001,8 @@ rcirc-server-parameter-value (define-obsolete-function-alias 'rcirc-format-strike-trough 'rcirc-format-strike-through "30.1") +(define-obsolete-function-alias 'rcirc-condition-filter #'seq-filter "30.1") + (provide 'rcirc) ;;; rcirc.el ends here commit 3d25a9fccfa620aebc93947a1738a4553b1b8592 Merge: e2d2726db7c c79ea103efd Author: Michael Albinus Date: Sat Oct 28 19:43:17 2023 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit c79ea103efd6fa3004c14f373305a17c49d6462d Author: Mauro Aranda Date: Mon Oct 23 09:45:12 2023 -0300 Add easy customization for dir-locals files (Bug#66702) * lisp/cus-edit.el (custom--editable-field-p): New utility function. (custom-dirlocals-widget, custom-dirlocals-file-widget) (custom-dirlocals-commands, custom-dirlocals-tool-bar-map): New variables. (custom-dirlocals-map, custom-dirlocals-field-map): New keymaps. (Custom-dirlocals-menu): New menu. (custom-dirlocals-key, custom-dynamic-cons, custom-dirlocals): New widgets. (custom-dirlocals-maybe-update-cons, custom-dirlocals-symbol-action) (custom-dirlocals-change-file, custom-dirlocals--set-widget-vars) (custom-dirlocals-get-options, custom-dirlocals-validate): New functions. (custom-dirlocals-with-buffer): New macro. (Custom-dirlocals-revert-buffer, Custom-dirlocals-save) (customize-dirlocals): New commands. * doc/emacs/custom.texi (Directory Variables): Document customize-dirlocals. * etc/NEWS: Announce. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index d51912a75da..e2d35863bd0 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1515,6 +1515,11 @@ Directory Variables valid filename, either @file{.dir-locals.el} or @file{.dir-locals-2.el}. +@findex customize-dirlocals +There's also a command to pop up an Easy Customization buffer +(@pxref{Easy Customization}) to edit directory local variables, +@code{customize-dirlocals}. + @findex dir-locals-set-class-variables @findex dir-locals-set-directory-class Another method of specifying directory-local variables is to define diff --git a/etc/NEWS b/etc/NEWS index 05fd1b7a390..ed9f1a2124c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -961,6 +961,11 @@ For links in 'webjump-sites' without an explicit URI scheme, it was previously assumed that they should be prefixed with "http://". Such URIs are now prefixed with "https://" instead. +** Customize ++++ +*** New command customize-dirlocals +This command pops up a buffer to edit the settings in .dir-locals.el + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 953b8b8b80f..6442ffeac24 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -512,6 +512,13 @@ custom-menu-filter (push name result))) (nreverse result))) +(defun custom--editable-field-p (widget) + "Non-nil if WIDGET is an editable-field widget, or inherits from it." + (let ((type (widget-type widget))) + (while (and type (not (eq type 'editable-field))) + (setq type (widget-type (get type 'widget-type)))) + type)) + ;;; Unlispify. (defvar custom-prefix-list nil @@ -5692,6 +5699,288 @@ custom-save-icons (prin1 value (current-buffer))) (insert ")\n"))))) +;;; Directory Local Variables. +;; The following code provides an Easy Customization interface to manage +;; `.dir-locals.el' files. +;; The main command is `customize-dirlocals'. It presents a Custom-like buffer +;; but with a few tweaks. Variables are inserted in a repeat widget, and +;; update its associated widget (the one for editing the value) upon the user +;; hitting RET or TABbing out of it. +;; This is unlike the `cus-theme.el' interface for editing themes, that prompts +;; the user for the variable to then create the appropriate widget. +(defvar-local custom-dirlocals-widget nil + "Widget that holds the dir-locals customizations.") + +(defvar-local custom-dirlocals-file-widget nil + "Widget that holds the name of the dir-locals file being customized.") + +(defvar-keymap custom-dirlocals-map + :doc "Keymap used in the \"*Customize Dirlocals*\" buffer." + :full t + :parent widget-keymap + "SPC" #'scroll-up-command + "S-SPC" #'scroll-down-command + "DEL" #'scroll-down-command + "C-x C-s" #'Custom-dirlocals-save + "q" #'Custom-buffer-done + "n" #'widget-forward + "p" #'widget-backward) + +(defvar custom-dirlocals-field-map + (let ((map (copy-keymap custom-field-keymap))) + (define-key map "\C-x\C-s" #'Custom-dirlocals-save) + (define-key map "\C-m" #'widget-field-activate) + map) + "Keymap for the editable fields in the \"*Customize Dirlocals*\" buffer .") + +(defvar custom-dirlocals-commands + '((" Save Settings " Custom-dirlocals-save t + "Save Settings to the dir-locals file." "save" "Save" t) + (" Undo Edits " Custom-dirlocals-revert-buffer t + "Revert buffer, undoing any editions." + "refresh" "Undo" t) + (" Help for Customize " Custom-help t "Get help for using Customize." + "help" "Help" t) + (" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit" t)) + "Alist of specifications for Customize menu items, tool bar icons and buttons. +See `custom-commands' for further explanation.") + +(easy-menu-define + Custom-dirlocals-menu (list custom-dirlocals-map + custom-dirlocals-field-map) + "Menu used in dirlocals customization buffers." + (nconc (list "Custom" + (customize-menu-create 'customize)) + (mapcar (lambda (arg) + (let ((tag (nth 0 arg)) + (command (nth 1 arg)) + (visible (nth 2 arg)) + (help (nth 3 arg)) + (active (nth 6 arg))) + (vector tag command :visible (eval visible) + :active `(eq t ',active) + :help help))) + custom-dirlocals-commands))) + +(defvar custom-dirlocals-tool-bar-map nil + "Keymap for the toolbar in \"*Customize Dirlocals*\" buffer.") + +(define-widget 'custom-dirlocals-key 'menu-choice + "Menu to choose between possible keys in a dir-locals file. + +Possible values are nil, a symbol (standing for a major mode) or a directory +name." + :tag "Specification" + :value nil + :help-echo "Select a key for the dir-locals specification." + :args '((const :tag "All modes" nil) + (symbol :tag "Major mode" fundamental-mode) + (directory :tag "Subdirectory"))) + +(define-widget 'custom-dynamic-cons 'cons + "A cons widget that changes its 2nd type based on the 1st type." + :value-create #'custom-dynamic-cons-value-create) + +(defun custom-dynamic-cons-value-create (widget) + "Select an appropriate 2nd type for the cons WIDGET and create WIDGET. + +The appropriate types are: +- A symbol, if the value to represent is a minor-mode. +- A boolean, if the value to represent is either the unibyte value or the + subdirs value. +- A widget type suitable for editing a variable, in case of specifying a + variable's value. +- A sexp widget, if none of the above happens." + (let* ((args (widget-get widget :args)) + (value (widget-get widget :value)) + (val (car value))) + (cond + ((eq val 'mode) (setf (nth 1 args) + '(symbol :keymap custom-dirlocals-field-map + :tag "Minor mode"))) + ((eq val 'unibyte) (setf (nth 1 args) '(boolean))) + ((eq val 'subdirs) (setf (nth 1 args) '(boolean))) + ((custom-variable-p val) + (let ((w (widget-convert (custom-variable-type val)))) + (when (custom--editable-field-p w) + (widget-put w :keymap custom-dirlocals-field-map)) + (setf (nth 1 args) w))) + (t (setf (nth 1 args) '(sexp :keymap custom-dirlocals-field-map)))) + (widget-put (nth 0 args) :keymap custom-dirlocals-field-map) + (widget-group-value-create widget))) + +(defun custom-dirlocals-maybe-update-cons () + "If focusing out from the first widget in a cons widget, update its value." + (when-let ((w (widget-at))) + (when (widget-get w :custom-dirlocals-symbol) + (widget-value-set (widget-get w :parent) + (cons (widget-value w) "")) + (widget-setup)))) + +(define-widget 'custom-dirlocals 'editable-list + "An editable list to edit settings in a dir-locals file." + :entry-format "%i %d %v" + :insert-button-args '(:help-echo "Insert new specification here.") + :append-button-args '(:help-echo "Append new specification here.") + :delete-button-args '(:help-echo "Delete this specification.") + :args '((group :format "%v" + custom-dirlocals-key + (repeat + :tag "Settings" + :inline t + (custom-dynamic-cons + :tag "Setting" + (symbol :action custom-dirlocals-symbol-action + :custom-dirlocals-symbol t) + ;; Will change according to the option being customized. + (sexp :tag "Value")))))) + +(defun custom-dirlocals-symbol-action (widget &optional _event) + "Action for the symbol WIDGET. + +Sets the value of its parent, a cons widget, in order to create an +appropriate widget to edit the value of WIDGET. + +Moves point into the widget that holds the value." + (setq widget (or widget (widget-at))) + (widget-value-set (widget-get widget :parent) + (cons (widget-value widget) "")) + (widget-setup) + (widget-forward 1)) + +(defun custom-dirlocals-change-file (widget &optional _event) + "Switch to a buffer to customize the dir-locals file in WIDGET." + (customize-dirlocals (expand-file-name (widget-value widget)))) + +(defun custom-dirlocals--set-widget-vars () + "Set local variables for the Widget library." + (custom--initialize-widget-variables) + (add-hook 'widget-forward-hook #'custom-dirlocals-maybe-update-cons nil t)) + +(defmacro custom-dirlocals-with-buffer (&rest body) + "Arrange to execute BODY in a \"*Customize Dirlocals*\" buffer." + ;; We don't use `custom-buffer-create' because the settings here + ;; don't go into the `custom-file'. + `(progn + (switch-to-buffer "*Customize Dirlocals*") + (kill-all-local-variables) + (let ((inhibit-read-only t)) + (erase-buffer)) + (remove-overlays) + (custom-dirlocals--set-widget-vars) + ,@body + (setq-local tool-bar-map + (or custom-dirlocals-tool-bar-map + ;; Set up `custom-dirlocals-tool-bar-map'. + (let ((map (make-sparse-keymap))) + (mapc + (lambda (arg) + (tool-bar-local-item-from-menu + (nth 1 arg) (nth 4 arg) map custom-dirlocals-map + :label (nth 5 arg))) + custom-dirlocals-commands) + (setq custom-dirlocals-tool-bar-map map)))) + (setq-local revert-buffer-function #'Custom-dirlocals-revert-buffer) + (use-local-map custom-dirlocals-map) + (widget-setup))) + +(defun custom-dirlocals-get-options () + "Return all options inside a custom-dirlocals widget." + (let* ((groups (widget-get custom-dirlocals-widget :children)) + (repeats (mapcar (lambda (group) + (nth 1 (widget-get group :children))) + groups))) + (mapcan (lambda (repeat) + (mapcar (lambda (w) + (nth 1 (widget-get w :children))) + (widget-get repeat :children))) + repeats))) + +(defun custom-dirlocals-validate () + "Non-nil if all customization options validate. + +If at least an option doesn't validate, signals an error and moves point +to the widget with the invalid value." + (dolist (opt (custom-dirlocals-get-options)) + (when-let ((w (widget-apply opt :validate))) + (goto-char (widget-get w :from)) + (error "%s" (widget-get w :error)))) + t) + +(defun Custom-dirlocals-revert-buffer (&rest _ignored) + "Revert the buffer for Directory Local Variables customization." + (interactive) + (customize-dirlocals (widget-get custom-dirlocals-file-widget :value))) + +(defun Custom-dirlocals-save (&rest _ignore) + "Save the settings to the dir-locals file being customized." + (interactive) + (when (custom-dirlocals-validate) + (let* ((file (widget-value custom-dirlocals-file-widget)) + (old (widget-get custom-dirlocals-widget :value)) + (dirlocals (widget-value custom-dirlocals-widget))) + (dolist (spec old) + (let ((mode (car spec)) + (settings (cdr spec))) + (dolist (setting settings) + (delete-dir-local-variable mode (car setting) file)))) + (dolist (spec dirlocals) + (let ((mode (car spec)) + (settings (cdr spec))) + (dolist (setting (reverse settings)) + (when (memq (car setting) '(mode eval)) + (delete-dir-local-variable mode (car setting) file)) + (add-dir-local-variable mode (car setting) (cdr setting) file))))) + ;; Write the dir-locals file and kill its buffer, to come back to + ;; our own buffer. + (write-file (expand-file-name buffer-file-name) nil) + (kill-buffer))) + +;;;###autoload +(defun customize-dirlocals (&optional filename) + "Customize Directory Local Variables in the current directory. + +With optional argument FILENAME non-nil, customize the `.dir-locals.el' file +that FILENAME specifies." + (interactive) + (let* ((file (or filename (expand-file-name ".dir-locals.el"))) + (dirlocals (when (file-exists-p file) + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + (prog1 + (condition-case _ + (read (current-buffer)) + (end-of-file nil)) + (kill-buffer)))))) + (custom-dirlocals-with-buffer + (widget-insert + "This buffer is for customizing the Directory Local Variables in:\n") + (setq custom-dirlocals-file-widget + (widget-create `(file :action ,#'custom-dirlocals-change-file + ,file))) + (widget-insert + (substitute-command-keys + " +To select another file, edit the above field and hit RET. + +After you enter a user option name under the symbol field, +be sure to press \\`RET' or \\`TAB', so that the field that holds the +value changes to an appropriate field for the option. + +Type \\`C-x C-s' when you've finished editing it, to save the +settings to the file.")) + (widget-insert "\n\n\n") + (widget-create 'push-button :tag " Revert " + :action #'Custom-dirlocals-revert-buffer) + (widget-insert " ") + (widget-create 'push-button :tag " Save Settings " + :action #'Custom-dirlocals-save) + (widget-insert "\n\n") + (setq custom-dirlocals-widget + (widget-create 'custom-dirlocals :value dirlocals)) + (setq default-directory (file-name-directory file)) + (goto-char (point-min))))) + (provide 'cus-edit) ;;; cus-edit.el ends here commit e81e625ab895f1bd3c5263f5b66251db0fd38bd6 Merge: 0797246c09d aa253c533d2 Author: Eli Zaretskii Date: Sat Oct 28 05:06:21 2023 -0400 Merge from origin/emacs-29 aa253c533d2 ; Fix broken links to gmane.org cc3e436c822 Change news.gmane.org to news.gmane.io 297fe945c57 Fix minor defcustom issues in Gnus (Bug#66715) 3beb5f5e240 ; * doc/misc/gnus.texi: Fix unmatched quote in gnus doc. ... 85d08d5788e Minor connection-local variables fixes 79d8328ca4a Make Dired honor `insert-directory-program´ with globs 43127294e13 Fix typo in url-privacy-level :type 380f8574ef5 * lisp/vc/log-view.el (log-view-mode-menu): Quote derived... commit 0797246c09d074aa9306aaa22634ed936c101345 Merge: a2f88746b8a 5d1e6f759f2 Author: Eli Zaretskii Date: Sat Oct 28 04:56:23 2023 -0400 ; Merge from origin/emacs-29 The following commit was skipped: 5d1e6f759f2 * lisp/tab-bar.el: Fix the close button with auto-width (... commit a2f88746b8a65a22119805174dd6f0d2aedf01c7 Merge: 12d10872f47 5f60913208f Author: Eli Zaretskii Date: Sat Oct 28 04:56:22 2023 -0400 Merge from origin/emacs-29 5f60913208f Fix State button for customize-icon (Bug#66635) 27c71979ff1 ; Another Texinfo fix 889a550ca08 ; Fix Texinfo warnings 893c344b4e4 Fix the use of adaptive-fill-regexp in treesit indent preset 1098c114b74 Fix treesit-install-language-grammar (bug#66673) 491ee428c08 Fix treesit-explore-mode (bug#66431) ee043a2703d tsx-ts-mode--font-lock-compatibility-bb1f97b: Re-fix the ... commit 12d10872f479f93cb2e0e1a6e919a185af621b21 Author: Po Lu Date: Sat Oct 28 06:43:56 2023 +0000 ; * lisp/dnd.el (dnd-protocol-alist): Correct typo. diff --git a/lisp/dnd.el b/lisp/dnd.el index 33a8f182539..936534fa32c 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -60,7 +60,7 @@ dnd-protocol-alist If no match is found, the URL is inserted as text by calling `dnd-insert-text'. The function shall return the action done (move, copy, link or private) if some action was made, or nil if the URL is ignored." - :version "30.0" + :version "30.1" :type '(repeat (cons (regexp) (function))) :group 'dnd) commit f14870ee2614453c861c6ddde36a51392496662d Author: Po Lu Date: Sat Oct 28 06:43:44 2023 +0000 * lisp/dnd.el (dnd-protocol-alist): Update :version. diff --git a/lisp/dnd.el b/lisp/dnd.el index ecf9c332e94..33a8f182539 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -60,7 +60,7 @@ dnd-protocol-alist If no match is found, the URL is inserted as text by calling `dnd-insert-text'. The function shall return the action done (move, copy, link or private) if some action was made, or nil if the URL is ignored." - :version "22.1" + :version "30.0" :type '(repeat (cons (regexp) (function))) :group 'dnd) commit 897cc73c88a9da0a2477f1e61501b907eb877a5b Author: Po Lu Date: Sat Oct 28 06:42:48 2023 +0000 Render default DND file name handlers more precise * lisp/dnd.el (dnd-protocol-alist): Redefine file name handlers to match solely the local or remote URIs they understand. (dnd-handle-multiple-urls): Prevent calling the same handler multiple times for a single URI. * lisp/gnus/mml.el (mml-dnd-protocol-alist): Apply an anologous adjustment here. Delete now redundant redefinition of dnd-open-file. (mml-dnd-attach-file): Inquire whether to apply the default disposition and such only once even if more than one file is dropped. * test/lisp/dnd-tests.el (dnd-tests-receive-multiple-urls) (dnd-tests-default-file-name-handlers): New tests. diff --git a/lisp/dnd.el b/lisp/dnd.el index c27fdeb7745..ecf9c332e94 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -42,10 +42,11 @@ dnd ;;;###autoload (defcustom dnd-protocol-alist - `((,(purecopy "^file:///") . dnd-open-local-file) ; XDND format. - (,(purecopy "^file://") . dnd-open-file) ; URL with host - (,(purecopy "^file:") . dnd-open-local-file) ; Old KDE, Motif, Sun - (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) + `((,(purecopy "^file:///") . dnd-open-local-file) ; XDND format. + (,(purecopy "^file://[^/]") . dnd-open-file) ; URL with host + (,(purecopy "^file:/[^/]") . dnd-open-local-file) ; Old KDE, Motif, Sun + (,(purecopy "^file:[^/]") . dnd-open-local-file) ; MS-Windows + (,(purecopy "^\\(https?\\|ftp\\|nfs\\)://") . dnd-open-file)) "The functions to call for different protocols when a drop is made. This variable is used by `dnd-handle-multiple-urls'. The list contains of (REGEXP . FUNCTION) pairs. @@ -223,7 +224,8 @@ dnd-handle-multiple-urls (let ((cell (cons handler nil))) (push cell list) cell)))) - (setcdr cell (cons uri (cdr cell)))))))) + (unless (memq uri cell) + (setcdr cell (cons uri (cdr cell))))))))) (setq list (nreverse list)) ;; While unassessed handlers still exist... (while list diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 6025ca7e72a..24cd5eb83d3 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1369,9 +1369,9 @@ mml-insert-empty-tag ;;; Attachment functions. (defcustom mml-dnd-protocol-alist - '(("^file:///" . mml-dnd-attach-file) - ("^file://" . dnd-open-file) - ("^file:" . mml-dnd-attach-file)) + '(("^file:///" . mml-dnd-attach-file) ; GNOME, KDE, and suchlike. + ("^file:/[^/]" . mml-dnd-attach-file) ; Motif, other systems. + ("^file:[^/]" . mml-dnd-attach-file)) ; MS-Windows. "The functions to call when a drop in `mml-mode' is made. See `dnd-protocol-alist' for more information. When nil, behave as in other buffers." @@ -1460,29 +1460,36 @@ mml-attach-file (file-name-nondirectory file))) (goto-char at-end)))) -(defun mml-dnd-attach-file (uri _action) - "Attach a drag and drop file. - -Ask for type, description or disposition according to -`mml-dnd-attach-options'." - (let ((file (dnd-get-local-file-name uri t))) - (when (and file (file-regular-p file)) - (let ((mml-dnd-attach-options mml-dnd-attach-options) - type description disposition) - (setq mml-dnd-attach-options - (when (and (eq mml-dnd-attach-options t) - (not - (y-or-n-p - "Use default type, disposition and description? "))) - '(type description disposition))) - (when (or (memq 'type mml-dnd-attach-options) - (memq 'disposition mml-dnd-attach-options)) - (setq type (mml-minibuffer-read-type file))) - (when (memq 'description mml-dnd-attach-options) - (setq description (mml-minibuffer-read-description))) - (when (memq 'disposition mml-dnd-attach-options) - (setq disposition (mml-minibuffer-read-disposition type nil file))) - (mml-attach-file file type description disposition))))) +(defun mml-dnd-attach-file (uris _action) + "Attach a drag and drop URIS, a list of local file URIs. + +Query whether to use the types, dispositions and descriptions +default for each URL, subject to `mml-dnd-attach-options'. + +Return the action `private', communicating to the drop source +that the file has been attached." + (let (file (mml-dnd-attach-options mml-dnd-attach-options)) + (setq mml-dnd-attach-options + (when (and (eq mml-dnd-attach-options t) + (not + (y-or-n-p + "Use default type, disposition and description? "))) + '(type description disposition))) + (dolist (uri uris) + (setq file (dnd-get-local-file-name uri t)) + (when (and file (file-regular-p file)) + (let (type description disposition) + (when (or (memq 'type mml-dnd-attach-options) + (memq 'disposition mml-dnd-attach-options)) + (setq type (mml-minibuffer-read-type file))) + (when (memq 'description mml-dnd-attach-options) + (setq description (mml-minibuffer-read-description))) + (when (memq 'disposition mml-dnd-attach-options) + (setq disposition (mml-minibuffer-read-disposition type nil file))) + (mml-attach-file file type description disposition))))) + 'private) + +(put 'mml-dnd-attach-file 'dnd-multiple-handler t) (defun mml-attach-buffer (buffer &optional type description disposition filename) "Attach a buffer to the outgoing MIME message. diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el index 342b6e49be4..7a7f54ba0bb 100644 --- a/test/lisp/dnd-tests.el +++ b/test/lisp/dnd-tests.el @@ -531,7 +531,69 @@ dnd-tests-receive-multiple-urls dnd-tests-list-4) 'copy) 'private)) - (should (equal (buffer-string) (nth 4 dnd-tests-list-4)))))) + (should (equal (buffer-string) (nth 4 dnd-tests-list-4)))) + ;; Check that a handler enumerated twice in the handler list + ;; receives URIs assigned to it only once. + (let* ((received-p nil) + (lambda (lambda (uri _action) + (should (equal uri "scheme1://test")) + (should (null received-p)) + (setq received-p 'copy)))) + (setq dnd-protocol-alist (list (cons "scheme1://" lambda) + (cons "scheme1://" lambda))) + (should (equal (dnd-handle-multiple-urls (selected-window) + (list "scheme1://test") + 'copy) + 'copy))))) + +(ert-deftest dnd-tests-default-file-name-handlers () + (let* ((local-files-opened nil) + (remote-files-opened nil) + (function-1 (lambda (file _uri) + (push file local-files-opened) + 'copy)) + (function-2 (lambda (file _uri) + (push file remote-files-opened) + 'copy))) + (unwind-protect + (progn + (advice-add #'dnd-open-local-file :override + function-1) + (advice-add #'dnd-open-file :override + function-2) + ;; Guarantee that file names are properly categorized as either + ;; local or remote by the default dnd-protocol-alist. + (dnd-handle-multiple-urls + (selected-window) + (list + ;; These are run-of-the-mill local file URIs. + "file:///usr/include/sys/acct.h" + "file:///usr/include/sys/acctctl.h" + ;; These URIs incorporate a host; they should match + ;; function-2 but never function-1. + "file://remotehost/usr/src/emacs/configure.ac" + "file://remotehost/usr/src/emacs/configure" + ;; These URIs are generated by drag-and-drop event + ;; handlers from local file names alone; they are not + ;; echt URIs in and of themselves, but a product of our + ;; drag and drop code. + "file:/etc/vfstab" + "file:/etc/dfs/sharetab" + ;; These URIs are generated under MS-Windows. + "file:c:/path/to/file/name" + "file:d:/path/to/file/name") + 'copy) + (should (equal (sort local-files-opened #'string<) + '("file:///usr/include/sys/acct.h" + "file:///usr/include/sys/acctctl.h" + "file:/etc/dfs/sharetab" + "file:/etc/vfstab" + "file:c:/path/to/file/name" + "file:d:/path/to/file/name"))) + (should (equal (sort remote-files-opened #'string<) + '("file://remotehost/usr/src/emacs/configure" + "file://remotehost/usr/src/emacs/configure.ac")))) + (advice-remove #'dnd-open-local-file function-2)))) (provide 'dnd-tests) ;;; dnd-tests.el ends here commit 6b229ffc6f32b111bf11242080d98022758b43e0 Author: Manuel Giraud Date: Sat Oct 21 14:36:24 2023 +0200 Support for menu bar in window_from_coordinates * src/window.h: * src/window.c (window_from_coordinates): In the no toolkit build, add support for the menu bar window. Add a new 'menu_bar_p' argument so the function's signature has changed. All callers changed. * src/androidterm.c (handle_one_android_event): * src/haikuterm.c (haiku_read_socket): * src/keyboard.c (make_lispy_position): * src/nsterm.m ([EmacsView mouseDown:]): * src/pgtkterm.c (button_event): * src/w32term.c (w32_read_socket): * src/xdisp.c (note_mouse_highlight): * src/xterm.c (handle_one_xevent): Set menu_bar_p to true. diff --git a/src/androidterm.c b/src/androidterm.c index e87f7ca2d14..4a479daf452 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -1141,7 +1141,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, Lisp_Object window = window_from_coordinates (f, event->xmotion.x, event->xmotion.y, 0, - false, false); + false, false, false); /* A window will be autoselected only when it is not selected now and the last mouse movement event was @@ -1290,7 +1290,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, int x = event->xbutton.x; int y = event->xbutton.y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tab_bar_p = EQ (window, f->tab_bar_window); if (tab_bar_p) @@ -1312,7 +1312,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, int x = event->xbutton.x; int y = event->xbutton.y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tool_bar_p = (EQ (window, f->tool_bar_window) && ((event->xbutton.type != ANDROID_BUTTON_RELEASE) @@ -1408,7 +1408,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, int y = event->touch.y; window = window_from_coordinates (any, x, y, 0, true, - true); + true, true); /* If this touch has started in the tool bar, do not send it to Lisp. Instead, simulate a tool bar @@ -1605,7 +1605,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, /* Figure out how much to scale the deltas by. */ window = window_from_coordinates (any, event->wheel.x, event->wheel.y, NULL, - false, false); + false, false, false); if (WINDOWP (window)) scroll_height = XWINDOW (window)->pixel_height; diff --git a/src/haikuterm.c b/src/haikuterm.c index b1a016b49a9..bcb5055ea42 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3472,7 +3472,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!NILP (Vmouse_autoselect_window)) { static Lisp_Object last_mouse_window; - Lisp_Object window = window_from_coordinates (f, b->x, b->y, 0, 0, 0); + Lisp_Object window = window_from_coordinates (f, b->x, b->y, 0, 0, 0, 0); if (WINDOWP (window) && !EQ (window, last_mouse_window) @@ -3555,7 +3555,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) int x = b->x; int y = b->y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tab_bar_p = EQ (window, f->tab_bar_window); if (tab_bar_p) @@ -3573,7 +3573,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) int x = b->x; int y = b->y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tool_bar_p = (EQ (window, f->tool_bar_window) && (type != BUTTON_UP || f->last_tool_bar_item != -1)); @@ -3834,7 +3834,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) BView_get_mouse (FRAME_HAIKU_VIEW (f), &x, &y); - wheel_window = window_from_coordinates (f, x, y, 0, false, false); + wheel_window = window_from_coordinates (f, x, y, 0, false, false, false); if (NILP (wheel_window)) { diff --git a/src/keyboard.c b/src/keyboard.c index dc2f78a7c26..c00f48d7836 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5562,7 +5562,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, int xret = 0, yret = 0; /* The window or frame under frame pixel coordinates (x,y) */ Lisp_Object window_or_frame = f - ? window_from_coordinates (f, mx, my, &part, true, true) + ? window_from_coordinates (f, mx, my, &part, true, true, true) : Qnil; #ifdef HAVE_WINDOW_SYSTEM bool tool_bar_p = false; diff --git a/src/msdos.c b/src/msdos.c index 1b7f2d4ae21..5dd7c1573c4 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -2662,7 +2662,7 @@ dos_rawgetc (void) static Lisp_Object last_mouse_window; mouse_window = window_from_coordinates - (SELECTED_FRAME (), mouse_last_x, mouse_last_y, 0, 0, 0); + (SELECTED_FRAME (), mouse_last_x, mouse_last_y, 0, 0, 0, 0); /* A window will be selected only when it is not selected now, and the last mouse movement event was not in it. A minibuffer window will be selected iff diff --git a/src/nsterm.m b/src/nsterm.m index 11535f071eb..46a5e8870e8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7412,7 +7412,7 @@ - (void)mouseDown: (NSEvent *)theEvent int x = lrint (p.x); int y = lrint (p.y); - window = window_from_coordinates (emacsframe, x, y, 0, true, true); + window = window_from_coordinates (emacsframe, x, y, 0, true, true, true); tab_bar_p = EQ (window, emacsframe->tab_bar_window); if (tab_bar_p) @@ -7518,7 +7518,7 @@ - (void)mouseMoved: (NSEvent *)e NSTRACE_MSG ("mouse_autoselect_window"); static Lisp_Object last_mouse_window; Lisp_Object window - = window_from_coordinates (emacsframe, pt.x, pt.y, 0, 0, 0); + = window_from_coordinates (emacsframe, pt.x, pt.y, 0, 0, 0, 0); if (WINDOWP (window) && !EQ (window, last_mouse_window) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index a7c687d811d..461c9d6d899 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -5894,7 +5894,7 @@ motion_notify_event (GtkWidget *widget, GdkEvent *event, { static Lisp_Object last_mouse_window; Lisp_Object window = window_from_coordinates - (f, event->motion.x, event->motion.y, 0, false, false); + (f, event->motion.x, event->motion.y, 0, false, false, false); /* A window will be autoselected only when it is not selected now and the last mouse movement event was @@ -6047,7 +6047,7 @@ button_event (GtkWidget *widget, GdkEvent *event, int x = event->button.x; int y = event->button.y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tab_bar_p = EQ (window, f->tab_bar_window); if (tab_bar_p) diff --git a/src/w32inevt.c b/src/w32inevt.c index 29717954cfd..630a9f4e5fb 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -496,7 +496,7 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, if (!NILP (Vmouse_autoselect_window)) { Lisp_Object mouse_window = window_from_coordinates (f, mx, my, - 0, 0, 0); + 0, 0, 0, 0); /* A window will be selected only when it is not selected now, and the last mouse movement event was not in it. A minibuffer window will be selected iff diff --git a/src/w32term.c b/src/w32term.c index a5f17a18213..301d8f4ef12 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -3376,7 +3376,7 @@ w32_construct_mouse_wheel (struct input_event *result, W32Msg *msg, if (w32_wheel_scroll_lines == UINT_MAX) { Lisp_Object window = window_from_coordinates (f, p.x, p.y, NULL, - false, false); + false, false, false); if (!WINDOWP (window)) { result->kind = NO_EVENT; @@ -5335,7 +5335,7 @@ w32_read_socket (struct terminal *terminal, { static Lisp_Object last_mouse_window; Lisp_Object window = window_from_coordinates - (f, LOWORD (msg.msg.lParam), HIWORD (msg.msg.lParam), 0, 0, 0); + (f, LOWORD (msg.msg.lParam), HIWORD (msg.msg.lParam), 0, 0, 0, 0); /* Window will be selected only when it is not selected now and last mouse movement event was @@ -5407,7 +5407,7 @@ w32_read_socket (struct terminal *terminal, int x = XFIXNAT (inev.x); int y = XFIXNAT (inev.y); - window = window_from_coordinates (f, x, y, 0, 1, 1); + window = window_from_coordinates (f, x, y, 0, 1, 1, 1); if (EQ (window, f->tab_bar_window)) { @@ -5435,7 +5435,7 @@ w32_read_socket (struct terminal *terminal, int x = XFIXNAT (inev.x); int y = XFIXNAT (inev.y); - window = window_from_coordinates (f, x, y, 0, 1, 1); + window = window_from_coordinates (f, x, y, 0, 1, 1, 1); if (EQ (window, f->tool_bar_window) /* Make sure the tool bar was previously diff --git a/src/window.c b/src/window.c index 968b982c135..e802ffb3fe2 100644 --- a/src/window.c +++ b/src/window.c @@ -1680,7 +1680,8 @@ check_window_containing (struct window *w, void *user_data) Lisp_Object window_from_coordinates (struct frame *f, int x, int y, - enum window_part *part, bool tab_bar_p, bool tool_bar_p) + enum window_part *part, bool menu_bar_p, + bool tab_bar_p, bool tool_bar_p) { Lisp_Object window; struct check_window_data cw; @@ -1693,6 +1694,21 @@ window_from_coordinates (struct frame *f, int x, int y, cw.window = &window, cw.x = x, cw.y = y; cw.part = part; foreach_window (f, check_window_containing, &cw); +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_MENU_BAR) + /* If not found above, see if it's in the menu bar window, if a menu + bar exists. */ + if (NILP (window) + && menu_bar_p + && WINDOWP (f->menu_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->menu_bar_window)) > 0 + && (coordinates_in_window (XWINDOW (f->menu_bar_window), x, y) + != ON_NOTHING)) + { + *part = ON_TEXT; + window = f->menu_bar_window; + } +#endif + #if defined (HAVE_WINDOW_SYSTEM) /* If not found above, see if it's in the tab bar window, if a tab bar exists. */ @@ -1746,7 +1762,7 @@ DEFUN ("window-at", Fwindow_at, Swindow_at, 2, 3, 0, + FRAME_INTERNAL_BORDER_WIDTH (f)), (FRAME_PIXEL_Y_FROM_CANON_Y (f, y) + FRAME_INTERNAL_BORDER_WIDTH (f)), - 0, false, false); + 0, false, false, false); } ptrdiff_t diff --git a/src/window.h b/src/window.h index 413293420fd..9ef8434af18 100644 --- a/src/window.h +++ b/src/window.h @@ -1111,7 +1111,7 @@ #define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \ extern Lisp_Object make_window (void); extern Lisp_Object window_from_coordinates (struct frame *, int, int, - enum window_part *, bool, bool); + enum window_part *, bool, bool, bool); extern void resize_frame_windows (struct frame *, int, bool); extern void restore_window_configuration (Lisp_Object); extern void delete_all_child_windows (Lisp_Object); diff --git a/src/xdisp.c b/src/xdisp.c index b9009df5df9..578131a4005 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2778,7 +2778,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) goto virtual_glyph; } else if (!f->glyphs_initialized_p - || (window = window_from_coordinates (f, gx, gy, &part, false, false), + || (window = window_from_coordinates (f, gx, gy, &part, false, false, false), NILP (window))) { width = FRAME_SMALLEST_CHAR_WIDTH (f); @@ -35438,7 +35438,7 @@ note_mouse_highlight (struct frame *f, int x, int y) return; /* Which window is that in? */ - window = window_from_coordinates (f, x, y, &part, true, true); + window = window_from_coordinates (f, x, y, &part, true, true, true); /* If displaying active text in another window, clear that. */ if (! EQ (window, hlinfo->mouse_face_window) diff --git a/src/xterm.c b/src/xterm.c index 5d491e63778..d01c4da0564 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -21171,7 +21171,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } Lisp_Object window = window_from_coordinates - (f, xmotion.x, xmotion.y, 0, false, false); + (f, xmotion.x, xmotion.y, 0, false, false, false); /* A window will be autoselected only when it is not selected now and the last mouse movement event was @@ -21902,7 +21902,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, int x = event->xbutton.x; int y = event->xbutton.y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tab_bar_p = EQ (window, f->tab_bar_window); if (tab_bar_p) @@ -21923,7 +21923,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, int x = event->xbutton.x; int y = event->xbutton.y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tool_bar_p = (EQ (window, f->tool_bar_window) && (event->xbutton.type != ButtonRelease || f->last_tool_bar_item != -1)); @@ -22656,7 +22656,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, continue; window = window_from_coordinates (f, real_x, real_y, NULL, - false, false); + false, false, false); if (WINDOWP (window)) scroll_height = XWINDOW (window)->pixel_height; @@ -23099,7 +23099,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, || !NILP (focus_follows_mouse))) { static Lisp_Object last_mouse_window; - Lisp_Object window = window_from_coordinates (f, ev.x, ev.y, 0, false, false); + Lisp_Object window = window_from_coordinates (f, ev.x, ev.y, 0, false, false, + false); /* A window will be autoselected only when it is not selected now and the last mouse movement event was @@ -23677,7 +23678,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, int x = bv.x; int y = bv.y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); tab_bar_p = EQ (window, f->tab_bar_window); if (tab_bar_p) @@ -23698,7 +23699,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, int x = bv.x; int y = bv.y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); /* Ignore button release events if the mouse wasn't previously pressed on the tool bar. We do this because otherwise selecting some @@ -24704,7 +24705,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, int x = xev->event_x; int y = xev->event_y; - window = window_from_coordinates (f, x, y, 0, true, true); + window = window_from_coordinates (f, x, y, 0, true, true, true); /* Ignore button release events if the mouse wasn't previously pressed on the tool bar. We do this because otherwise selecting some commit 1e5760ed786667113d4e144504ca7a981d25cf37 Author: Stefan Monnier Date: Sat Oct 28 01:17:03 2023 -0400 (auth-source-backend): Don't pass obsolete "name" arg * lisp/auth-source.el (auth-source-backends-parser-file) (auth-source-backends-parser-macos-keychain) (auth-source-backends-parser-secrets): Remove unused "name" argument to `auth-source-backend` constructor. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 365f6697ec8..583b6e57897 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -387,7 +387,6 @@ auth-source-backends-parser-file (cond ((equal extension "plist") (auth-source-backend - source :source source :type 'plstore :search-function #'auth-source-plstore-search @@ -395,13 +394,11 @@ auth-source-backends-parser-file :data (plstore-open source))) ((member-ignore-case extension '("json")) (auth-source-backend - source :source source :type 'json :search-function #'auth-source-json-search)) (t (auth-source-backend - source :source source :type 'netrc :search-function #'auth-source-netrc-search @@ -449,7 +446,6 @@ auth-source-backends-parser-macos-keychain (setq source (symbol-name source))) (auth-source-backend - (format "Mac OS Keychain (%s)" source) :source source :type keychain-type :search-function #'auth-source-macos-keychain-search @@ -490,7 +486,6 @@ auth-source-backends-parser-secrets (if (featurep 'secrets) (auth-source-backend - (format "Secrets API (%s)" source) :source source :type 'secrets :search-function #'auth-source-secrets-search @@ -498,7 +493,6 @@ auth-source-backends-parser-secrets (auth-source-do-warn "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry) (auth-source-backend - (format "Ignored Secrets API (%s)" source) :source "" :type 'ignore)))))) commit f0d42c5e47eaba2c8ccee0a804965a2b71923d41 Author: Po Lu Date: Sat Oct 28 10:02:58 2023 +0800 Minor adjustments to Android drag and drop and content URIs * java/org/gnu/emacs/EmacsWindow.java (EmacsWindow) : New fields initialized to -1. (onDragEvent): Remember the position of the previous event to avoid sending duplicates. * src/androidvfs.c (EMACS_PATH_MAX): New define. (android_saf_tree_rename, android_saf_tree_opendir) (android_name_file, android_fstatat, android_faccessat) (android_fchmodat, android_readlinkat): Use EMACS_PATH_MAX where SAF file names might be encountered. diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 7662186a0eb..d7a37a8d57f 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -152,6 +152,10 @@ private static class Coordinate /* The position of this window relative to the root window. */ public int xPosition, yPosition; + /* The position of the last drag and drop event received; both + values are -1 if no drag and drop operation is under way. */ + private int dndXPosition, dndYPosition; + public EmacsWindow (short handle, final EmacsWindow parent, int x, int y, int width, int height, boolean overrideRedirect) @@ -202,6 +206,9 @@ private static class Coordinate return size () > 10; } }; + + dndXPosition = -1; + dndYPosition = -1; } public void @@ -1617,11 +1624,26 @@ else if (EmacsWindow.this.isMapped) return true; case DragEvent.ACTION_DRAG_LOCATION: - /* Send this drag motion event to Emacs. */ - EmacsNative.sendDndDrag (handle, x, y); + /* Send this drag motion event to Emacs. Skip this when the + integer position hasn't changed, for Android sends events + even if the movement from the previous position of the drag + is less than 1 pixel on either axis. */ + + if (x != dndXPosition || y != dndYPosition) + { + EmacsNative.sendDndDrag (handle, x, y); + dndXPosition = x; + dndYPosition = y; + } + return true; case DragEvent.ACTION_DROP: + /* Reset this view's record of the previous drag and drop + event's position. */ + dndXPosition = -1; + dndYPosition = -1; + /* Judge whether this is plain text, or if it's a file URI for which permissions must be requested. */ @@ -1706,8 +1728,13 @@ else if (type.equals (ClipDescription.MIMETYPE_TEXT_URILIST)) if (builder.length () > 0) EmacsNative.sendDndUri (handle, x, y, builder.toString ()); - return true; + + default: + /* Reset this view's record of the previous drag and drop + event's position. */ + dndXPosition = -1; + dndYPosition = -1; } return true; diff --git a/src/androidvfs.c b/src/androidvfs.c index b3d644e21a2..51558d2a375 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -403,6 +403,16 @@ #define FIND_METHOD(c_name, name, signature) \ +/* Account for SAF file names two times as large as PATH_MAX; larger + values are prohibitively slow, but smaller values can't face up to + some long file names within several nested layers of directories. + + Buffers holding components or other similar file name constitutents + which don't represent SAF files must continue to use PATH_MAX, for + that is the restriction imposed by the Unix file system. */ + +#define EMACS_PATH_MAX (PATH_MAX * 2) + /* Delete redundant instances of `.' and `..' from NAME in-place. NAME must be *LENGTH long, excluding a mandatory trailing NULL byte. @@ -4990,7 +5000,7 @@ android_saf_tree_rename (struct android_vnode *src, { char *last, *dst_last; struct android_saf_tree_vnode *vp, *vdst; - char path[PATH_MAX], path1[PATH_MAX]; + char path[EMACS_PATH_MAX], path1[EMACS_PATH_MAX]; char *fill, *dst_id; int rc; @@ -5076,8 +5086,8 @@ android_saf_tree_rename (struct android_vnode *src, /* The names of the source and destination directories will have to be copied to path. */ - if (last - vp->name >= PATH_MAX - || dst_last - vdst->name >= PATH_MAX) + if (last - vp->name >= EMACS_PATH_MAX + || dst_last - vdst->name >= EMACS_PATH_MAX) { errno = ENAMETOOLONG; return -1; @@ -5191,7 +5201,7 @@ android_saf_tree_rename (struct android_vnode *src, directory is required, as it provides the directory whose entries will be modified. */ - if (last - vp->name >= PATH_MAX) + if (last - vp->name >= EMACS_PATH_MAX) { errno = ENAMETOOLONG; return -1; @@ -5480,7 +5490,7 @@ android_saf_tree_opendir (struct android_vnode *vnode) struct android_saf_tree_vdir *dir; char *fill, *end; jobject cursor; - char component[PATH_MAX]; + char component[EMACS_PATH_MAX]; vp = (struct android_saf_tree_vnode *) vnode; @@ -5510,7 +5520,7 @@ android_saf_tree_opendir (struct android_vnode *vnode) if (!end) emacs_abort (); - if (end - fill >= PATH_MAX) + if (end - fill >= EMACS_PATH_MAX) { errno = ENAMETOOLONG; xfree (dir); @@ -6455,7 +6465,7 @@ android_root_name (struct android_vnode *vnode, char *name, least N bytes. NAME may be either an absolute file name or a name relative to the - current working directory. It must not be longer than PATH_MAX + current working directory. It must not be longer than EMACS_PATH_MAX bytes. Value is NULL upon failure with errno set accordingly, or the @@ -6464,14 +6474,14 @@ android_root_name (struct android_vnode *vnode, char *name, static struct android_vnode * android_name_file (const char *name) { - char buffer[PATH_MAX + 1], *head; + char buffer[EMACS_PATH_MAX + 1], *head; const char *end; size_t len; int nslash, c; struct android_vnode *vp; len = strlen (name); - if (len > PATH_MAX) + if (len > EMACS_PATH_MAX) { errno = ENAMETOOLONG; return NULL; @@ -7009,7 +7019,7 @@ android_fstatat_1 (int dirfd, const char *filename, android_fstatat (int dirfd, const char *restrict pathname, struct stat *restrict statbuf, int flags) { - char buffer[PATH_MAX + 1]; + char buffer[EMACS_PATH_MAX + 1]; struct android_vnode *vp; int rc; @@ -7023,7 +7033,7 @@ android_fstatat (int dirfd, const char *restrict pathname, /* Now establish whether DIRFD is a file descriptor corresponding to an open VFS directory stream. */ - if (!android_fstatat_1 (dirfd, pathname, buffer, PATH_MAX + 1)) + if (!android_fstatat_1 (dirfd, pathname, buffer, EMACS_PATH_MAX + 1)) { pathname = buffer; goto vfs; @@ -7049,7 +7059,7 @@ android_fstatat (int dirfd, const char *restrict pathname, android_faccessat (int dirfd, const char *restrict pathname, int mode, int flags) { - char buffer[PATH_MAX + 1]; + char buffer[EMACS_PATH_MAX + 1]; struct android_vnode *vp; int rc; @@ -7063,7 +7073,7 @@ android_faccessat (int dirfd, const char *restrict pathname, /* Now establish whether DIRFD is a file descriptor corresponding to an open VFS directory stream. */ - if (!android_fstatat_1 (dirfd, pathname, buffer, PATH_MAX + 1)) + if (!android_fstatat_1 (dirfd, pathname, buffer, EMACS_PATH_MAX + 1)) { pathname = buffer; goto vfs; @@ -7089,7 +7099,7 @@ android_faccessat (int dirfd, const char *restrict pathname, android_fchmodat (int dirfd, const char *pathname, mode_t mode, int flags) { - char buffer[PATH_MAX + 1]; + char buffer[EMACS_PATH_MAX + 1]; struct android_vnode *vp; int rc; @@ -7099,7 +7109,7 @@ android_fchmodat (int dirfd, const char *pathname, mode_t mode, /* Now establish whether DIRFD is a file descriptor corresponding to an open VFS directory stream. */ - if (!android_fstatat_1 (dirfd, pathname, buffer, PATH_MAX + 1)) + if (!android_fstatat_1 (dirfd, pathname, buffer, EMACS_PATH_MAX + 1)) { pathname = buffer; goto vfs; @@ -7125,7 +7135,7 @@ android_fchmodat (int dirfd, const char *pathname, mode_t mode, android_readlinkat (int dirfd, const char *restrict pathname, char *restrict buf, size_t bufsiz) { - char buffer[PATH_MAX + 1]; + char buffer[EMACS_PATH_MAX + 1]; struct android_vnode *vp; ssize_t rc; @@ -7135,7 +7145,7 @@ android_readlinkat (int dirfd, const char *restrict pathname, /* Now establish whether DIRFD is a file descriptor corresponding to an open VFS directory stream. */ - if (!android_fstatat_1 (dirfd, pathname, buffer, PATH_MAX + 1)) + if (!android_fstatat_1 (dirfd, pathname, buffer, EMACS_PATH_MAX + 1)) { pathname = buffer; goto vfs; commit eb6708f0ac129f2faee31b1f5517641ffb38fcdf Author: Stefan Monnier Date: Fri Oct 27 21:17:38 2023 -0400 (c-initialize-cc-mode): Be slightly more explicit * lisp/progmodes/cc-mode.el (c-initialize-cc-mode): Don't depend on the fact that `post-text-conversion-hook` is "local only". diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 8dea599ed98..227a6af2a6b 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -257,7 +257,7 @@ c-initialize-cc-mode ;; Set up text conversion, for Emacs >= 30.0 (when (boundp 'post-text-conversion-hook) - (add-hook 'post-text-conversion-hook #'c-post-text-conversion)) + (add-hook 'post-text-conversion-hook #'c-post-text-conversion nil t)) (unless new-style-init (c-init-language-vars-for 'c-mode))) commit 81510f2fff5e61c6fca359e01870139f1302e1ed Author: Stefan Monnier Date: Fri Oct 27 20:18:54 2023 -0400 (provided-mode-derived-p): Fix alias case The new handling of aliases in `provided-mode-derived-p` introduced in Emacs-28.1 caused a regression where (provided-mode-derived-p MODE MODE) returns nil if MODE is an alias. Rework the loop so we consider an alias as a kind of parent. * lisp/subr.el (provided-mode-derived-p): Step over aliases separately. * test/lisp/subr-tests.el (subr-tests--derived-mode-1) (subr-tests--derived-mode-2): Move out of `provided-mode-derived-p` and give them properly namespaced names. (provided-mode-derived-p): Add more tests for aliases. diff --git a/lisp/subr.el b/lisp/subr.el index 12e33380260..d4173b4daba 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2682,17 +2682,15 @@ provided-mode-derived-p "Non-nil if MODE is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." - ;; If MODE is an alias, then look up the real mode function first. (declare (side-effect-free t)) - (when-let ((alias (symbol-function mode))) - (when (symbolp alias) - (setq mode alias))) (while (and (not (memq mode modes)) - (let* ((parent (get mode 'derived-mode-parent)) - (parentfn (symbol-function parent))) - (setq mode (if (and parentfn (symbolp parentfn)) parentfn parent))))) + (let* ((parent (get mode 'derived-mode-parent))) + (setq mode (or parent + ;; If MODE is an alias, then follow the alias. + (let ((alias (symbol-function mode))) + (and (symbolp alias) alias))))))) mode) (defun derived-mode-p (&rest modes) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 0d409cead26..db327056533 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -348,15 +348,17 @@ subr-test-global-key-binding (defalias 'subr-tests--parent-mode (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) +(define-derived-mode subr-tests--derived-mode-1 prog-mode "test") +(define-derived-mode subr-tests--derived-mode-2 subr-tests--parent-mode "test") (ert-deftest provided-mode-derived-p () ;; base case: `derived-mode' directly derives `prog-mode' - (should (progn - (define-derived-mode derived-mode prog-mode "test") - (provided-mode-derived-p 'derived-mode 'prog-mode))) - ;; edge case: `derived-mode' derives an alias of `prog-mode' - (should (progn - (define-derived-mode derived-mode subr-tests--parent-mode "test") - (provided-mode-derived-p 'derived-mode 'prog-mode)))) + (should (provided-mode-derived-p 'subr-tests--derived-mode-1 'prog-mode)) + ;; Edge cases: aliases along the derivation. + (should (provided-mode-derived-p 'subr-tests--parent-mode + 'subr-tests--parent-mode)) + (should (provided-mode-derived-p 'subr-tests--derived-mode-2 + 'subr-tests--parent-mode)) + (should (provided-mode-derived-p 'subr-tests--derived-mode-2 'prog-mode))) (ert-deftest number-sequence-test () (should (= (length commit 9acd8c8e530dda326ae5bf852c2437fdcde4e8cc Author: F. Jason Park Date: Sat Sep 2 13:43:22 2023 -0700 Tidy up ERC's internal text-property API * lisp/erc/erc-fill.el (erc-fill--spaced-commands): Remove unused internal variable originally intended for ERC 5.6. (erc-fill): Check for `erc-msg' being `msg', which carries the same meaning as `erc-cmd' being `PRIVMSG' or `NOTICE', except that inserted outgoing messages now no longer normally have an `erc-cmd' property. (erc-fill-wrap-mode, erc-fill-wrap-disable): Kill `erc-fill--wrap-last-msg'. (erc-fill--wrap-max-lull): Convert from buffer-local to normal variable. (erc-fill--wrap-continued-message-p): Rework slightly to guard against resetting the "last speaker" marker when the `erc-ephemeral' text property is present. This tells insert- and send-related hook members to pretend the current message doesn't exist when performing stateful operations. That is, modules should expect the message being inserted to possibly disappear or be replaced. Also, look for `erc-msg' being `msg' instead of `erc-cmd' being `PRIVMSG', and fix bug involving only checking `erc-ctcp' in the current message. * lisp/erc/erc-stamp.el (erc-add-timestamp): Don't insert timestamps when the `erc-ephemeral' text property is present. * lisp/erc/erc.el (erc--msg-props): Add doc string explaining the purpose of this variable and the various text properties most commonly present in its value. (erc--msg-prop-overrides): Add doc string. (erc-send-action): Don't set `erc-cmd' prop on outgoing CTCP ACTIONs. (erc-display-message): Reverse overrides to prefer items toward the front of the alist. (erc-process-ctcp-query): Include existing overrides from environs. (erc-send-current-line): Include existing overrides from environs. (erc-display-msg): Fix doc string and reverse overrides. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--insert-privmsg): Remove stray comment. (erc-fill-tests--save-p): Set value from environment variable. (erc-fill-tests--compare): Limit writing snapshots to one test at a time. (erc-fill-wrap--merge-action): Fix expected output for non-action messages that follow action messages. These were previously merged but escaped detection. * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update. (Bug#60936) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index e28c3563ebf..e8f3f624ff1 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -145,10 +145,6 @@ erc-fill-line-spacing :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) number)) -(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE) - "Types of messages to add space between on graphical displays. -Only considered when `erc-fill-line-spacing' is non-nil.") - (defvar-local erc-fill--function nil "Internal copy of `erc-fill-function'. Takes precedence over the latter when non-nil.") @@ -175,11 +171,11 @@ erc-fill (when-let* ((erc-fill-line-spacing) (p (point-min))) (widen) - (when (or (erc--check-msg-prop 'erc-cmd erc-fill--spaced-commands) - (and-let* ((cmd (save-excursion - (forward-line -1) - (get-text-property (point) 'erc-cmd)))) - (memq cmd erc-fill--spaced-commands))) + (when (or (erc--check-msg-prop 'erc-msg 'msg) + (and-let* ((m (save-excursion + (forward-line -1) + (erc--get-inserted-msg-prop 'erc-msg)))) + (eq 'msg m))) (put-text-property (1- p) p 'line-spacing erc-fill-line-spacing)))))))) @@ -463,6 +459,7 @@ fill-wrap (kill-local-variable 'erc-fill--wrap-value) (kill-local-variable 'erc-fill--function) (kill-local-variable 'erc-fill--wrap-visual-keys) + (kill-local-variable 'erc-fill--wrap-last-msg) (remove-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p t)) 'local) @@ -479,13 +476,17 @@ erc-fill--wrap-length-function parties.") (defvar-local erc-fill--wrap-last-msg nil) -(defvar-local erc-fill--wrap-max-lull (* 24 60 60)) +(defvar erc-fill--wrap-max-lull (* 24 60 60)) (defun erc-fill--wrap-continued-message-p () "Return non-nil when the current speaker hasn't changed. That is, indicate whether the text just inserted is from the same sender as that of the previous \"PRIVMSG\"." - (prog1 (and-let* + (and + (not (erc--check-msg-prop 'erc-ephemeral)) + (progn ; preserve blame for now, unprogn on next major change + (prog1 + (and-let* ((m (or erc-fill--wrap-last-msg (setq erc-fill--wrap-last-msg (point-min-marker)) nil)) @@ -493,8 +494,9 @@ erc-fill--wrap-continued-message-p (props (save-restriction (widen) (and-let* - (((eq 'PRIVMSG (get-text-property m 'erc-cmd))) - ((not (eq (get-text-property m 'erc-msg) 'ACTION))) + (((eq 'msg (get-text-property m 'erc-msg))) + ((not (eq (get-text-property m 'erc-ctcp) + 'ACTION))) ((not (invisible-p m))) (spr (next-single-property-change m 'erc-speaker))) (cons (get-text-property m 'erc-ts) @@ -509,7 +511,7 @@ erc-fill--wrap-continued-message-p ((not (erc--check-msg-prop 'erc-ctcp 'ACTION))) (nick (get-text-property speaker 'erc-speaker)) ((erc-nick-equal-p props nick)))) - (set-marker erc-fill--wrap-last-msg (point-min)))) + (set-marker erc-fill--wrap-last-msg (point-min)))))) (defun erc-fill--wrap-measure (beg end) "Return display spec width for inserted region between BEG and END. diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index daa33cac3b2..b3812470a4d 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -243,7 +243,8 @@ erc-add-timestamp (erc-stamp--invisible-property ;; FIXME on major version bump, make this `erc-' prefixed. (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp)) - (skipp (and erc-stamp--skip-when-invisible invisible)) + (skipp (or (and erc-stamp--skip-when-invisible invisible) + (erc--check-msg-prop 'erc-ephemeral))) (erc-stamp--current-time ct)) (when erc--msg-props (puthash 'erc-ts ct erc--msg-props)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 872ce5b4f49..0471ee0bbb8 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -136,8 +136,62 @@ erc-scripts :group 'erc) (defvar erc-message-parsed) ; only known to this file -(defvar erc--msg-props nil) -(defvar erc--msg-prop-overrides nil) + +(defvar erc--msg-props nil + "Hash table containing metadata properties for current message. +Provided by the insertion functions `erc-display-message' and +`erc-display-msg' while running their modification hooks. +Initialized when null for each visitation round from function +parameters and environmental factors, as well as the alist +`erc--msg-prop-overrides'. Keys are symbols. Values are opaque +objects, unless otherwise specified. Items present after running +`erc-insert-post-hook' or `erc-send-post-hook' become text +properties added to the first character of an inserted message. +A given message therefore spans the interval extending from one +set of such properties to the newline before the next (or +`erc-insert-marker'). As of ERC 5.6, this forms the basis for +visiting and editing inserted messages. Modules should align +their markers accordingly. The following properties have meaning +as of ERC 5.6: + + - `erc-msg': a symbol, guaranteed present; values include: + + - `msg', signifying a `PRIVMSG' or an incoming `NOTICE' + - `self', a fallback used by `erc-display-msg' for callers + that don't specify an `erc-msg' + - `unknown', a similar fallback for `erc-display-message' + - a catalog key, such as `s401' or `finished' + - an `erc-display-message' TYPE parameter, like `notice' + + - `erc-cmd': a message's associated IRC command, as read by + `erc--get-eq-comparable-cmd'; currently either a symbol, like + `PRIVMSG', or a number, like 5, which represents the numeric + \"005\"; absent on \"local\" messages, such as simple warnings + and help text, and on outgoing messages unless echoed back by + the server (assuming future support) + + - `erc-ctcp': a CTCP command, like `ACTION' + + - `erc-ts': a timestamp, possibly provided by the server; as of + 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\" + type otherwise; managed by the `stamp' module + + - `erc-ephemeral': a symbol prefixed by or matching a module + name; indicates to other modules and members of modification + hooks that the current message should not affect stateful + operations, such as recording a channel's most recent speaker + +This is an internal API, and the selection of related helper +utilities is fluid and provisional. As of ERC 5.6, see the +functions `erc--check-msg-prop' and `erc--get-inserted-msg-prop'.") + +(defvar erc--msg-prop-overrides nil + "Alist of \"message properties\" for populating `erc--msg-props'. +These override any defaults normally shown to modification hooks +by `erc-display-msg' and `erc-display-message'. Modules should +accommodate existing overrides when applicable. Items toward the +front shadow any that follow. Ignored when `erc--msg-props' is +already non-nil.") ;; Forward declarations (defvar tabbar--local-hlf) @@ -2898,9 +2952,9 @@ erc-send-action "Send CTCP ACTION information described by STR to TGT." (erc-send-ctcp-message tgt (format "ACTION %s" str) force) ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us. - (let ((erc--msg-prop-overrides '((erc-msg . msg) - (erc-cmd . PRIVMSG) - (erc-ctcp . ACTION))) + (let ((erc--msg-prop-overrides `((erc-msg . msg) + (erc-ctcp . ACTION) + ,@erc--msg-prop-overrides)) (nick (erc-current-nick))) (setq nick (propertize nick 'erc-speaker nick)) (erc-display-message nil '(t action input) (current-buffer) @@ -3554,9 +3608,9 @@ erc-display-message table) (when cmd (puthash 'erc-cmd cmd table)) - (and erc--msg-prop-overrides - (pcase-dolist (`(,k . ,v) erc--msg-prop-overrides) - (puthash k v table))) + (and-let* ((ovs erc--msg-prop-overrides)) + (pcase-dolist (`(,k . ,v) (reverse ovs)) + (puthash k v table))) table))) (erc-message-parsed parsed)) (setq string @@ -5830,7 +5884,8 @@ erc-process-ctcp-query (let* ((type (upcase (car (split-string (car queries))))) (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))) (erc--msg-prop-overrides `((erc-msg . msg) - (erc-ctcp . ,(intern type))))) + (erc-ctcp . ,(intern type)) + ,@erc--msg-prop-overrides))) (if (and hook (boundp hook)) (if (string-equal type "ACTION") (run-hook-with-args-until-success @@ -6835,8 +6890,8 @@ erc-send-current-line (when-let (((not (erc--input-split-abortp state))) (inhibit-read-only t) (old-buf (current-buffer))) - (let ((erc--msg-prop-overrides '((erc-cmd . PRIVMSG) - (erc-msg . msg)))) + (let ((erc--msg-prop-overrides `((erc-msg . msg) + ,@erc--msg-prop-overrides))) (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt (delete-region erc-input-marker (erc-end-of-input-line)) @@ -6978,15 +7033,18 @@ erc-send-input t))))) (defun erc-display-msg (line) - "Display LINE as a message of the user to the current target at point." + "Insert LINE into current buffer and run \"send\" hooks. +Expect LINE to originate from input submitted interactively at +the prompt, such as outgoing chat messages or echoed slash +commands." (when erc-insert-this (save-excursion (erc--assert-input-bounds) (let ((insert-position (marker-position (goto-char erc-insert-marker))) - (erc--msg-props (or erc--msg-props - (map-into (cons '(erc-msg . self) - erc--msg-prop-overrides) - 'hash-table))) + (erc--msg-props (or erc--msg-props ; prefer `self' to `unknown' + (let ((ovs erc--msg-prop-overrides)) + (map-into `((erc-msg . self) ,@(reverse ovs)) + 'hash-table)))) beg) (insert (erc-format-my-nick)) (setq beg (point)) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 80f5fd22ac6..92424d1e556 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -33,7 +33,6 @@ erc-fill-tests--insert-privmsg (declare (indent 1)) (let* ((msg (erc-format-privmessage speaker (apply #'concat msg-parts) nil t)) - ;; (erc--msg-prop-overrides '((erc-msg . msg) (erc-cmd . PRIVMSG))) (parsed (make-erc-response :unparsed msg :sender speaker :command "PRIVMSG" :command-args (list "#chan" msg) @@ -129,10 +128,10 @@ erc-fill-tests--wrap-check-prefixes (should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix) '(space :width erc-fill--wrap-value)))))) -;; Set this variable to t to generate new snapshots after carefully +;; Use this variable to generate new snapshots after carefully ;; reviewing the output of *each* snapshot (not just first and last). ;; Obviously, only run one test at a time. -(defvar erc-fill-tests--save-p nil) +(defvar erc-fill-tests--save-p (getenv "ERC_TESTS_FILL_SAVE")) ;; On graphical displays, echo .graphic >> .git/info/exclude (defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic") @@ -162,8 +161,12 @@ erc-fill-tests--compare (insert (setq got (read repr)))) (erc-mode)) (if erc-fill-tests--save-p - (with-temp-file expect-file - (insert repr)) + (let (inhibit-message) + (with-temp-file expect-file + (insert repr)) + ;; Limit writing snapshots to one test at a time. + (setq erc-fill-tests--save-p nil) + (message "erc-fill-tests--compare: wrote %S" expect-file)) (if (file-exists-p expect-file) ;; Ensure string-valued properties, like timestamps, aren't ;; recursive (signals `max-lisp-eval-depth' exceeded). @@ -297,16 +300,20 @@ erc-fill-wrap--merge-action ;; Set this here so that the first few messages are from 1970 (let ((erc-fill-tests--time-vals (lambda () 1680332400))) (erc-fill-tests--insert-privmsg "bob" "zero.") + (erc-fill-tests--insert-privmsg "bob" "0.5") (erc-process-ctcp-query erc-server-process (make-erc-response - :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one\1" - :sender "bob!~u@fake" :command "PRIVMSG" - :command-args '("#chan" "\1ACTION one\1") :contents "\1ACTION one\1") + :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1" + :sender "bob!~u@fake" + :command "PRIVMSG" + :command-args '("#chan" "\1ACTION one.\1") + :contents "\1ACTION one.\1") "bob" "~u" "fake") (erc-fill-tests--insert-privmsg "bob" "two.") + (erc-fill-tests--insert-privmsg "bob" "2.5") ;; Compat switch to opt out of overhanging speaker. (let (erc-fill--wrap-action-dedent-p) 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 82c6d52cf7c..f966daeed1f 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* bob one\n two.\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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg 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-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 1680332400 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-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-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#)) +#("\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-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-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 1680332400 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-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-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 msg 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-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-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 msg 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-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 commit 5c4a9b73031f1607e4f793c5c0ef27004cc258db Author: F. Jason Park Date: Sat Oct 21 13:53:46 2023 -0700 Use marker for max pos in erc--traverse-inserted * lisp/erc/erc-stamp.el (erc-stamp--propertize-left-date-stamp): Run `erc-stamp--insert-date-hook' separately here instead of via `erc-insert-modify-hook'. (erc-stamp--insert-date-stamp-as-phony-message): Don't include value of `erc-stamp--insert-date-hook' in let-bound `erc-insert-modify-hook' because its members can run twice if buffer-local. Remove `erc-send-modify-hook' because it only runs via `erc-display-msg'. Shadow "pre" and "done" hooks because they don't expect to run in a narrowed buffer. Call getter for `erc-stamp--current-time'. (erc-stamp--lr-date-on-pre-modify, erc-insert-timestamp-left-and-right): Use function form of `erc-stamp--current-time' for determining current time stamp. * lisp/erc/erc.el (erc--get-inserted-msg-bounds): Fix off-by-one like thinko. (erc--traverse-inserted): Create temporary marker when END is a buffer position so that insertions and deletions are accounted for in the terminating condition. (erc--delete-inserted-message): New function. * test/lisp/erc/erc-tests.el (erc--delete-inserted-message): New test. (erc--update-modules/unknown): Improve readability slightly. * test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t-make-expecter): Indicate assertion flavor in error message. (Bug#60936) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 2ff1f3832fb..daa33cac3b2 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -638,7 +638,8 @@ erc-stamp--date-format-end (defun erc-stamp--propertize-left-date-stamp () (add-text-properties (point-min) (1- (point-max)) '(field erc-timestamp erc-stamp-type date-left)) - (erc--hide-message 'timestamp)) + (erc--hide-message 'timestamp) + (run-hooks 'erc-stamp--insert-date-hook)) ;; A kludge to pass state from insert hook to nested insert hook. (defvar erc-stamp--current-datestamp-left nil) @@ -665,19 +666,18 @@ erc-stamp--insert-date-stamp-as-phony-message (cl-assert string) (let ((erc-stamp--skip t) (erc--msg-props (map-into `((erc-msg . datestamp) - (erc-ts . ,erc-stamp--current-time)) + (erc-ts . ,(erc-stamp--current-time))) 'hash-table)) - (erc-send-modify-hook `(,@erc-send-modify-hook - erc-stamp--propertize-left-date-stamp - ,@erc-stamp--insert-date-hook)) (erc-insert-modify-hook `(,@erc-insert-modify-hook - erc-stamp--propertize-left-date-stamp - ,@erc-stamp--insert-date-hook))) + erc-stamp--propertize-left-date-stamp)) + ;; Don't run hooks that aren't expecting a narrowed buffer. + (erc-insert-pre-hook nil) + (erc-insert-done-hook nil)) (erc-display-message nil nil (current-buffer) string) (setq erc-timestamp-last-inserted-left string))) (defun erc-stamp--lr-date-on-pre-modify (_) - (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time))) + (when-let ((ct (erc-stamp--current-time)) (rendered (erc-stamp--format-date-stamp ct)) ((not (string-equal rendered erc-timestamp-last-inserted-left))) (erc-stamp--current-datestamp-left rendered) @@ -723,7 +723,7 @@ erc-insert-timestamp-left-and-right (narrow-to-region erc--insert-marker end-marker) (set-marker end-marker nil) (set-marker erc--insert-marker nil))) - (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) + (let* ((ct (erc-stamp--current-time)) (ts-right (with-suppressed-warnings ((obsolete erc-timestamp-format-right)) (if erc-timestamp-format-right diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f618fb17076..872ce5b4f49 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2980,7 +2980,7 @@ erc--get-inserted-msg-bounds (and-let* ((p (previous-single-property-change point 'erc-msg))) - (if (= p (1- point)) point (1- p))))))) + (if (= p (1- point)) p (1- p))))))) ,@(and (member only '(nil 'end)) '((e (1- (next-single-property-change (if at-start-p (1+ point) point) @@ -3005,8 +3005,12 @@ erc--with-inserted-msg ,@body))) (defun erc--traverse-inserted (beg end fn) - "Visit messages between BEG and END and run FN in narrowed buffer." - (setq end (min end (marker-position erc-insert-marker))) + "Visit messages between BEG and END and run FN in narrowed buffer. +If END is a marker, possibly update its position." + (unless (markerp end) + (setq end (set-marker (make-marker) (or end erc-insert-marker)))) + (unless (eq end erc-insert-marker) + (set-marker end (min erc-insert-marker end))) (save-excursion (goto-char beg) (let ((b (if (get-text-property (point) 'erc-msg) @@ -3018,7 +3022,9 @@ erc--traverse-inserted (save-restriction (narrow-to-region b e) (funcall fn)) - (setq b e))))) + (setq b e)))) + (unless (eq end erc-insert-marker) + (set-marker end nil))) (defvar erc--insert-marker nil "Internal override for `erc-insert-marker'.") @@ -3240,6 +3246,27 @@ erc--hide-message (cl-incf beg)) (erc--merge-prop (1- beg) (1- end) 'invisible value))))) +(defun erc--delete-inserted-message (beg-or-point &optional end) + "Remove message between BEG and END. +Expect BEG and END to match bounds as returned by the macro +`erc--get-inserted-msg-bounds'. Ensure all markers residing at +the start of the deleted message end up at the beginning of the +subsequent message." + (let ((beg beg-or-point)) + (save-restriction + (widen) + (unless end + (setq end (erc--get-inserted-msg-bounds nil beg-or-point) + beg (pop end))) + (with-silent-modifications + (if erc-legacy-invisible-bounds-p + (delete-region beg (1+ end)) + (save-excursion + (goto-char beg) + (insert-before-markers + (substring (delete-and-extract-region (1- (point)) (1+ end)) + -1)))))))) + (defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd)) (defun erc--order-text-properties-from-hash (table) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 57bf5860ac4..1af087e7e31 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1432,6 +1432,80 @@ erc-process-input-line (should-not calls)))))) +(ert-deftest erc--delete-inserted-message () + (erc-mode) + (erc--initialize-markers (point) nil) + ;; Put unique invisible properties on the line endings. + (erc-display-message nil 'notice nil "one") + (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'a) + (let ((erc--msg-prop-overrides '((erc-msg . datestamp) (erc-ts . 0)))) + (erc-display-message nil nil nil + (propertize "\n[date]" 'field 'erc-timestamp))) + (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'b) + (erc-display-message nil 'notice nil "two") + + (ert-info ("Date stamp deleted cleanly") + (goto-char 11) + (should (looking-at (rx "\n[date]"))) + (should (eq 'datestamp (get-text-property (point) 'erc-msg))) + (should (eq (point) (field-beginning (1+ (point))))) + + (erc--delete-inserted-message (point)) + + ;; Preceding line ending clobbered, replaced by trailing. + (should (looking-back (rx "*** one\n"))) + (should (looking-at (rx "*** two"))) + (should (eq 'b (get-text-property (1- (point)) 'invisible)))) + + (ert-info ("Markers at pos-bol preserved") + (erc-display-message nil 'notice nil "three") + (should (looking-at (rx "*** two"))) + + (let ((m (point-marker)) + (n (point-marker)) + (p (point))) + (set-marker-insertion-type m t) + (goto-char (point-max)) + (erc--delete-inserted-message p) + (should (= (marker-position n) p)) + (should (= (marker-position m) p)) + (goto-char p) + (set-marker m nil) + (set-marker n nil) + (should (looking-back (rx "*** one\n"))) + (should (looking-at (rx "*** three"))))) + + (ert-info ("Compat") + (erc-display-message nil 'notice nil "four") + (should (looking-at (rx "*** three\n"))) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (let ((erc-legacy-invisible-bounds-p t)) + (erc--delete-inserted-message (point)))) + (should (looking-at (rx "*** four\n")))) + + (ert-info ("Deleting most recent message preserves markers") + (let ((m (point-marker)) + (n (point-marker)) + (p (point))) + (should (equal "*** four\n" (buffer-substring p erc-insert-marker))) + (set-marker-insertion-type m t) + (goto-char (point-max)) + (erc--delete-inserted-message p) + (should (= (marker-position m) p)) + (should (= (marker-position n) p)) + (goto-char p) + (should (looking-back (rx "*** one\n"))) + (should (looking-at erc-prompt)) + (erc--assert-input-bounds) + + ;; However, `m' is now forever "trapped" at `erc-insert-marker'. + (erc-display-message nil 'notice nil "two") + (should (= m erc-insert-marker)) + (goto-char n) + (should (looking-at (rx "*** two\n"))) + (set-marker m nil) + (set-marker n nil)))) + (ert-deftest erc--order-text-properties-from-hash () (let ((table (map-into '((a . 1) (erc-ts . 0) @@ -2617,8 +2691,8 @@ erc--update-modules/unknown (obarray (obarray-make)) (err (should-error (erc--update-modules erc-modules)))) (should (equal (cadr err) "`foo' is not a known ERC module")) - (should (equal (funcall get-calls) - `((req . ,(intern-soft "erc-foo"))))))) + (should (equal (mapcar #'prin1-to-string (funcall get-calls)) + '("(req . erc-foo)"))))) ;; Module's mode command exists but lacks an associated file. (ert-info ("Bad autoload flagged as suspect") @@ -2627,10 +2701,8 @@ erc--update-modules/unknown (obarray (obarray-make)) (erc-modules (list (intern "foo")))) - ;; Create a mode activation command. + ;; Create a mode-activation command and make mode-var global. (funcall mk-cmd "foo") - - ;; Make the mode var global. (funcall mk-global "foo") ;; No local modules to return. @@ -2639,7 +2711,7 @@ erc--update-modules/unknown '("foo"))) ;; ERC requires the library via prefixed module name. (should (equal (mapcar #'prin1-to-string (funcall get-calls)) - `("(req . erc-foo)" "(erc-foo-mode . 1)")))))))) + '("(req . erc-foo)" "(erc-foo-mode . 1)")))))))) ;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to ;; load its defining library, first via the symbol property diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el b/test/lisp/erc/resources/erc-d/erc-d-t.el index cf869fb3c70..7126165fd91 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-t.el +++ b/test/lisp/erc/resources/erc-d/erc-d-t.el @@ -157,6 +157,7 @@ erc-d-t-make-expecter (let (positions) (lambda (timeout text &optional reset-from) (let* ((pos (cdr (assq (current-buffer) positions))) + (erc-d-t--wait-message-prefix (and (< timeout 0) "Sustaining: ")) (cb (lambda () (unless pos (push (cons (current-buffer) (setq pos (make-marker))) commit a4ba236e56fd71e30b9a729edaf379c0638e809a Author: F. Jason Park Date: Mon Oct 23 21:59:25 2023 -0700 Ignore date stamps completely in erc-track * etc/ERC-NEWS: Mention that date stamps no longer optionally affect the mode line. Also mention but discourage new variable 'erc-stamp-prepend-date-stamps-p'. * lisp/erc/erc-stamp.el (erc-stamp-prepend-date-stamps-p): New variable, an escape hatch to allow date stamps to once again be prepended to messages. (erc-insert-timestamp-left-and-right): Don't insert stamps as independent messages when legacy support flag `erc-stamp-prepend-date-stamps-p' is non-nil. * lisp/erc/erc-track.el (erc-track--skipped-msgs): New internal variable. (erc-track-modified-channels): In previous versions, a date stamp attached to a message for an IRC command in `erc-track-exclude-types' would have no effect on the mode line. That they were able to otherwise was probably a bug. Regardless, this distinction was lost for the worse after date stamps became independent messages with c68dc7786fc "Manage some text props for ERC insertion-hook members". To sidestep this regression, the `track' module will ignore date stamps completely from now on. Thanks to Corwin Brust for spotting this. * test/lisp/erc/erc-scenarios-stamp.el (erc-scenarios-stamp--left/display-margin-mode): Remove redundant binding. (erc-scenarios-stamp--legacy-date-stamps): New test. (Bug#60936) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 41ab9cc4c5e..f59023eae62 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -228,6 +228,12 @@ with a legitimate use for this option likely also possesses the knowledge to rig up a suitable analog with minimal effort. That said, the road to removal is long. +** The 'track' module always ignores date stamps. +Users of the stamp module who leave 'erc-insert-timestamp-function' +set to its default of 'erc-insert-timestamp-left-and-right' will find +that date stamps no longer affect the mode line, even for IRC commands +not included in 'erc-track-exclude-types'. + ** Option 'erc-warn-about-blank-lines' is more informative. Enabled by default, this option now produces more useful feedback whenever ERC rejects prompt input containing whitespace-only lines. @@ -348,7 +354,9 @@ leading portion of message bodies as well as special casing to act on these areas without inflicting collateral damage. It may also be worth noting that as consequence of these changes, the internally managed variable 'erc-timestamp-last-inserted-left' no longer records -the final trailing newline in 'erc-timestamp-format-left'. +the final trailing newline in 'erc-timestamp-format-left'. If you +must, see variable 'erc-stamp-prepend-date-stamps-p' for a temporary +escape hatch. *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and provided library diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index b515513dcb7..2ff1f3832fb 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -689,6 +689,16 @@ erc-stamp--lr-date-on-pre-modify (let (erc-timestamp-format erc-away-timestamp-format) (erc-add-timestamp))))) +(defvar erc-stamp-prepend-date-stamps-p nil + "When non-nil, date stamps are not independent messages. +Users should think twice about enabling this escape hatch. It +will likely degraded the user experience by causing post-5.5 +features, like `fill-wrap', dynamic invisibility, etc., to +malfunction. Basic support for the default configuration may +expire earlier than normally expected.") +(make-obsolete-variable 'erc-stamp-prepend-date-stamps-p + "unsupported legacy behavior" "30.1") + (defun erc-insert-timestamp-left-and-right (string) "Insert a stamp on either side when it changes. When the deprecated option `erc-timestamp-format-right' is nil, @@ -703,7 +713,7 @@ erc-insert-timestamp-left-and-right Additionally, ensure every date stamp is identifiable as such so that internal modules can easily distinguish between other left-sided stamps and date stamps inserted by this function." - (unless erc-stamp--date-format-end + (unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p) (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t) (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t) (let ((erc--insert-marker (point-min-marker)) @@ -719,6 +729,13 @@ erc-insert-timestamp-left-and-right (if erc-timestamp-format-right (erc-format-timestamp ct erc-timestamp-format-right) string)))) + ;; Maybe insert legacy date stamp. + (when-let ((erc-stamp-prepend-date-stamps-p) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + ((not (string= ts-left erc-timestamp-last-inserted-left)))) + (goto-char (point-min)) + (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) + (insert (setq erc-timestamp-last-inserted-left ts-left))) ;; insert right timestamp (let ((erc-timestamp-only-if-changed-flag t) (erc-timestamp-last-inserted erc-timestamp-last-inserted-right)) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index c8f2e04c3eb..a36b781e04d 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -785,6 +785,9 @@ erc-track-select-mode-line-face choice)) choice)))) +(defvar erc-track--skipped-msgs '(datestamp) + "Values of `erc-msg' text prop to ignore.") + (defun erc-track-modified-channels () "Hook function for `erc-insert-post-hook'. Check if the current buffer should be added to the mode line as a @@ -798,10 +801,13 @@ erc-track-modified-channels ;; FIXME either use `erc--server-buffer-p' or ;; explain why that's unwise. (erc-server-or-unjoined-channel-buffer-p))) - (not (erc-message-type-member - (or (erc-find-parsed-property) - (point-min)) - erc-track-exclude-types))) + (not (let ((parsed (erc-find-parsed-property))) + (or (erc-message-type-member (or parsed (point-min)) + erc-track-exclude-types) + ;; Skip certain non-server-sent messages. + (and (not parsed) + (erc--check-msg-prop 'erc-msg + erc-track--skipped-msgs)))))) ;; If the active buffer is not visible (not shown in a ;; window), and not to be excluded, determine the kinds of ;; faces used in the current message, and unless the user diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index d6b5d868ce5..b98300d04be 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -50,7 +50,6 @@ erc-scenarios-stamp--left/display-margin-mode (erc-stamp--current-time 704591940) (erc-stamp--tz t) (erc-server-flood-penalty 0.1) - (erc-timestamp-only-if-changed-flag nil) (erc-insert-timestamp-function #'erc-insert-timestamp-left) (erc-modules (cons 'fill-wrap erc-modules)) (erc-timestamp-only-if-changed-flag nil) @@ -87,4 +86,31 @@ erc-scenarios-stamp--left/display-margin-mode (should (looking-back "CEIMRUabefhiklmnoqstuv\n")) (should (looking-at (rx "["))))))))) +(ert-deftest erc-scenarios-stamp--legacy-date-stamps () + (with-suppressed-warnings ((obsolete erc-stamp-prepend-date-stamps-p)) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (erc-stamp-prepend-date-stamps-p t) + (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + (funcall expect 5 "Opening connection") + (goto-char (1- (match-beginning 0))) + (should (eq 'erc-timestamp (field-at-pos (point)))) + (should (eq 'unknown (erc--get-inserted-msg-prop 'erc-msg))) + ;; Force redraw of date stamp. + (setq erc-timestamp-last-inserted-left nil) + + (funcall expect 5 "This server is in debug mode") + (while (and (zerop (forward-line -1)) + (not (eq 'erc-timestamp (field-at-pos (point)))))) + (should (erc--get-inserted-msg-prop 'erc-cmd))))))) + ;;; erc-scenarios-stamp.el ends here commit a491a3d8355d9602636801edb13b6701147c792a Author: F. Jason Park Date: Mon Oct 23 19:33:32 2023 -0700 ; * lisp/erc/erc.el (erc-after-connect): Remove package-version. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7d75ec49ccd..f618fb17076 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2490,7 +2490,6 @@ erc-after-connect to the 376/422 message's \"sender\", as well as the current nick, as given by the 376/422 message's \"target\" parameter, which is typically the same as that reported by `erc-current-nick'." - :package-version '(ERC . "5.6") ; FIXME sync on release :group 'erc-hooks :type '(repeat function)) commit e9205323e1577431c5323e951368d17fa003f2f7 Author: F. Jason Park Date: Tue Oct 24 18:18:50 2023 -0700 Be slightly more aggressive with erc-scrolltobottom-all * lisp/erc/erc-goodies.el (erc--scrolltobottom-on-post-command): Redo obsolete doc string. (erc--scrolltobottom-at-prompt-minibuffer-active, erc--scrolltobottom-on-win-conf-change): Rename former to latter to better reflect actual role. Remove conditional guard so it always runs. (erc--scrolltobottom-setup): Set `scroll-step' locally when a user hasn't customized `scroll-conservatively'. Update `window-configuration-change-hook' member name. (Bug#64855) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 9d70c644429..4cc81dd9378 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -119,28 +119,20 @@ erc--scrolltobottom-post-ignore-commands "Commands to skip instead of force-scroll on `post-command-hook'.") (defun erc--scrolltobottom-on-post-command () - "Restore window start or scroll to prompt and recenter. -When `erc--scrolltobottom-window-info' is non-nil and its first -item is associated with the selected window, restore start of -window so long as prompt hasn't moved. Expect buffer to be -unnarrowed." + "Scroll selected window unless `this-command' is exempted." (when (eq (selected-window) (get-buffer-window)) (unless (memq this-command erc--scrolltobottom-post-ignore-commands) - (erc--scrolltobottom-confirm)) - (setq erc--scrolltobottom-window-info nil))) + (setq erc--scrolltobottom-window-info nil) + (erc--scrolltobottom-confirm)))) ;; It may be desirable to also restore the relative line position of ;; window point after changing dimensions. Perhaps stashing the ;; previous ratio of window line to body height and later recentering ;; proportionally would achieve this. -(defun erc--scrolltobottom-at-prompt-minibuffer-active () +(defun erc--scrolltobottom-on-win-conf-change () "Scroll window to bottom when at prompt and using the minibuffer." - ;; This is redundant or ineffective in the selected window if at - ;; prompt or if only one window exists. - (unless (or (input-pending-p) - (and (minibuffer-window-active-p (minibuffer-window)) - (eq (old-selected-window) (minibuffer-window)))) - (erc--scrolltobottom-confirm))) + (setq erc--scrolltobottom-window-info nil) + (erc--scrolltobottom-confirm)) (defun erc--scrolltobottom-all (&rest _) "Maybe put prompt on last line in all windows displaying current buffer. @@ -176,17 +168,20 @@ erc--scrolltobottom-setup (if erc-scrolltobottom-all (progn (setq-local read-minibuffer-restore-windows nil) + (when (zerop scroll-conservatively) + (setq-local scroll-step 1)) (unless (eq erc-scrolltobottom-all 'relaxed) (add-hook 'window-configuration-change-hook - #'erc--scrolltobottom-at-prompt-minibuffer-active 50 t) + #'erc--scrolltobottom-on-win-conf-change 50 t) (add-hook 'post-command-hook #'erc--scrolltobottom-on-post-command 50 t))) (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t)) (remove-hook 'post-command-hook #'erc-scroll-to-bottom t) (remove-hook 'post-command-hook #'erc--scrolltobottom-on-post-command t) (remove-hook 'window-configuration-change-hook - #'erc--scrolltobottom-at-prompt-minibuffer-active t) + #'erc--scrolltobottom-on-win-conf-change t) (kill-local-variable 'read-minibuffer-restore-windows) + (kill-local-variable 'scroll-step) (kill-local-variable 'erc--scrolltobottom-window-info))) (defun erc--scrolltobottom-on-pre-insert (_) commit c59c8db98a1d031a20ec7850978653657e394baa Author: Eli Zaretskii Date: Fri Oct 27 20:47:01 2023 +0300 ; Another fix for profiler.c * src/profiler.c: Reshuffle functions and declarations to compile also when PROFILER_CPU_SUPPORT is not defined. (Bug#66774) diff --git a/src/profiler.c b/src/profiler.c index 199cf368a55..b494ad783dc 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -55,6 +55,8 @@ saturated_add (EMACS_INT a, EMACS_INT b) EMACS_INT discarded; /* Samples evicted during table overflow. */ }; +static Lisp_Object export_log (struct profiler_log *); + static struct profiler_log make_log (void) { @@ -213,6 +215,23 @@ record_backtrace (struct profiler_log *plog, EMACS_INT count) /* Sampling profiler. */ +/* Signal handler for sampling profiler. */ + +static void +add_sample (struct profiler_log *plog, EMACS_INT count) +{ + if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */ + /* Special case the time-count inside GC because the hash-table + code is not prepared to be used while the GC is running. + More specifically it uses ASIZE at many places where it does + not expect the ARRAY_MARK_FLAG to be set. We could try and + harden the hash-table code, but it doesn't seem worth the + effort. */ + plog->gc_count = saturated_add (plog->gc_count, count); + else + record_backtrace (plog, count); +} + #ifdef PROFILER_CPU_SUPPORT /* The profiler timer and whether it was properly initialized, if @@ -238,24 +257,6 @@ record_backtrace (struct profiler_log *plog, EMACS_INT count) /* The current sampling interval in nanoseconds. */ static EMACS_INT current_sampling_interval; -/* Signal handler for sampling profiler. */ - -static void -add_sample (struct profiler_log *plog, EMACS_INT count) -{ - if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */ - /* Special case the time-count inside GC because the hash-table - code is not prepared to be used while the GC is running. - More specifically it uses ASIZE at many places where it does - not expect the ARRAY_MARK_FLAG to be set. We could try and - harden the hash-table code, but it doesn't seem worth the - effort. */ - plog->gc_count = saturated_add (plog->gc_count, count); - else - record_backtrace (plog, count); -} - - static void handle_profiler_signal (int signal) { @@ -418,6 +419,19 @@ DEFUN ("profiler-cpu-running-p", return profiler_cpu_running ? Qt : Qnil; } +DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, + 0, 0, 0, + doc: /* Return the current cpu profiler log. +The log is a hash-table mapping backtraces to counters which represent +the amount of time spent at those points. Every backtrace is a vector +of functions, where the last few elements may be nil. +Before returning, a new log is allocated for future samples. */) + (void) +{ + return (export_log (&cpu)); +} +#endif /* PROFILER_CPU_SUPPORT */ + static Lisp_Object export_log (struct profiler_log *log) { @@ -430,26 +444,15 @@ export_log (struct profiler_log *log) Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil), make_fixnum (log->discarded), result); +#ifdef PROFILER_CPU_SUPPORT /* Here we're making the log visible to Elisp, so it's not safe any more for our use afterwards since we can't rely on its special pre-allocated keys anymore. So we have to allocate a new one. */ if (profiler_cpu_running) *log = make_log (); +#endif /* PROFILER_CPU_SUPPORT */ return result; } - -DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, - 0, 0, 0, - doc: /* Return the current cpu profiler log. -The log is a hash-table mapping backtraces to counters which represent -the amount of time spent at those points. Every backtrace is a vector -of functions, where the last few elements may be nil. -Before returning, a new log is allocated for future samples. */) - (void) -{ - return (export_log (&cpu)); -} -#endif /* PROFILER_CPU_SUPPORT */ /* Memory profiler. */ commit ee848be84c67d21f1a64167b265c87533212e375 Author: Eli Zaretskii Date: Fri Oct 27 18:26:27 2023 +0300 Fix compilation error in profiler.c * src/profiler.c (memory): Declare outside of the PROFILER_CPU_SUPPORT conditional. (Bug#66774) diff --git a/src/profiler.c b/src/profiler.c index 6217071ef9c..199cf368a55 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -235,9 +235,6 @@ record_backtrace (struct profiler_log *plog, EMACS_INT count) /* Hash-table log of CPU profiler. */ static struct profiler_log cpu; -/* Hash-table log of Memory profiler. */ -static struct profiler_log memory; - /* The current sampling interval in nanoseconds. */ static EMACS_INT current_sampling_interval; @@ -456,6 +453,9 @@ DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, /* Memory profiler. */ +/* Hash-table log of Memory profiler. */ +static struct profiler_log memory; + /* True if memory profiler is running. */ bool profiler_memory_running; commit e2d2726db7ce728fe9c81ecd6154490e7157d409 Merge: 54c9467a993 5d1e6f759f2 Author: Michael Albinus Date: Fri Oct 27 15:28:45 2023 +0200 ; Merge from origin/emacs-29 The following commit was skipped: 5d1e6f759f2 * lisp/tab-bar.el: Fix the close button with auto-width (... commit 54c9467a99332064b6966294906e04ac43149574 Merge: 28c2191df02 5f60913208f Author: Michael Albinus Date: Fri Oct 27 15:28:43 2023 +0200 Merge from origin/emacs-29 5f60913208f Fix State button for customize-icon (Bug#66635) 27c71979ff1 ; Another Texinfo fix 889a550ca08 ; Fix Texinfo warnings 893c344b4e4 Fix the use of adaptive-fill-regexp in treesit indent preset 1098c114b74 Fix treesit-install-language-grammar (bug#66673) 491ee428c08 Fix treesit-explore-mode (bug#66431) ee043a2703d tsx-ts-mode--font-lock-compatibility-bb1f97b: Re-fix the ... commit 28c2191df0239c16b4fb9e7242582185175a329f Author: Michael Albinus Date: Fri Oct 27 15:18:36 2023 +0200 * lisp/net/tramp.el (tramp-read-id-output): Identifiers can contain "-". diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7cc9b0c14a2..9cc319bef67 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -6231,20 +6231,20 @@ tramp-read-id-output (goto-char (point-min)) ;; Read uid. (when (search-forward-regexp - (rx "uid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")") + (rx "uid=" (group (+ digit)) "(" (group (+ (any "_-" alnum))) ")") nil 'noerror) (setq uid-integer (string-to-number (match-string 1)) uid-string (match-string 2))) ;; Read gid. (when (search-forward-regexp - (rx "gid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")") + (rx "gid=" (group (+ digit)) "(" (group (+ (any "_-" alnum))) ")") nil 'noerror) (setq gid-integer (string-to-number (match-string 1)) gid-string (match-string 2))) ;; Read groups. (when (search-forward-regexp (rx "groups=") nil 'noerror) (while (looking-at - (rx (group (+ digit)) "(" (group (+ (any "_" word))) ")")) + (rx (group (+ digit)) "(" (group (+ (any "_-" alnum))) ")")) (setq groups-integer (cons (string-to-number (match-string 1)) groups-integer) groups-string (cons (match-string 2) groups-string)) commit 41939127457f0564217caef2d8740f8e0e816b9c Author: Michael Albinus Date: Fri Oct 27 15:09:41 2023 +0200 Fix Tramp (don't merge) * lisp/net/tramp.el (tramp-read-id-output): Identifiers can contain "-". diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d1b38cfeb93..29f5ffd68f0 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -6399,20 +6399,20 @@ tramp-read-id-output (goto-char (point-min)) ;; Read uid. (when (re-search-forward - (rx "uid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")") + (rx "uid=" (group (+ digit)) "(" (group (+ (any "_-" alnum))) ")") nil 'noerror) (setq uid-integer (string-to-number (match-string 1)) uid-string (match-string 2))) ;; Read gid. (when (re-search-forward - (rx "gid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")") + (rx "gid=" (group (+ digit)) "(" (group (+ (any "_-" alnum))) ")") nil 'noerror) (setq gid-integer (string-to-number (match-string 1)) gid-string (match-string 2))) ;; Read groups. (when (re-search-forward (rx "groups=") nil 'noerror) (while (looking-at - (rx (group (+ digit)) "(" (group (+ (any "_" word))) ")")) + (rx (group (+ digit)) "(" (group (+ (any "_-" alnum))) ")")) (setq groups-integer (cons (string-to-number (match-string 1)) groups-integer) groups-string (cons (match-string 2) groups-string)) commit d81c59612f026cc6540b388e144c20a3497e72e1 Author: Eli Zaretskii Date: Fri Oct 27 15:37:34 2023 +0300 ; Fix style of error messages in pdumper.c * src/pdumper.c (dump_buffer, dump_do_dump_relocation) (dump_native_comp_unit): Make the style of error messages more consistent. diff --git a/src/pdumper.c b/src/pdumper.c index 9a3870181e3..379e128e2b4 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2864,7 +2864,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) if (!itree_empty_p (buffer->overlays)) { /* We haven't implemented the code to dump overlays. */ - error ("Dumping overlays in buffers is not yet implemented. Aborting..."); + error ("dumping overlays is not yet implemented"); } else out->overlays = NULL; @@ -2958,7 +2958,7 @@ dump_native_comp_unit (struct dump_context *ctx, struct Lisp_Native_Comp_Unit *comp_u) { if (!CONSP (comp_u->file)) - error ("Trying to dump non fixed-up eln file"); + error ("trying to dump non fixed-up eln file"); /* Have function documentation always lazy loaded to optimize load-time. */ comp_u->data_fdoc_v = Qnil; @@ -5356,11 +5356,11 @@ dump_do_dump_relocation (const uintptr_t dump_base, dump_ptr (dump_base, reloc_offset); comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); if (STRINGP (comp_u->file)) - error ("Trying to load incoherent dumped eln file %s", + error ("trying to load incoherent dumped eln file %s", SSDATA (comp_u->file)); if (!CONSP (comp_u->file)) - error ("Incoherent compilation unit for dump was dumped"); + error ("incoherent compilation unit for dump was dumped"); /* emacs_execdir is always unibyte, but the file names in comp_u->file could be multibyte, so we need to encode commit 8c9e544501ae26ae328deefc05b5bf4874ead2d1 Author: Ihor Radchenko Date: Thu Oct 26 14:52:32 2023 +0300 * src/pdumper.c (dump_buffer): Print message when aborting (bug#66743) When the buffer contains overlays, it cannot be dumped. Print a clear message describing the reason, instead of just aborting. diff --git a/src/pdumper.c b/src/pdumper.c index 315a31e2bcb..9a3870181e3 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2862,8 +2862,10 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) DUMP_FIELD_COPY (out, buffer, long_line_optimizations_p); if (!itree_empty_p (buffer->overlays)) - /* We haven't implemented the code to dump overlays. */ - emacs_abort (); + { + /* We haven't implemented the code to dump overlays. */ + error ("Dumping overlays in buffers is not yet implemented. Aborting..."); + } else out->overlays = NULL; commit bbd4385a631d0b1127a17919e767bbbb513e1dcc Author: Po Lu Date: Fri Oct 27 18:44:15 2023 +0800 Substitute eassert for assert throughout Android code * src/android.c (android_init_emacs_service) (android_init_emacs_pixmap, android_init_graphics_point) (android_init_emacs_drawable, android_init_emacs_window) (android_init_emacs_cursor, android_destroy_handle) (android_create_window, android_init_android_rect_class) (android_init_emacs_gc_class, android_begin_query): * src/androidselect.c (android_init_emacs_clipboard) (android_init_emacs_desktop_notification): * src/androidterm.c (getExtractedText) (android_get_surrounding_text_internal): * src/androidvfs.c (android_vfs_init): Replace assert with eassert. diff --git a/src/android.c b/src/android.c index 9f0e966a602..3344a773d5f 100644 --- a/src/android.c +++ b/src/android.c @@ -1531,7 +1531,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ service_class.class, \ name, signature); \ - assert (service_class.c_name); + eassert (service_class.c_name); FIND_METHOD (fill_rectangle, "fillRectangle", "(Lorg/gnu/emacs/EmacsDrawable;" @@ -1647,7 +1647,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ pixmap_class.class, \ name, signature); \ - assert (pixmap_class.c_name); + eassert (pixmap_class.c_name); FIND_METHOD (constructor_mutable, "", "(SIII)V"); @@ -1678,7 +1678,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ point_class.class, \ name, signature); \ - assert (point_class.c_name); + eassert (point_class.c_name); FIND_METHOD (constructor, "", "(II)V"); #undef FIND_METHOD @@ -1708,7 +1708,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ drawable_class.class, \ name, signature); \ - assert (drawable_class.c_name); + eassert (drawable_class.c_name); FIND_METHOD (get_bitmap, "getBitmap", "()Landroid/graphics/Bitmap;"); #undef FIND_METHOD @@ -1738,7 +1738,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ window_class.class, \ name, signature); \ - assert (window_class.c_name); + eassert (window_class.c_name); FIND_METHOD (swap_buffers, "swapBuffers", "()V"); FIND_METHOD (toggle_on_screen_keyboard, @@ -1798,7 +1798,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ cursor_class.class, \ name, signature); \ - assert (cursor_class.c_name); + eassert (cursor_class.c_name); FIND_METHOD (constructor, "", "(SI)V"); #undef FIND_METHOD @@ -2695,12 +2695,12 @@ android_destroy_handle (android_handle handle) class = (*android_java_env)->FindClass (android_java_env, "org/gnu/emacs/EmacsHandleObject"); - assert (class != NULL); + eassert (class != NULL); method = (*android_java_env)->GetMethodID (android_java_env, class, "destroyHandle", "()V"); - assert (method != NULL); + eassert (method != NULL); old = class; class @@ -2843,13 +2843,13 @@ android_create_window (android_window parent, int x, int y, { class = (*android_java_env)->FindClass (android_java_env, "org/gnu/emacs/EmacsWindow"); - assert (class != NULL); + eassert (class != NULL); constructor = (*android_java_env)->GetMethodID (android_java_env, class, "", "(SLorg/gnu/emacs/EmacsWindow;" "IIIIZ)V"); - assert (constructor != NULL); + eassert (constructor != NULL); old = class; class = (*android_java_env)->NewGlobalRef (android_java_env, class); @@ -2925,12 +2925,12 @@ android_init_android_rect_class (void) android_rect_class = (*android_java_env)->FindClass (android_java_env, "android/graphics/Rect"); - assert (android_rect_class); + eassert (android_rect_class); android_rect_constructor = (*android_java_env)->GetMethodID (android_java_env, android_rect_class, "", "(IIII)V"); - assert (emacs_gc_constructor); + eassert (emacs_gc_constructor); old = android_rect_class; android_rect_class @@ -2952,19 +2952,19 @@ android_init_emacs_gc_class (void) emacs_gc_class = (*android_java_env)->FindClass (android_java_env, "org/gnu/emacs/EmacsGC"); - assert (emacs_gc_class); + eassert (emacs_gc_class); emacs_gc_constructor = (*android_java_env)->GetMethodID (android_java_env, emacs_gc_class, "", "(S)V"); - assert (emacs_gc_constructor); + eassert (emacs_gc_constructor); emacs_gc_mark_dirty = (*android_java_env)->GetMethodID (android_java_env, emacs_gc_class, "markDirty", "(Z)V"); - assert (emacs_gc_mark_dirty); + eassert (emacs_gc_mark_dirty); old = emacs_gc_class; emacs_gc_class @@ -6667,7 +6667,7 @@ android_begin_query (void) if (old == 1) { /* Answer the query that is currently being made. */ - assert (android_query_function != NULL); + eassert (android_query_function != NULL); android_answer_query (); } diff --git a/src/androidselect.c b/src/androidselect.c index 3f025351093..f7988db0520 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -90,7 +90,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ clipboard_class.class, \ name, signature); \ - assert (clipboard_class.c_name); + eassert (clipboard_class.c_name); FIND_METHOD (set_clipboard, "setClipboard", "([B)V"); FIND_METHOD (owns_clipboard, "ownsClipboard", "()I"); @@ -107,7 +107,7 @@ #define FIND_METHOD(c_name, name, signature) \ "makeClipboard", "()Lorg/gnu/emacs/" "EmacsClipboard;"); - assert (clipboard_class.make_clipboard); + eassert (clipboard_class.make_clipboard); #undef FIND_METHOD } @@ -511,7 +511,7 @@ #define FIND_METHOD(c_name, name, signature) \ = (*android_java_env)->GetMethodID (android_java_env, \ notification_class.class, \ name, signature); \ - assert (notification_class.c_name); + eassert (notification_class.c_name); FIND_METHOD (init, "", "(Ljava/lang/String;" "Ljava/lang/String;Ljava/lang/String;" diff --git a/src/androidterm.c b/src/androidterm.c index 9d6517cce2b..e87f7ca2d14 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -21,7 +21,6 @@ Copyright (C) 2023 Free Software Foundation, Inc. #include #include #include -#include #include #include "lisp.h" @@ -5602,15 +5601,15 @@ NATIVE_NAME (getExtractedText) (JNIEnv *env, jobject ignored_object, class = (*env)->FindClass (env, ("android/view/inputmethod" "/ExtractedTextRequest")); - assert (class); + eassert (class); request_class.hint_max_chars = (*env)->GetFieldID (env, class, "hintMaxChars", "I"); - assert (request_class.hint_max_chars); + eassert (request_class.hint_max_chars); request_class.token = (*env)->GetFieldID (env, class, "token", "I"); - assert (request_class.token); + eassert (request_class.token); request_class.initialized = true; } @@ -5620,12 +5619,12 @@ NATIVE_NAME (getExtractedText) (JNIEnv *env, jobject ignored_object, text_class.class = (*env)->FindClass (env, ("android/view/inputmethod" "/ExtractedText")); - assert (text_class.class); + eassert (text_class.class); class = text_class.class = (*env)->NewGlobalRef (env, text_class.class); - assert (text_class.class); + eassert (text_class.class); text_class.flags = (*env)->GetFieldID (env, class, "flags", "I"); @@ -5924,7 +5923,7 @@ android_get_surrounding_text_internal (JNIEnv *env, jshort window, return NULL; } #else /* __ANDROID_API__ >= 31 */ - assert (class); + eassert (class); #endif /* __ANDROID_API__ < 31 */ class = (*env)->NewGlobalRef (env, class); @@ -5936,7 +5935,7 @@ android_get_surrounding_text_internal (JNIEnv *env, jshort window, /* Now look for its constructor. */ constructor = (*env)->GetMethodID (env, class, "", "(Ljava/lang/CharSequence;III)V"); - assert (constructor); + eassert (constructor); } context.before_length = before_length; @@ -6032,7 +6031,7 @@ NATIVE_NAME (takeSnapshot) (JNIEnv *env, jobject object, jshort window) return NULL; } #else /* __ANDROID_API__ >= 33 */ - assert (class); + eassert (class); #endif /* __ANDROID_API__ < 33 */ class = (*env)->NewGlobalRef (env, class); @@ -6044,7 +6043,7 @@ NATIVE_NAME (takeSnapshot) (JNIEnv *env, jobject object, jshort window) constructor = (*env)->GetMethodID (env, class, "", "(Landroid/view/inputmethod" "/SurroundingText;III)V"); - assert (constructor); + eassert (constructor); } /* Try to create a TextSnapshot object. */ diff --git a/src/androidvfs.c b/src/androidvfs.c index f89a82cfcc6..b3d644e21a2 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -6557,12 +6557,12 @@ android_vfs_init (JNIEnv *env, jobject manager) /* Initialize some required classes. */ java_string_class = (*env)->FindClass (env, "java/lang/String"); - assert (java_string_class); + eassert (java_string_class); old = java_string_class; java_string_class = (jclass) (*env)->NewGlobalRef (env, java_string_class); - assert (java_string_class); + eassert (java_string_class); (*env)->DeleteLocalRef (env, old); /* And initialize those used on Android 5.0 and later. */ commit fe2761cf3e3f21a9c5a73686a8e21aceb13daa78 Author: Po Lu Date: Fri Oct 27 11:17:47 2023 +0800 Mention additional return values for framep et al * doc/lispref/frames.texi (Frames, Multiple Terminals): Don't omit mentions of Android or Haiku. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 5013cd28420..fc36346f773 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -60,8 +60,12 @@ Frames terminal. @item pc The frame is displayed on an MS-DOS terminal. +@item haiku +The frame is displayed using the Haiku Application Kit. @item pgtk The frame is displayed using pure GTK facilities. +@item android +The frame is displayed on an Android device. @end table @end defun @@ -224,8 +228,8 @@ Multiple Terminals @item The kind of display associated with the terminal. This is the symbol returned by the function @code{terminal-live-p} (i.e., @code{x}, -@code{t}, @code{w32}, @code{ns}, @code{pc}, @code{haiku}, or @code{pgtk}). -@xref{Frames}. +@code{t}, @code{w32}, @code{ns}, @code{pc}, @code{haiku}, @code{pgtk}, +or @code{android}). @xref{Frames}. @item A list of terminal parameters. @xref{Terminal Parameters}. commit 4a4677aa32fcecd5d490a096e4de0e03ebe55b5e Author: Po Lu Date: Fri Oct 27 08:25:43 2023 +0800 Correct order of arguments to dnd-handle-multiple-urls * lisp/term/android-win.el (android-handle-dnd-event): Pass new-uri-list before action. diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index b73251456fa..960dfdcb4a6 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -288,8 +288,9 @@ android-handle-dnd-event ;; transformed back into a content URI. dnd-unescape-file-uris nil)))) (push uri new-uri-list)) - (dnd-handle-multiple-urls (posn-window posn) 'copy - new-uri-list)))))) + (dnd-handle-multiple-urls (posn-window posn) + new-uri-list + 'copy)))))) (define-key special-event-map [drag-n-drop] 'android-handle-dnd-event) commit 194a8f5c1406dd7e762376bdfde78d1b7d01b6b1 Author: Stefan Kangas Date: Thu Oct 26 23:58:05 2023 +0200 Fix `browse-url-default-scheme` custom :type * lisp/net/browse-url.el (browse-url-default-scheme): Fix custom :type. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 7cbc8e569a5..df3f538a354 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -680,7 +680,9 @@ browse-url-default-scheme Note that if you set this to \"https\", websites that do not yet support HTTPS may not load correctly in your web browser. Such websites are increasingly rare, but they do still exist." - :type 'string + :type '(choice (const :tag "HTTP" "http") + (const :tag "HTTPS" "https") + (string :tag "Something else" "https")) :version "29.1") (defun browse-url-url-at-point () commit 967ee6a70cd053e9dc9b51f6945b0bf030df081b Author: Harald Jörg Date: Thu Oct 26 21:55:31 2023 +0200 ; cperl-mode.el: Remove a duplicate defvar * lisp/progmodes/cperl-mode.el (imenu-max-items): Remove duplicate defvar. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 85495732075..1a2ad15f5b2 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -7328,9 +7328,6 @@ cperl-list-fold (nreverse list2)) list1))))) -(defvar imenu-max-items nil - "Max items in an imenu list. Defined in imenu.el.") - (defun cperl-menu-to-keymap (menu) (let (list) (cons 'keymap commit 2ec90ac8ffc3075efc55c7a3f1d2e5e62d895d36 Author: Stefan Kangas Date: Thu Oct 26 21:09:06 2023 +0200 Remove highlighting trailing whitespace from cperl-mode * lisp/progmodes/cperl-mode.el (cperl-invalid-face): Make obsolete in favor of 'show-trailing-whitespace'. (cperl-init-faces): No longer highlight trailing whitespace separately. (cperl-praise, cperl-tips-faces): Update documentation for above change. diff --git a/etc/NEWS b/etc/NEWS index 3ad886bdc2b..05fd1b7a390 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -876,6 +876,10 @@ The Perl documentation in info format is no longer distributed with Perl or on CPAN since more than 10 years. Perl documentation can be read with 'cperl-perldoc' instead. +*** Highlighting trailing whitespace has been removed. +The user option 'cperl-invalid-face' is now obsolete, and does +nothing. See the user option 'show-trailing-whitespace' instead. + ** Emacs Sessions (Desktop) +++ diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 2894f36477a..85495732075 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -379,6 +379,8 @@ cperl-invalid-face :type 'face :version "21.1" :group 'cperl-faces) +(make-obsolete-variable 'cperl-invalid-face + 'show-trailing-whitespace "30.1") (defcustom cperl-pod-here-fontify t "Not-nil after evaluation means to highlight POD and here-docs sections." @@ -730,7 +732,6 @@ cperl-praise m) Highlights (by user-choice) either 3-delimiters constructs (such as tr/a/b/), or regular expressions and `y/tr'; - n) Highlights trailing whitespace; o) Is able to manipulate Perl Regular Expressions to ease conversion to a more readable form. p) Can ispell POD sections and HERE-DOCs. @@ -828,7 +829,6 @@ cperl-tips-faces `font-lock-type-face' Overridable keywords `font-lock-variable-name-face' Variable declarations, indirect array and hash names, POD headers/item names - `cperl-invalid-face' Trailing whitespace Note that in several situations the highlighting tries to inform about possible confusion, such as different colors for function names in @@ -5858,9 +5858,6 @@ cperl-init-faces (setq t-font-lock-keywords (list - ;; -------- trailing spaces -> use invalid-face as a warning - ;; (matcher subexp facespec) - `("[ \t]+$" 0 ',cperl-invalid-face t) ;; -------- function definition _and_ declaration ;; (matcher (subexp facespec)) ;; facespec is evaluated depending on whether the commit 3d72fb13a8a6f30e2a0079abbf8a96aae6819b06 Author: Stefan Kangas Date: Thu Oct 26 20:55:44 2023 +0200 ; Update item numbering in cperl-praise * lisp/progmodes/cperl-mode.el (cperl-praise): Remove retired item and update numbering. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 9244c6a923a..2894f36477a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -704,43 +704,42 @@ cperl-praise 3) Separate list of packages/classes; 4) Hierarchical view of methods in (sub)packages; 5) and functions (by the full name - with package); - e) This item has retired. - f) Has a builtin list of one-line explanations for perl constructs. - g) Can show these explanations if you stay long enough at the + e) Has a builtin list of one-line explanations for perl constructs. + f) Can show these explanations if you stay long enough at the corresponding place (or on demand); - h) Has an enhanced fontification (using 3 or 4 additional faces + g) Has an enhanced fontification (using 3 or 4 additional faces comparing to font-lock - basically, different namespaces in Perl have different colors); - i) Can construct TAGS basing on its knowledge of Perl syntax, + h) Can construct TAGS basing on its knowledge of Perl syntax, the standard menu has 6 different way to generate TAGS (if \"by directory\", .xs files - with C-language bindings - are included in the scan); - j) Can build a hierarchical view of classes (via imenu) basing + i) Can build a hierarchical view of classes (via imenu) basing on generated TAGS file; - k) Has electric parentheses, electric newlines, uses Abbrev + j) Has electric parentheses, electric newlines, uses Abbrev for electric logical constructs while () {} with different styles of expansion (context sensitive to be not so bothering). Electric parentheses behave \"as they should\" in a presence of a visible region. - l) Changes msb.el \"on the fly\" to insert a group \"Perl files\"; - m) Can convert from + k) Changes msb.el \"on the fly\" to insert a group \"Perl files\"; + l) Can convert from if (A) { B } to B if A; - n) Highlights (by user-choice) either 3-delimiters constructs + m) Highlights (by user-choice) either 3-delimiters constructs (such as tr/a/b/), or regular expressions and `y/tr'; - o) Highlights trailing whitespace; - p) Is able to manipulate Perl Regular Expressions to ease + n) Highlights trailing whitespace; + o) Is able to manipulate Perl Regular Expressions to ease conversion to a more readable form. - q) Can ispell POD sections and HERE-DOCs. - r) Understands comments and character classes inside regular + p) Can ispell POD sections and HERE-DOCs. + q) Understands comments and character classes inside regular expressions; can find matching () and [] in a regular expression. - s) Allows indentation of //x-style regular expressions; - t) Highlights different symbols in regular expressions according + r) Allows indentation of //x-style regular expressions; + s) Highlights different symbols in regular expressions according to their function; much less problems with backslashitis; - u) Allows you to locate regular expressions which contain + t) Allows you to locate regular expressions which contain interpolated parts. 5) The indentation engine was very smart, but most of tricks may be commit f0157616cfa8864f6ed25e89383b83c611145b80 Author: Stefan Kangas Date: Thu Oct 26 20:53:09 2023 +0200 Remove link to Perl info documentation * lisp/info-look.el: Remove link to Perl info documentation. It is no longer distributed with Perl, nor is it available from CPAN. diff --git a/lisp/info-look.el b/lisp/info-look.el index dc6c3226040..eeb758e5b85 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -30,7 +30,6 @@ ;; Scheme: https://groups.csail.mit.edu/mac/ftpdir/scm/r5rs.info.tar.gz ;; LaTeX: https://mirrors.ctan.org/info/latex2e-help-texinfo/latex2e.texi ;; (or CTAN mirrors) -;; Perl: (or CPAN mirrors) ;; Traditionally, makeinfo quoted `like this', but version 5 and later ;; quotes 'like this' or ‘like this’. Doc specs with patterns commit c22eeba82770e71ade074883ff8682e7dcae0509 Author: Michael Albinus Date: Thu Oct 26 16:12:16 2023 +0200 ; Fix typo diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 3aae927be65..df966040a1b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5895,7 +5895,7 @@ Traces and Profiles @item @w{ 0} Silent (no @value{tramp} messages at all) @item @w{ 1} Errors @item @w{ 2} Warnings -@item @w{ 3} Connectioncccc to remote hosts (default verbosity) +@item @w{ 3} Connection to remote hosts (default verbosity) @item @w{ 4} Activities @item @w{ 5} Internal @item @w{ 6} Sent and received strings commit 4f57af7fccdb3786bea43ef0f174027a4a6daef2 Author: Michael Albinus Date: Thu Oct 26 15:59:24 2023 +0200 * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. (don't merge) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 38c7a3babed..3aae927be65 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5891,20 +5891,20 @@ Traces and Profiles @noindent The verbosity levels are -@indentedblock - @w{ 0} silent (no @value{tramp} messages at all) -@* @w{ 1} errors -@* @w{ 2} warnings -@* @w{ 3} connection to remote hosts (default verbosity) -@* @w{ 4} activities -@* @w{ 5} internal -@* @w{ 6} sent and received strings -@* @w{ 7} connection properties -@* @w{ 8} file caching -@* @w{ 9} test commands -@* @w{10} traces (huge) -@* @w{11} call traces (maintainer only) -@end indentedblock +@itemize @w{} +@item @w{ 0} Silent (no @value{tramp} messages at all) +@item @w{ 1} Errors +@item @w{ 2} Warnings +@item @w{ 3} Connectioncccc to remote hosts (default verbosity) +@item @w{ 4} Activities +@item @w{ 5} Internal +@item @w{ 6} Sent and received strings +@item @w{ 7} Connection properties +@item @w{ 8} File caching +@item @w{ 9} Test commands +@item @w{10} Traces (huge) +@item @w{11} Call traces (maintainer only) +@end itemize With @code{tramp-verbose} greater than or equal to 4, messages are also written to a @value{tramp} debug buffer. Such debug buffers are commit ff791f6b002b031a69945d27d47a6585f6bf239b Author: Michael Albinus Date: Thu Oct 26 15:55:15 2023 +0200 * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index fc6b4ce0e60..1853886596a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -6092,32 +6092,20 @@ Traces and Profiles @noindent The verbosity levels are -@enumerate -@item -Silent (no @value{tramp} messages at all) -@item -Errors -@item -Warnings -@item -Connection to remote hosts (default verbosity) -@item -Activities -@item -Internal -@item -Sent and received strings -@item -Connection properties -@item -File caching -@item -Test commands -@item -Traces (huge) -@item -Call traces (maintainer only) -@end enumerate +@itemize @w{} +@item @w{ 0} Silent (no @value{tramp} messages at all) +@item @w{ 1} Errors +@item @w{ 2} Warnings +@item @w{ 3} Connectioncccc to remote hosts (default verbosity) +@item @w{ 4} Activities +@item @w{ 5} Internal +@item @w{ 6} Sent and received strings +@item @w{ 7} Connection properties +@item @w{ 8} File caching +@item @w{ 9} Test commands +@item @w{10} Traces (huge) +@item @w{11} Call traces (maintainer only) +@end itemize With @code{tramp-verbose} greater than or equal to 4, messages are also written to the @value{tramp} debug buffer @file{*debug commit 309823ff7796416414cee8c6f4d2650615c19f64 Author: João Távora Date: Thu Oct 26 14:20:41 2023 +0100 Flymake: protect against problematic invalid diagnostics If a backend reports a diagnostic which is out of bounds, it still lives in flymake--state and will still be cleaned up in the next run of flymake--publish-diagnostics. But if flymake--highlight-line doesn't give it an overlay (which it didn't until now), things will break afterwards. See bug#66759 and https://github.com/joaotavora/eglot/discussions/1311 * lisp/progmodes/flymake.el (flymake--highlight-line): Set flymake--diag-overlay earlier. (Version): Bump to 1.3.7. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index b27e6527f81..fb000517655 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,7 +4,7 @@ ;; Author: Pavel Kobyakov ;; Maintainer: João Távora -;; Version: 1.3.6 +;; Version: 1.3.7 ;; Keywords: c languages tools ;; Package-Requires: ((emacs "26.1") (eldoc "1.14.0") (project "0.7.1")) @@ -809,6 +809,7 @@ flymake--highlight-line (flymake--diag-orig-end e)) (flymake--delete-overlay eov))) (setq ov (make-overlay beg end)) + (setf (flymake--diag-overlay diagnostic) ov) (when (= (overlay-start ov) (overlay-end ov)) ;; Some backends report diagnostics with invalid bounds. Don't ;; bother. @@ -863,7 +864,6 @@ flymake--highlight-line (overlay-put ov 'evaporate t) (overlay-put ov 'flymake-overlay t) (overlay-put ov 'flymake-diagnostic diagnostic) - (setf (flymake--diag-overlay diagnostic) ov) ;; Handle `flymake-show-diagnostics-at-end-of-line' ;; (when flymake-show-diagnostics-at-end-of-line commit 7c668eb75b3e59819c9c3ddf00ed38cb89d3ca18 Author: Po Lu Date: Thu Oct 26 19:49:40 2023 +0800 Properly respond to drops observing the Motif protocol * lisp/pgtk-dnd.el (pgtk-dnd-handle-file-name): * lisp/x-dnd.el (x-dnd-handle-file-name): Correct order of arguments to d-h-m-u. diff --git a/lisp/pgtk-dnd.el b/lisp/pgtk-dnd.el index 2ce1571aefc..48edaa2472a 100644 --- a/lisp/pgtk-dnd.el +++ b/lisp/pgtk-dnd.el @@ -253,16 +253,17 @@ pgtk-dnd-handle-file-name retval) (let ((did-action (dnd-handle-multiple-urls - window action (mapcar - (lambda (item) - (when coding - (setq item (encode-coding-string item - coding))) - (concat "file://" - (mapconcat 'url-hexify-string - (split-string item "/") - "/"))) - uri-list)))) + window (mapcar + (lambda (item) + (when coding + (setq item (encode-coding-string item + coding))) + (concat "file://" + (mapconcat 'url-hexify-string + (split-string item "/") + "/"))) + uri-list) + action))) (when did-action (setq retval did-action))) retval)) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index eca1e93ba07..cf7f61b39a7 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -384,16 +384,18 @@ x-dnd-handle-file-name retval) (let ((did-action (dnd-handle-multiple-urls - window action (mapcar - (lambda (item) - (when coding - (setq item (encode-coding-string item - coding))) - (concat "file://" - (mapconcat 'url-hexify-string - (split-string item "/") - "/"))) - uri-list)))) + window + (mapcar + (lambda (item) + (when coding + (setq item (encode-coding-string item + coding))) + (concat "file://" + (mapconcat 'url-hexify-string + (split-string item "/") + "/"))) + uri-list) + action))) (when did-action (setq retval did-action))) retval)) commit 6ad14b658f1ba8df0f549a5a08f6a3f9d1666bf9 Author: Po Lu Date: Thu Oct 26 19:46:32 2023 +0800 Correct typos in the manuals * doc/misc/tramp.texi (Traces and Profiles): Don't mimic @enumerate with @indentedblock, which is absent from Texinfo 4.13. * doc/misc/use-package.texi (Global keybindings): Remove stray comma after @xref. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 61910a3d86d..fc6b4ce0e60 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -6092,20 +6092,32 @@ Traces and Profiles @noindent The verbosity levels are -@indentedblock - @w{ 0} silent (no @value{tramp} messages at all) -@* @w{ 1} errors -@* @w{ 2} warnings -@* @w{ 3} connection to remote hosts (default verbosity) -@* @w{ 4} activities -@* @w{ 5} internal -@* @w{ 6} sent and received strings -@* @w{ 7} connection properties -@* @w{ 8} file caching -@* @w{ 9} test commands -@* @w{10} traces (huge) -@* @w{11} call traces (maintainer only) -@end indentedblock +@enumerate +@item +Silent (no @value{tramp} messages at all) +@item +Errors +@item +Warnings +@item +Connection to remote hosts (default verbosity) +@item +Activities +@item +Internal +@item +Sent and received strings +@item +Connection properties +@item +File caching +@item +Test commands +@item +Traces (huge) +@item +Call traces (maintainer only) +@end enumerate With @code{tramp-verbose} greater than or equal to 4, messages are also written to the @value{tramp} debug buffer @file{*debug diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi index 4046c3a62ce..37ed50ab2b1 100644 --- a/doc/misc/use-package.texi +++ b/doc/misc/use-package.texi @@ -940,7 +940,7 @@ Global keybindings Remapping of commands with @code{:bind} and @code{bind-key} works as expected, because when the binding is a vector, it is passed straight to @code{define-key}. @xref{Remapping Commands,,, elisp, GNU Emacs -Lisp Reference Manual}), for more information about command remapping. +Lisp Reference Manual}, for more information about command remapping. For example, the following declaration will rebind @code{fill-paragraph} (bound to @kbd{M-q} by default) to @code{unfill-toggle}: commit 11f44ec6dda8660ad5270ee7c76d8b48062dc327 Author: Po Lu Date: Thu Oct 26 11:37:58 2023 +0000 Enable DND handlers to receive more than one URI at a time * doc/lispref/frames.texi (Drag and Drop): Illustrate the effect of the dnd-multiple-handler property and how convergent handlers are reconciled. * etc/NEWS (Lisp Changes in Emacs 30.1): Announce this change. * lisp/dnd.el (dnd-protocol-alist): Bring doc string up to date. (dnd-handle-one-url): Obsolete this function. (dnd-handle-multiple-urls): New function. * lisp/pgtk-dnd.el (pgtk-dnd-handle-uri-list) (pgtk-dnd-handle-file-name): * lisp/term/android-win.el (android-handle-dnd-event): * lisp/term/haiku-win.el (haiku-drag-and-drop): * lisp/term/ns-win.el (ns-drag-n-drop): * lisp/term/w32-win.el (w32-handle-dropped-file): * lisp/x-dnd.el (x-dnd-handle-uri-list, x-dnd-handle-file-name): Reimplement in terms of `dnd-handle-multiple-uris'. * lisp/term/pgtk-win.el (pgtk-drag-n-drop) (pgtk-drag-n-drop-other-frame, pgtk-drag-n-drop-as-text): Efface detritus that remained after the removal of the old PGTK drag and drop implementation. * test/lisp/dnd-tests.el (ert-x, dnd-tests-list-1) (dnd-tests-list-2, dnd-tests-list-3, dnd-tests-list-4) (dnd-tests-local-file-function, dnd-tests-remote-file-function) (dnd-tests-http-scheme-function, dnd-tests-browse-url-handler) (dnd-tests-receive-multiple-urls): New tests. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index ef5ed146015..5013cd28420 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4724,9 +4724,9 @@ Drag and Drop @cindex drag and drop Data transferred by drag and drop is generally either plain text or -a URL designating a file or another resource. When text is dropped, -it is inserted at the location of the drop, with recourse to saving it -into the kill ring if that is not possible. +a list of URLs designating files or other resources. When text is +dropped, it is inserted at the location of the drop, with recourse to +saving it into the kill ring if that is not possible. URLs dropped are supplied to pertinent @dfn{DND handler functions} in the variable @code{dnd-protocol-alist}, or alternatively ``URL @@ -4740,9 +4740,14 @@ Drag and Drop matched and DND handler functions called on the dropping of matching URLs. -Each handler function is called with the URL that matched it and one -of the symbols @code{copy}, @code{move}, @code{link}, @code{private} -or @code{ask} identifying the action to be taken. +@cindex dnd-multiple-handler, a symbol property +If a handler function is a symbol whose @code{dnd-multiple-handler} +property (@pxref{Symbol Properties}) is set, then upon a drop it is +given a list of every URL that matches its regexp; absent this +property, it is called once for each of those URLs. Following this +first argument is one of the symbols @code{copy}, @code{move}, +@code{link}, @code{private} or @code{ask} identifying the action to be +taken. If @var{action} is @code{private}, the program that initiated the drop does not insist on any particular behavior on the part of its @@ -4750,19 +4755,29 @@ Drag and Drop or copy its contents into the current buffer. The other values of @var{action} imply much the same as in the @var{action} argument to @code{dnd-begin-file-drag}. + +Once its work completes, a handler function must return a symbol +designating the action it took: either the action it was provided, or +the symbol @code{private}, which communicates to the source of the +drop that the action it prescribed has not been executed. + +When multiple handlers match an overlapping subset of items within a +drop, the handler matched against by the greatest number of items is +called to open that subset. The items it is supplied are subsequently +withheld from other handlers, even those they also match. @end defvar @cindex drag and drop, X @cindex drag and drop, other formats - Emacs does not take measures to accept data besides text and URLs by -default, for the window system interfaces which enable this are too -far removed from each other to abstract over consistently. Nor are -DND handlers accorded the capacity to influence the action they are -meant to take, as particular drag-and-drop protocols deny recipients -such control. The X11 drag-and-drop implementation rests on several -underlying protocols that make use of selection transfer and share -much in common, to which low level access is provided through the -following functions and variables: + Emacs does not take measures to accept data besides text and URLs, +for the window system interfaces which enable this are too far removed +from each other to abstract over consistently. Nor are DND handlers +accorded influence over the actions they are meant to take, as +particular drag-and-drop protocols deny recipients such control. The +X11 drag-and-drop implementation rests on several underlying protocols +that make use of selection transfer and share much in common, to which +low level access is provided through the following functions and +variables: @defvar x-dnd-test-function This function is called to ascertain whether Emacs should accept a diff --git a/etc/NEWS b/etc/NEWS index 99bf52eab77..3ad886bdc2b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1122,6 +1122,16 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** Drag-and-drop functions can now be called once for compound drops. +It is now possible for drag-and-drop handler functions to respond to +drops incorporating more than one URL. Functions capable of this must +set their 'dnd-multiple-handler' symbol properties to a non-nil value. +See the Info node "(elisp)Drag and Drop". + +Incident to this change, the function 'dnd-handle-one-url' has been +made obsolete, for it cannot take these new handlers into account. + ** New function 're-disassemble' to see the innards of a regexp. If you compiled with '--enable-checking', you can use this to help debug either your regexp performance problems or the regexp engine. diff --git a/lisp/dnd.el b/lisp/dnd.el index 14581e3d414..c27fdeb7745 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -46,13 +46,14 @@ dnd-protocol-alist (,(purecopy "^file://") . dnd-open-file) ; URL with host (,(purecopy "^file:") . dnd-open-local-file) ; Old KDE, Motif, Sun (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) - "The functions to call for different protocols when a drop is made. -This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'. +This variable is used by `dnd-handle-multiple-urls'. The list contains of (REGEXP . FUNCTION) pairs. The functions shall take two arguments, URL, which is the URL dropped and ACTION which is the action to be performed for the drop (move, copy, link, private or ask). +If a function's `dnd-multiple-handler' property is set, it is provided +a list of each URI dropped instead. If no match is found here, and the value of `browse-url-browser-function' is a pair of (REGEXP . FUNCTION), those regexps are tried for a match. If no match is found, the URL is inserted as text by calling `dnd-insert-text'. @@ -159,7 +160,10 @@ dnd-handle-one-url `browse-url-default-handlers' are searched for a match. If no match is found, just call `dnd-insert-text'. WINDOW is where the drop happened, ACTION is the action for the drop, URL -is what has been dropped. Returns ACTION." +is what has been dropped. Returns ACTION. + +This function has been obsolete since Emacs 30.1; it has been +supplanted by `dnd-handle-multiple-urls'." (let (ret) (or (catch 'done @@ -180,6 +184,90 @@ dnd-handle-one-url (setq ret 'private))) ret)) +(make-obsolete 'dnd-handle-one-url 'dnd-handle-multiple-urls "30.1") + +(defun dnd-handle-multiple-urls (window urls action) + "Select a handler for, then open, each element of URLS. +The argument ACTION is the action which must be taken, much as +that to `dnd-begin-file-drag'. + +Assign and give each URL to one of the \"DND handler\" functions +listed in the variable `dnd-protocol-alist'. When multiple +handlers matching the same subset of URLs exist, give precedence +to the handler assigned the greatest number of URLs. + +If a handler is a symbol with the property +`dnd-multiple-handler', call it with ACTION and a list of every +URL it is assigned. Otherwise, call it once for each URL +assigned with ACTION and the URL in question. + +Subsequently open URLs that don't match any handlers opened with +any handler selected by `browse-url-select-handler', and failing +even that, insert them with `dnd-insert-text'. + +Return a symbol designating the actions taken by each DND handler +called. If all DND handlers called return the same symbol, +return that symbol; otherwise, or if no DND handlers are called, +return `private'. + +Do not rely on the contents of URLS after calling this function, +for it will be modified." + (let ((list nil) (return-value nil)) + (with-selected-window window + (dolist (handler dnd-protocol-alist) + (let ((pattern (car handler)) + (handler (cdr handler))) + (dolist (uri urls) + (when (string-match pattern uri) + (let ((cell (or (cdr (assq handler list)) + (let ((cell (cons handler nil))) + (push cell list) + cell)))) + (setcdr cell (cons uri (cdr cell)))))))) + (setq list (nreverse list)) + ;; While unassessed handlers still exist... + (while list + ;; Sort list by the number of URLs assigned to each handler. + (setq list (sort list (lambda (first second) + (> (length (cdr first)) + (length (cdr second)))))) + ;; Call the handler in its car before removing each URL from + ;; URLs. + (let ((handler (caar list)) + (entry-urls (cdar list))) + (setq list (cdr list)) + (when entry-urls + (if (and (symbolp handler) + (get handler 'dnd-multiple-handler)) + (progn + (let ((value (funcall handler entry-urls action))) + (if (or (not return-value) + (eq return-value value)) + (setq return-value value) + (setq return-value 'private))) + (dolist (url entry-urls) + (setq urls (delq url urls)) + ;; And each handler-URL list after this. + (dolist (item list) + (setcdr item (delq url (cdr item)))))) + (dolist (url entry-urls) + (let ((value (funcall handler url action))) + (if (or (not return-value) (eq return-value value)) + (setq return-value value) + (setq return-value 'private))) + (setq urls (delq url urls)) + ;; And each handler-URL list after this. + (dolist (item list) + (setcdr item (delq url (cdr item))))))))) + ;; URLS should now incorporate only those which haven't been + ;; assigned their own handlers. + (dolist (leftover urls) + (setq return-value 'private) + (if-let ((handler (browse-url-select-handler leftover + 'internal))) + (funcall handler leftover action) + (dnd-insert-text window action leftover))) + (or return-value 'private)))) (defun dnd-get-local-file-uri (uri) "Return an uri converted to file:/// syntax if uri is a local file. diff --git a/lisp/pgtk-dnd.el b/lisp/pgtk-dnd.el index f2998fd1e67..2ce1571aefc 100644 --- a/lisp/pgtk-dnd.el +++ b/lisp/pgtk-dnd.el @@ -238,10 +238,9 @@ pgtk-dnd-handle-uri-list STRING is the uri-list as a string. The URIs are separated by \\r\\n." (let ((uri-list (split-string string "[\0\r\n]" t)) retval) - (dolist (bf uri-list) - ;; If one URL is handled, treat as if the whole drop succeeded. - (let ((did-action (dnd-handle-one-url window action bf))) - (when did-action (setq retval did-action)))) + (let ((did-action (dnd-handle-multiple-urls window uri-list + action))) + (when did-action (setq retval did-action))) retval)) (defun pgtk-dnd-handle-file-name (window action string) @@ -252,17 +251,21 @@ pgtk-dnd-handle-file-name (coding (or file-name-coding-system default-file-name-coding-system)) retval) - (dolist (bf uri-list) - ;; If one URL is handled, treat as if the whole drop succeeded. - (if coding (setq bf (encode-coding-string bf coding))) - (let* ((file-uri (concat "file://" - (mapconcat 'url-hexify-string - (split-string bf "/") "/"))) - (did-action (dnd-handle-one-url window action file-uri))) - (when did-action (setq retval did-action)))) + (let ((did-action + (dnd-handle-multiple-urls + window action (mapcar + (lambda (item) + (when coding + (setq item (encode-coding-string item + coding))) + (concat "file://" + (mapconcat 'url-hexify-string + (split-string item "/") + "/"))) + uri-list)))) + (when did-action (setq retval did-action))) retval)) - (defun pgtk-dnd-choose-type (types &optional known-types) "Choose which type we want to receive for the drop. TYPES are the types the source of the drop offers, a vector of type names diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index f3f5c227df0..b73251456fa 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -272,6 +272,7 @@ android-handle-dnd-event ((eq (car message) 'uri) (let ((uri-list (split-string (cdr message) "[\0\r\n]" t)) + (new-uri-list nil) (dnd-unescape-file-uris t)) (dolist (uri uri-list) (ignore-errors @@ -286,7 +287,9 @@ android-handle-dnd-event ;; subject to URI decoding, for it must be ;; transformed back into a content URI. dnd-unescape-file-uris nil)))) - (dnd-handle-one-url (posn-window posn) 'copy uri))))))) + (push uri new-uri-list)) + (dnd-handle-multiple-urls (posn-window posn) 'copy + new-uri-list)))))) (define-key special-event-map [drag-n-drop] 'android-handle-dnd-event) diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 50c9cb5b9d4..f53cf7939b9 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -369,14 +369,15 @@ haiku-drag-and-drop ((posn-area (event-start event))) ((assoc "refs" string) (with-selected-window window - (dolist (filename (cddr (assoc "refs" string))) - (dnd-handle-one-url window action - (concat "file:" filename))))) + (dnd-handle-multiple-urls + window (mapcar + (lambda (name) (concat "file:" name)) + (cddr (assoc "refs" string))) + action))) ((assoc "text/uri-list" string) (dolist (text (cddr (assoc "text/uri-list" string))) (let ((uri-list (split-string text "[\0\r\n]" t))) - (dolist (bf uri-list) - (dnd-handle-one-url window action bf))))) + (dnd-handle-multiple-urls window uri-list action)))) ((assoc "text/plain" string) (with-selected-window window (dolist (text (cddr (assoc "text/plain" string))) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 7525b9321ca..e40a0ce3e96 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -520,11 +520,12 @@ ns-drag-n-drop (goto-char (posn-point (event-start event))) (cond ((or (memq 'ns-drag-operation-generic operations) (memq 'ns-drag-operation-copy operations)) - ;; Perform the default/copy action. - (dolist (data objects) - (dnd-handle-one-url window 'private (if (eq type 'file) - (concat "file:" data) - data)))) + (let ((urls (if (eq type 'file) (mapcar + (lambda (file) + (concat "file:" file)) + objects) + objects))) + (dnd-handle-multiple-urls window urls 'private))) (t ;; Insert the text as is. (dnd-insert-text window 'private string)))))) diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index f2552d3b057..ef854a28278 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -48,45 +48,6 @@ pgtk-use-im-context-on-new-connection (declare-function pgtk-use-im-context "pgtkim.c") -(defun pgtk-drag-n-drop (event &optional new-frame force-text) - "Edit the files listed in the drag-n-drop EVENT. -Switch to a buffer editing the last file dropped." - (interactive "e") - (let* ((window (posn-window (event-start event))) - (arg (car (cdr (cdr event)))) - (type (car arg)) - (data (car (cdr arg))) - (url-or-string (cond ((eq type 'file) - (concat "file:" data)) - (t data)))) - (set-frame-selected-window nil window) - (when new-frame - (select-frame (make-frame))) - (raise-frame) - (setq window (selected-window)) - (if force-text - (dnd-insert-text window 'private data) - (dnd-handle-one-url window 'private url-or-string)))) - -(defun pgtk-drag-n-drop-other-frame (event) - "Edit the files listed in the drag-n-drop EVENT, in other frames. -May create new frames, or reuse existing ones. The frame editing -the last file dropped is selected." - (interactive "e") - (pgtk-drag-n-drop event t)) - -(defun pgtk-drag-n-drop-as-text (event) - "Drop the data in EVENT as text." - (interactive "e") - (pgtk-drag-n-drop event nil t)) - -(defun pgtk-drag-n-drop-as-text-other-frame (event) - "Drop the data in EVENT as text in a new frame." - (interactive "e") - (pgtk-drag-n-drop event t t)) - -(global-set-key [drag-n-drop] 'pgtk-drag-n-drop) - (defun pgtk-suspend-error () "Don't allow suspending if any of the frames are PGTK frames." (if (memq 'pgtk (mapcar 'window-system (frame-list))) @@ -392,7 +353,6 @@ pgtk-device-class (defvaralias 'x-gtk-use-system-tooltips 'use-system-tooltips) - (define-key special-event-map [drag-n-drop] #'pgtk-dnd-handle-drag-n-drop-event) (add-hook 'after-make-frame-functions #'pgtk-dnd-init-frame) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index c9e25f4f83d..4f1fd475392 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -117,12 +117,14 @@ w32-handle-dropped-file (split-string (encode-coding-string f coding) "/") "/"))) - (dnd-handle-one-url window 'private - (concat - (if (eq system-type 'cygwin) - "file://" - "file:") - file-name))) + ;; FIXME: is the W32 build capable only of receiving a single file + ;; from each drop? + (dnd-handle-multiple-urls window (list (concat + (if (eq system-type 'cygwin) + "file://" + "file:") + file-name)) + 'private)) (defun w32-drag-n-drop (event &optional new-frame) "Edit the files listed in the drag-n-drop EVENT. diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index b87fc97f8fd..eca1e93ba07 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -369,10 +369,9 @@ x-dnd-handle-uri-list STRING is the uri-list as a string. The URIs are separated by \\r\\n." (let ((uri-list (split-string string "[\0\r\n]" t)) retval) - (dolist (bf uri-list) - ;; If one URL is handled, treat as if the whole drop succeeded. - (let ((did-action (dnd-handle-one-url window action bf))) - (when did-action (setq retval did-action)))) + (let ((did-action (dnd-handle-multiple-urls window uri-list + action))) + (when did-action (setq retval did-action))) retval)) (defun x-dnd-handle-file-name (window action string) @@ -383,17 +382,21 @@ x-dnd-handle-file-name (coding (or file-name-coding-system default-file-name-coding-system)) retval) - (dolist (bf uri-list) - ;; If one URL is handled, treat as if the whole drop succeeded. - (if coding (setq bf (encode-coding-string bf coding))) - (let* ((file-uri (concat "file://" - (mapconcat 'url-hexify-string - (split-string bf "/") "/"))) - (did-action (dnd-handle-one-url window action file-uri))) - (when did-action (setq retval did-action)))) + (let ((did-action + (dnd-handle-multiple-urls + window action (mapcar + (lambda (item) + (when coding + (setq item (encode-coding-string item + coding))) + (concat "file://" + (mapconcat 'url-hexify-string + (split-string item "/") + "/"))) + uri-list)))) + (when did-action (setq retval did-action))) retval)) - (defun x-dnd-choose-type (types &optional known-types) "Choose which type we want to receive for the drop. TYPES are the types the source of the drop offers, a vector of type names diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el index 9f97d739cec..342b6e49be4 100644 --- a/test/lisp/dnd-tests.el +++ b/test/lisp/dnd-tests.el @@ -33,6 +33,7 @@ (require 'tramp) (require 'select) (require 'ert-x) +(require 'browse-url) (defvar dnd-tests-selection-table nil "Alist of selection names to their values.") @@ -437,5 +438,100 @@ dnd-tests-direct-save (ignore-errors (delete-file normal-temp-file))))) + + +(defvar dnd-tests-list-1 '("file:///usr/openwin/include/pixrect/pr_impl.h" + "file:///usr/openwin/include/pixrect/pr_io.h") + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defvar dnd-tests-list-2 '("file:///usr/openwin/include/pixrect/pr_impl.h" + "file://remote/usr/openwin/include/pixrect/pr_io.h") + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defvar dnd-tests-list-3 (append dnd-tests-list-2 '("http://example.com")) + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defvar dnd-tests-list-4 (append dnd-tests-list-3 '("scheme1://foo.bar" + "scheme2://foo.bar")) + "Sample data for tests concerning the treatment of drag-and-drop URLs.") + +(defun dnd-tests-local-file-function (urls _action) + "Signal an error if URLS doesn't match `dnd-tests-list-1'. +ACTION is ignored. Return the symbol `copy' otherwise." + (should (equal urls dnd-tests-list-1)) + 'copy) + +(put 'dnd-tests-local-file-function 'dnd-multiple-handler t) + +(defun dnd-tests-remote-file-function (urls _action) + "Signal an error if URLS doesn't match `dnd-tests-list-2'. +ACTION is ignored. Return the symbol `copy' otherwise." + (should (equal urls dnd-tests-list-2)) + 'copy) + +(put 'dnd-tests-remote-file-function 'dnd-multiple-handler t) + +(defun dnd-tests-http-scheme-function (url _action) + "Signal an error if URLS doesn't match `dnd-tests-list-3''s third element. +ACTION is ignored. Return the symbol `private' otherwise." + (should (equal url (car (last dnd-tests-list-3)))) + 'private) + +(defun dnd-tests-browse-url-handler (url &rest _ignored) + "Verify URL is `dnd-tests-list-4''s fourth element." + (should (equal url (nth 3 dnd-tests-list-4)))) + +(put 'dnd-tests-browse-url-handler 'browse-url-browser-kind 'internal) + +(ert-deftest dnd-tests-receive-multiple-urls () + (let ((dnd-protocol-alist '(("^file:///" . dnd-tests-local-file-function) + ("^file:" . error) + ("^unrelated-scheme:" . error))) + (browse-url-handlers nil)) + ;; Check that the order of the alist is respected when the + ;; precedences of two handlers are equal. + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-1) + 'copy) + 'copy)) + ;; Check that sorting handlers by precedence functions correctly. + (setq dnd-protocol-alist '(("^file:///" . error) + ("^file:" . dnd-tests-remote-file-function) + ("^unrelated-scheme:" . error))) + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-2) + 'copy) + 'copy)) + ;; Check that multiple handlers can be called at once, and actions + ;; are properly "downgraded" to private when multiple handlers + ;; return inconsistent values. + (setq dnd-protocol-alist '(("^file:" . dnd-tests-remote-file-function) + ("^file:///" . error) + ("^http://" . dnd-tests-http-scheme-function))) + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-3) + 'copy) + 'private)) + ;; Now verify that the function's documented fallback behavior + ;; functions correctly. Set browse-url-handlers to an association + ;; list incorporating a test function, then guarantee that is + ;; called. + (setq browse-url-handlers '(("^scheme1://" . dnd-tests-browse-url-handler))) + ;; Furthermore, guarantee the fifth argument of the test data is + ;; inserted, for no apposite handler exists. + (save-window-excursion + (set-window-buffer nil (get-buffer-create " *dnd-tests*")) + (set-buffer (get-buffer-create " *dnd-tests*")) + (erase-buffer) + (should (equal (dnd-handle-multiple-urls (selected-window) + (copy-sequence + dnd-tests-list-4) + 'copy) + 'private)) + (should (equal (buffer-string) (nth 4 dnd-tests-list-4)))))) + (provide 'dnd-tests) ;;; dnd-tests.el ends here commit b62ad00981ec98fc07fd798a4e6e75c90aad9200 Author: Harald Jörg Date: Thu Oct 26 12:06:12 2023 +0200 cperl-mode.el: Make commands and options for Perl info pages obsolete. The Perl documentation in info format is no longer distributed with Perl, nor is it available from CPAN. Point to cperl-perldoc instead. * lisp/progmodes/cperl-mode.el (cperl-info-page): Make obsolete. (cperl-tips): Remove outdated instructions to get Perl info sources from the docstring. (cperl-praise): Remove advertising the info interface in the docstring. (cperl-mode-map): Replace bindings to `cperl-info-on-command' and `cperl-info-on-current-command' by `cperl-perldoc'. (cperl-menu): Remove menu entries pointing to the Perl info page. (cperl-mode): Remove explanation of the Perl info commands from the docstring. (cperl-info-on-command, cperl-info-on-current-command), (cperl-imenu-info-imenu-search, cperl-imenu-on-info): Declare the commands obsolete. * etc/NEWS: Describe the obsoletion of Perl info commands. diff --git a/etc/NEWS b/etc/NEWS index f8d4a3c3efe..99bf52eab77 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -870,6 +870,12 @@ 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. +*** 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 +read with 'cperl-perldoc' instead. + ** Emacs Sessions (Desktop) +++ diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 807927aa86d..9244c6a923a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -433,6 +433,11 @@ cperl-info-page Older version of this page was called `perl5', newer `perl'." :type 'string :group 'cperl-help-system) +(make-obsolete-variable 'cperl-info-page + (concat "The Perl info page is no longer maintained. " + "Consider installing the perl-doc package from " + "GNU ELPA to access Perl documentation.") + "30.1") (defcustom cperl-use-syntax-table-text-property t "Non-nil means CPerl sets up and uses `syntax-table' text property." @@ -630,14 +635,9 @@ cperl-tips (add-to-list \\='major-mode-remap-alist \\='(perl-mode . cperl-mode)) -Get perl5-info from - $CPAN/doc/manual/info/perl5-old/perl5-info.tar.gz -Also, one can generate a newer documentation running `pod2texi' converter - $CPAN/doc/manual/info/perl5/pod2texi-0.1.tar.gz - -If you use imenu-go, run imenu on perl5-info buffer (you can do it -from Perl menu). If many files are related, generate TAGS files from -Tools/Tags submenu in Perl menu. +To read Perl documentation in info format you can convert POD to +texinfo with the converter `pod2texi' from the texinfo project: + https://www.gnu.org/software/texinfo/manual/pod2texi.html If some class structure is too complicated, use Tools/Hierarchy-view from Perl menu, or hierarchic view of imenu. The second one uses the @@ -704,9 +704,7 @@ cperl-praise 3) Separate list of packages/classes; 4) Hierarchical view of methods in (sub)packages; 5) and functions (by the full name - with package); - e) Has an interface to INFO docs for Perl; The interface is - very flexible, including shrink-wrapping of - documentation buffer/frame; + e) This item has retired. f) Has a builtin list of one-line explanations for perl constructs. g) Can show these explanations if you stay long enough at the corresponding place (or on demand); @@ -978,12 +976,12 @@ cperl-mode-map (define-key map "\177" 'cperl-electric-backspace) (define-key map "\t" 'cperl-indent-command) ;; don't clobber the backspace binding: - (define-key map [(control ?c) (control ?h) ?F] 'cperl-info-on-command) + (define-key map [(control ?c) (control ?h) ?F] 'cperl-perldoc) (if (cperl-val 'cperl-clobber-lisp-bindings) (progn (define-key map [(control ?h) ?f] ;;(concat (char-to-string help-char) "f") ; does not work - 'cperl-info-on-command) + 'cperl-perldoc) (define-key map [(control ?h) ?v] ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help) @@ -994,7 +992,7 @@ cperl-mode-map ;;(concat (char-to-string help-char) "v") ; does not work (key-binding "\C-hv"))) (define-key map [(control ?c) (control ?h) ?f] - 'cperl-info-on-current-command) + 'cperl-perldoc) (define-key map [(control ?c) (control ?h) ?v] ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help)) @@ -1051,7 +1049,6 @@ cperl-menu "----" ("Tools" ["Imenu" imenu] - ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)] "----" ["Ispell PODs" cperl-pod-spell ;; Better not to update syntaxification here: @@ -1110,8 +1107,6 @@ cperl-menu ;; This is from imenu-go.el. I can't find it on any ELPA ;; archive, so I'm not sure if it's still in use or not. (fboundp 'imenu-go-find-at-position)] - ["Help on function" cperl-info-on-command t] - ["Help on function at point" cperl-info-on-current-command t] ["Help on symbol at point" cperl-get-help t] ["Perldoc" cperl-perldoc t] ["Perldoc on word at point" cperl-perldoc-at-point t] @@ -1716,16 +1711,8 @@ cperl-mode whitespace inserted by semis and braces in `auto-newline'-mode by consequent \\[cperl-electric-backspace]. -If your site has perl5 documentation in info format, you can use commands -\\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it. -These keys run commands `cperl-info-on-current-command' and -`cperl-info-on-command', which one is which is controlled by variable -`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings' -\(in turn affected by `cperl-hairy'). - -Even if you have no info-format documentation, short one-liner-style -help is available on \\[cperl-get-help], and one can run perldoc or -man via menu. +Short one-liner-style help is available on \\[cperl-get-help], +and one can run perldoc or man via menu. It is possible to show this help automatically after some idle time. This is regulated by variable `cperl-lazy-help-time'. Default with @@ -1817,8 +1804,8 @@ cperl-mode (cperl-val 'cperl-info-on-command-no-prompt)) (progn ;; don't clobber the backspace binding: - (define-key cperl-mode-map "\C-hf" 'cperl-info-on-current-command) - (define-key cperl-mode-map "\C-c\C-hf" 'cperl-info-on-command))) + (define-key cperl-mode-map "\C-hf" 'cperl-perldoc) + (define-key cperl-mode-map "\C-c\C-hf" 'cperl-perldoc))) (setq local-abbrev-table cperl-mode-abbrev-table) (if (cperl-val 'cperl-electric-keywords) (abbrev-mode 1)) @@ -6589,10 +6576,7 @@ cperl-word-at-point 'find-tag-default)))))) (defun cperl-info-on-command (command) - "Show documentation for Perl command COMMAND in other window. -If perl-info buffer is shown in some frame, uses this frame. -Customized by setting variables `cperl-shrink-wrap-info-frame', -`cperl-max-help-size'." + (declare (obsolete cperl-perldoc "30.1")) (interactive (let* ((default (cperl-word-at-point)) (read (read-string @@ -6668,25 +6652,26 @@ cperl-info-on-command (select-window iniwin))) (defun cperl-info-on-current-command () - "Show documentation for Perl command at point in other window." + (declare (obsolete cperl-perldoc "30.1")) (interactive) (cperl-info-on-command (cperl-word-at-point))) (defun cperl-imenu-info-imenu-search () + (declare (obsolete nil "30.1")) (if (looking-at "^-X[ \t\n]") nil (re-search-backward "^\n\\([-a-zA-Z_]+\\)[ \t\n]") (forward-line 1))) (defun cperl-imenu-info-imenu-name () + (declare (obsolete nil "30.1")) (buffer-substring (match-beginning 1) (match-end 1))) (declare-function imenu-choose-buffer-index "imenu" (&optional prompt alist)) (defun cperl-imenu-on-info () - "Show imenu for Perl Info Buffer. -Opens Perl Info buffer if needed." + (declare (obsolete nil "30.1")) (interactive) (require 'imenu) (let* ((buffer (current-buffer)) commit fda07b56d9e985b6ae74a6845453b55da0345e3c Author: Po Lu Date: Thu Oct 26 04:50:19 2023 +0000 Revise selection documentation * doc/lispref/frames.texi (Window System Selections): (X Selections): * lisp/select.el (selection-coding-system): Correct misunderstandings about the nature of selection-coding-system under X. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 1a7af04b103..ef5ed146015 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4058,11 +4058,12 @@ Window System Selections MS-Windows and X@. Under MS-DOS and MS-Windows, it is the coding system by which all -clipboard text will be encoded and decoded, whereas on X it merely -supplies the EOL format of the selection text sent in response to a -request for text encoded by a matching coding system; which is to say -that if its value is @code{utf-8-dos}, it will influence requests for -@code{UTF8_STRING} data, but not those for @code{STRING}. +non-ASCII clipboard text will be encoded and decoded; if set under X, +it provides the coding system calls to @code{gui-get-selection} will +decode selection data for a subset of text data types by, and also +forces replies to selection requests for the polymorphic @code{TEXT} +data type to be encoded by the @code{compound-text-with-extensions} +coding system rather than Unicode. Its default value is the system code page under MS-Windows 95, 98 or Me, @code{utf-16le-dos} under NT/W2K/XP, @code{iso-latin-1-dos} on @@ -4154,12 +4155,12 @@ X Selections owner to a Lisp representation, which @code{gui-get-selection} returns. - By default, Emacs converts selection data consisting of any series -of bytes to a unibyte string holding those bytes, that consisting of a -single 16-bit or 32-bit word as an unsigned number, and that -consisting of multiple such words as a vector of unsigned numbers. -However, Emacs applies special treatment for data from the following -conversion targets: + Emacs converts selection data consisting of any series of bytes to a +unibyte string holding those bytes, that consisting of a single 16-bit +or 32-bit word as an unsigned number, and that consisting of multiple +such words as a vector of unsigned numbers. The exceptions to this +general pattern are that Emacs applies special treatment for data from +the following conversion targets: @table @code @item INTEGER @@ -4384,8 +4385,8 @@ X Selections @itemize @bullet @item A string of type @code{C_STRING}, if the selection contents contain no -multibyte characters, or contains 8-bit characters with all 8 bits -set. +multibyte characters, or contain ``raw 8-bit bytes'' (@pxref{Text +Representations}). @item A string of type @code{STRING}, if the selection contents can be diff --git a/lisp/select.el b/lisp/select.el index 09c678867d0..f62f7b07239 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -49,27 +49,28 @@ selection-coding-system \(Unicode) on NT/W2K/XP, and `iso-latin-1-dos' on MS-DOS. For X Windows: -When sending text via selection and clipboard, if the target -data-type matches this coding system according to the table -below, it is used for encoding the text. Otherwise (including -the case that this variable is nil), a proper coding system is -selected as below: - -data-type coding system ---------- ------------- -UTF8_STRING utf-8 -COMPOUND_TEXT compound-text-with-extensions -STRING iso-latin-1 -C_STRING raw-text-unix - -When receiving text, if this coding system is non-nil, it is used -for decoding regardless of the data-type. If this is nil, a -proper coding system is used according to the data-type as above. -See also the documentation of the variable `x-select-request-type' how -to control which data-type to request for receiving text. +This coding system replaces that of the default coding system +selection text is encoded by in reaction to a request for the +polymorphic `TEXT' selection target when its base coding system +is compatible with `compound-text' and the text being encoded +cannot be rendered Latin-1 without loss of information. + +It also replaces the coding system by which calls to +`gui-get-selection' decode selection requests for text data +types, which are enumerated below beside their respective coding +systems otherwise used. + +DATA TYPE CODING SYSTEM +-------------------------- ------------- +UTF8_STRING utf-8 +text/plain\\;charset=utf-8 utf-8 +COMPOUND_TEXT compound-text-with-extensions +STRING iso-latin-1 +C_STRING raw-text-unix -The default value is nil." +See also the documentation of the variable `x-select-request-type' how +to control which data-type to request for receiving text." :type 'coding-system :group 'mule ;; Default was compound-text-with-extensions in 22.x (pre-unicode). commit cfa3887e2dbcff25574e65cac380f151d0efd833 Author: Po Lu Date: Thu Oct 26 02:52:23 2023 +0000 Mollify byte compiler in builds without SQLite * lisp/sqlite-mode.el (sqlite-open): New declare-function. diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el index 38e9f84b842..120967a725f 100644 --- a/lisp/sqlite-mode.el +++ b/lisp/sqlite-mode.el @@ -33,6 +33,7 @@ (declare-function sqlite-finalize "sqlite.c") (declare-function sqlite-select "sqlite.c") (declare-function sqlite-open "sqlite.c") +(declare-function sqlite-close "sqlite.c") (defvar-keymap sqlite-mode-map "g" #'sqlite-mode-list-tables commit 2c72eecbaa4747ae287c0ab86810cfc1d3e87eb7 Author: Wilhelm H Kirschbaum Date: Sat Oct 7 10:37:49 2023 +0200 Simplify sigil font-lock match for elixir-ts-mode There is no need to match on specific sigils, except for regex. * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Update sigil match (bug#64275). diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 2ddce3de105..05edb4159a1 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -469,12 +469,11 @@ elixir-ts--font-lock-settings :override t `((sigil (sigil_name) @elixir-ts-font-sigil-name-face - (:match "^[sSwWpPUD]$" @elixir-ts-font-sigil-name-face)) + (:match "^[^HF]$" @elixir-ts-font-sigil-name-face)) @font-lock-string-face (sigil - "~" @font-lock-string-face - (sigil_name) @elixir-ts-font-sigil-name-face - (:match "^[rR]$" @elixir-ts-font-sigil-name-face)) + (sigil_name) @font-lock-regexp-face + (:match "^[rR]$" @font-lock-regexp-face)) @font-lock-regexp-face (sigil "~" @font-lock-string-face commit 70e25298f160ffec62e363056904b6238a87d4e0 Author: Dmitry Gutov Date: Thu Oct 26 02:38:56 2023 +0300 Tweak the DOI URL and the description * lisp/emacs-lisp/smie.el: Use a friendlier (HTTPS) DOI URL. And fix the year in the description. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 19a0c22027a..2bc7674b8bf 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -56,8 +56,8 @@ ;; which includes a kind of tutorial to get started with SMIE: ;; ;; SMIE: Weakness is Power! Auto-indentation with incomplete information -;; Stefan Monnier, Journal 2020, volume 5, issue 1. -;; doi: 10.22152/programming-journal.org/2021/5/1 +;; Stefan Monnier, Journal 2021, volume 5, issue 1. +;; doi: https://doi.org/10.22152/programming-journal.org/2021/5/1 ;; A good background to understand the development (especially the parts ;; building the 2D precedence tables and then computing the precedence levels commit 3d2d941576f5f1d6fdf30d5226cc6a5a52215e00 Author: Stefan Kangas Date: Wed Oct 25 23:26:37 2023 +0200 Support HTTPS links in newsticker extra elements * lisp/net/newst-reader.el (newsticker--do-print-extra-element): Support HTTPS links. diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el index 9ec0b395675..3c79304d8dd 100644 --- a/lisp/net/newst-reader.el +++ b/lisp/net/newst-reader.el @@ -237,7 +237,8 @@ newsticker--do-print-extra-element (cond ((listp contents) (mapc (lambda (i) (if (and (stringp i) - (string-match "^http://.*" i)) + (string-match + (rx bol "http" (? "s") "://" (* nonl)) i)) (let ((pos (point))) (insert i " ") ; avoid self-reference from the ; nt-link thing @@ -248,7 +249,7 @@ newsticker--do-print-extra-element 'help-echo (format "mouse-2: visit (%s)" i) 'keymap keymap))) - (insert (format "%s" i)))) + (insert (format "%s" i)))) contents)) (t (insert (format "%s" contents)))) commit 01242dda7799c8847e2ee33f5a47c1f6162f8c38 Author: Stefan Kangas Date: Wed Oct 25 23:23:45 2023 +0200 ; Fix webjump test after recent change * test/lisp/net/webjump-tests.el (webjump-tests-url-fix): Adjust test after recent change to prefer HTTPS. diff --git a/test/lisp/net/webjump-tests.el b/test/lisp/net/webjump-tests.el index 42fa346a869..ffdebf2bb6f 100644 --- a/test/lisp/net/webjump-tests.el +++ b/test/lisp/net/webjump-tests.el @@ -58,7 +58,7 @@ webjump-tests-url-encode (ert-deftest webjump-tests-url-fix () (should (equal (webjump-url-fix nil) "")) (should (equal (webjump-url-fix "/tmp/") "file:///tmp/")) - (should (equal (webjump-url-fix "gnu.org") "http://gnu.org/")) + (should (equal (webjump-url-fix "gnu.org") "https://gnu.org/")) (should (equal (webjump-url-fix "ftp.x.org") "ftp://ftp.x.org/")) (should (equal (webjump-url-fix "https://gnu.org") "https://gnu.org/"))) commit a73e662deffae4b13d9128e1558e449ed9f324c3 Author: Stefan Kangas Date: Wed Oct 25 01:33:47 2023 +0200 ; Fix two broken links diff --git a/lisp/info-look.el b/lisp/info-look.el index da45e30cd36..dc6c3226040 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -1,7 +1,6 @@ ;;; info-look.el --- major-mode-sensitive Info index lookup facility -*- lexical-binding: t -*- -;; An older version of this was known as libc.el. -;; Copyright (C) 1995-1999, 2001-2023 Free Software Foundation, Inc. +;; Copyright (C) 1995-2023 Free Software Foundation, Inc. ;; Author: Ralph Schleicher ;; Keywords: help languages @@ -28,9 +27,8 @@ ;; Some additional sources of (Tex)info files for non-GNU packages: ;; -;; Scheme: -;; LaTeX: -;; +;; Scheme: https://groups.csail.mit.edu/mac/ftpdir/scm/r5rs.info.tar.gz +;; LaTeX: https://mirrors.ctan.org/info/latex2e-help-texinfo/latex2e.texi ;; (or CTAN mirrors) ;; Perl: (or CPAN mirrors) commit beb0a7e1a7f79f54308cfcdc5c7ba2caaf72a494 Author: Michael Albinus Date: Wed Oct 25 19:25:53 2023 +0200 * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6e3a1a0eee1..61910a3d86d 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -6089,9 +6089,11 @@ Traces and Profiles to 10. @value{tramp} does not display all messages; only those with a verbosity level less than or equal to @code{tramp-verbose}. +@noindent The verbosity levels are - @w{ 0} silent (no @value{tramp} messages at all) +@indentedblock + @w{ 0} silent (no @value{tramp} messages at all) @* @w{ 1} errors @* @w{ 2} warnings @* @w{ 3} connection to remote hosts (default verbosity) @@ -6103,6 +6105,7 @@ Traces and Profiles @* @w{ 9} test commands @* @w{10} traces (huge) @* @w{11} call traces (maintainer only) +@end indentedblock With @code{tramp-verbose} greater than or equal to 4, messages are also written to the @value{tramp} debug buffer @file{*debug commit ccaf801baad95f470e9806e075a15a18eb216a54 Author: Michael Albinus Date: Wed Oct 25 19:21:05 2023 +0200 * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. (Don't merge) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index eb7d59a97b8..38c7a3babed 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5888,20 +5888,23 @@ Traces and Profiles to 10. @value{tramp} does not display all messages; only those with a verbosity level less than or equal to @code{tramp-verbose}. +@noindent The verbosity levels are - @w{ 0} silent (no @value{tramp} messages at all) -@*@indent @w{ 1} errors -@*@indent @w{ 2} warnings -@*@indent @w{ 3} connection to remote hosts (default verbosity) -@*@indent @w{ 4} activities -@*@indent @w{ 5} internal -@*@indent @w{ 6} sent and received strings -@*@indent @w{ 7} connection properties -@*@indent @w{ 8} file caching -@*@indent @w{ 9} test commands -@*@indent @w{10} traces (huge) -@*@indent @w{11} call traces (maintainer only) +@indentedblock + @w{ 0} silent (no @value{tramp} messages at all) +@* @w{ 1} errors +@* @w{ 2} warnings +@* @w{ 3} connection to remote hosts (default verbosity) +@* @w{ 4} activities +@* @w{ 5} internal +@* @w{ 6} sent and received strings +@* @w{ 7} connection properties +@* @w{ 8} file caching +@* @w{ 9} test commands +@* @w{10} traces (huge) +@* @w{11} call traces (maintainer only) +@end indentedblock With @code{tramp-verbose} greater than or equal to 4, messages are also written to a @value{tramp} debug buffer. Such debug buffers are @@ -5951,7 +5954,7 @@ Traces and Profiles @value{tramp} actions. If @code{tramp-verbose} is greater than or equal to 11, @value{tramp} -function call traces are written to the buffer @file{*trace-output*}. +function call traces are written to a @value{tramp} trace buffer. @node GNU Free Documentation License commit ce9d1d3f4dddba2c948affd0f1ccf6c4059f0af2 Author: Stefan Kangas Date: Wed Oct 25 15:13:08 2023 +0200 Support HTTPS in ido-file-internal * lisp/ido.el (ido-file-internal): Support HTTPS. diff --git a/lisp/ido.el b/lisp/ido.el index bbb3264f4f7..2daf3bae717 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -2326,7 +2326,7 @@ ido-file-internal (if (eq ido-use-filename-at-point 'guess) (ffap-guesser) (ffap-string-at-point)))) - (not (string-match "\\`http:/" fn))) + (not (string-match (rx bos "http" (? "s") ":/") fn))) (let ((absolute-fn (expand-file-name fn))) (cond ((file-directory-p absolute-fn) commit aa79a5fc0fb7c33d5502fbb3e4ba98479323e06d Author: Stefan Kangas Date: Wed Oct 25 14:34:15 2023 +0200 Support HTTPS URLs in newsticker-add-url * lisp/net/newst-backend.el (newsticker-add-url): Support HTTPS. diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 055a38a76e3..726134874ff 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -618,13 +618,13 @@ newsticker-add-url (end-of-line) (and (re-search-backward - "http://" + (rx "http" (? "s") "://") (if (> (point) (+ (point-min) 100)) (- (point) 100) (point-min)) t) (re-search-forward - "http://[-a-zA-Z0-9&/_.]*" + (rx "http" (? "s") "://" (zero-or-more (any "-a-zA-Z0-9&/_."))) (if (< (point) (- (point-max) 200)) (+ (point) 200) (point-max)) commit e76eaecbdef9593a61503b55dea39fcf3a075640 Author: john muhl Date: Tue Oct 10 14:39:30 2023 -0500 Improve imenu support in lua-ts-mode * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): Include require statements and remove anonymous entries. (lua-ts--named-function-p, lua-ts--require-name-function) (lua-ts--require-p): New functions. * lisp/speedbar.el (speedbar-supported-extension-expressions): Add Lua to the list of supported file types. (Bug#66465) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 80cf119f75c..2193779b759 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -443,6 +443,33 @@ lua-ts--defun-name-function (and (treesit-search-subtree node "function_definition" nil nil 1) (treesit-node-text child t)))))) +(defun lua-ts--named-function-p (node) + "Matches if NODE is a named function." + (let ((type (treesit-node-type node))) + (or (equal "function_declaration" type) + (and (equal "field" type) + (equal "function_definition" + (treesit-node-type + (treesit-node-child-by-field-name + node "value"))) + (treesit-node-child-by-field-name node "name"))))) + +(defun lua-ts--require-name-function (node) + "Return name of NODE to use for requires in imenu." + (when-let* (((lua-ts--require-p node)) + (parent (treesit-node-parent node)) + (parent-type (treesit-node-type parent))) + (if (equal "expression_list" parent-type) + (let* ((g-parent (treesit-node-parent parent)) + (name (treesit-node-child-by-field-name g-parent "name"))) + (treesit-node-text name t)) + (treesit-node-text (treesit-search-subtree node "string_content") t)))) + +(defun lua-ts--require-p (node) + "Matches if NODE is a require statement." + (let ((name (treesit-node-child-by-field-name node "name"))) + (equal "require" (treesit-node-text name t)))) + (defvar-local lua-ts--flymake-process nil) (defun lua-ts-flymake-luacheck (report-fn &rest _args) @@ -692,13 +719,15 @@ lua-ts-mode ;; Imenu. (setq-local treesit-simple-imenu-settings - `(("Variable" ,(rx bos "variable_declaration" eos) nil nil) - ("Function" ,(rx bos - (or "function_declaration" - "function_definition" - "field") - eos) - nil nil))) + `(("Requires" + "\\`function_call\\'" + lua-ts--require-p + lua-ts--require-name-function) + ("Variables" "\\`variable_declaration\\'" nil nil) + (nil + "\\`\\(?:f\\(?:ield\\|unction_declaration\\)\\)\\'" + lua-ts--named-function-p + nil))) ;; Which-function. (setq-local which-func-functions (treesit-defun-at-point)) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 67d4e8c4df1..51c5962cb66 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -631,7 +631,7 @@ speedbar-supported-extension-expressions (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?" ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".js" ".f\\(90\\|77\\|or\\)?") (if speedbar-use-imenu-flag - '(".ad[abs]" ".p[lm]" ".tcl" ".m" ".scm" ".pm" ".py" ".g" + '(".ad[abs]" ".p[lm]" ".tcl" ".m" ".scm" ".pm" ".py" ".g" ".lua" ;; html is not supported by default, but an imenu tags package ;; is available. Also, html files are nice to be able to see. ".s?html" commit 1d60139a8073c1293b75e41390f2b58bc2eb7943 Author: Spencer Baugh Date: Sat Aug 19 16:01:54 2023 -0400 Add toggle-window-dedicated command and mode-line-window-dedicated It's sometimes useful to interactively make certain windows dedicated. This allows a level of interactive control over which window display-buffer uses. Additionally, when a window is dedicated (even without this new command) it can affect display-buffer behavior in ways which may be unexpected for users. Let's display the window dedicated status in the mode-line to help indicate what's going on. * doc/emacs/windows.texi (Displaying Buffers): Add information about dedicated windows and toggle-window-dedicated. * doc/emacs/screen.texi (Mode Line): Add information about the window dedicated indicator. * etc/NEWS: Announce mode-line-window-dedicated and toggle-window-dedicated. * lisp/window.el (toggle-window-dedicated): Add. (bug#64619) (window-prefix-map): Add C-x w d binding. * lisp/bindings.el (mode-line-window-control): Add. (mode-line-window-dedicated): Add. (standard-mode-line-format): Insert mode-line-window-dedicated. diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi index 5e9e89e6b11..3b910587260 100644 --- a/doc/emacs/screen.texi +++ b/doc/emacs/screen.texi @@ -173,7 +173,7 @@ Mode Line The text displayed in the mode line has the following format: @example - @var{cs}:@var{ch}-@var{fr} @var{buf} @var{pos} @var{line} (@var{major} @var{minor}) + @var{cs}:@var{ch}-@var{d}@var{fr} @var{buf} @var{pos} @var{line} (@var{major} @var{minor}) @end example @noindent @@ -231,6 +231,12 @@ Mode Line However, if @code{default-directory} (@pxref{File Names}) for the current buffer is on a remote machine, @samp{@@} is displayed instead. + @var{d} appears if the window is dedicated to its current buffer. +It appears as @samp{D} for strong dedication and @samp{d} for other +forms of dedication. If the window is not dedicated, @var{d} does not +appear. @xref{Dedicated Windows,, elisp, The Emacs Lisp Reference +Manual}. + @var{fr} gives the selected frame name (@pxref{Frames}). It appears only on text terminals. The initial frame's name is @samp{F1}. diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 665fd80e53b..ca5e424d939 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -411,6 +411,28 @@ Displaying Buffers window on some other frame to display the desired buffer. Several of these commands are bound in the @kbd{C-x 5} prefix key. +@cindex dedicated window + Sometimes, a window is ``dedicated'' to its current buffer. +@xref{Dedicated Windows,, elisp, The Emacs Lisp Reference Manual}. +@code{display-buffer} will avoid reusing dedicated windows most of the +time. This is indicated by a @samp{d} in the mode line (@pxref{Mode +Line}). A window can also be strongly dedicated, which prevents any +changes to the buffer displayed in the window. This is indicated by a +@samp{D} in the mode line. + +Usually, dedicated windows are used to display specialized buffers, +but dedication can sometimes be useful interactively. For example, +when viewing errors with @kbd{M-g M-n} @code{next-error}, newly +displayed source code may replace a buffer you want to refer to. If +you dedicate a window to that buffer, the command (through +@code{display-buffer}) will prefer to use a different window instead. + +@kindex C-x w d +@findex toggle-window-dedicated + Toggle whether the selected window is dedicated to the current +buffer. With a prefix argument, make the window strongly dedicated +instead. + @menu * Window Choice:: How @code{display-buffer} works. * Temporary Displays:: Displaying non-editable buffers. diff --git a/etc/NEWS b/etc/NEWS index 746d4a8a3df..f8d4a3c3efe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -148,6 +148,27 @@ window systems other than Nextstep. When this minor mode is enabled, buttons representing modifier keys are displayed along the tool bar. ++++ +** 'd' in the mode line now indicates that the window is dedicated. +Windows have always been able to be dedicated to a specific buffer; +see 'window-dedicated-p'. Now the mode line indicates the dedicated +status of a window, with 'd' appearing in the mode line if a window is +dedicated and 'D' if the window is strongly dedicated. This indicator +appears before the buffer name, and after the buffer modification and +remote buffer indicators (usually "---" together). + ++++ +** New command 'toggle-window-dedicated'. +This makes it easy to interactively mark a specific window as +dedicated, so it won't be reused by 'display-buffer'. This can be +useful for complicated window setups. It is bound to 'C-x w d' +globally. + +** cl-print +*** You can expand the "..." truncation everywhere. +The code that allowed "..." to be expanded in the *Backtrace* should +now work anywhere the data is generated by `cl-print`. + --- ** New user option 'uniquify-dirname-transform'. This can be used to customize how buffer names are uniquified, by diff --git a/lisp/bindings.el b/lisp/bindings.el index 70e4087e131..418ee265e69 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -298,6 +298,35 @@ mode-line-frame-identification ;;;###autoload (put 'mode-line-frame-identification 'risky-local-variable t) +(defvar mode-line-window-dedicated-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] #'toggle-window-dedicated) + (purecopy map)) "\ +Keymap for what is displayed by `mode-line-window-dedicated'.") + +(defun mode-line-window-control () + "Compute mode line construct for window dedicated state. +Value is used for `mode-line-window-dedicated', which see." + (cond + ((eq (window-dedicated-p) t) + (propertize + "D" + 'help-echo "Window strongly dedicated to its buffer\nmouse-1: Toggle" + 'local-map mode-line-window-dedicated-keymap + 'mouse-face 'mode-line-highlight)) + ((window-dedicated-p) + (propertize + "d" + 'help-echo "Window dedicated to its buffer\nmouse-1: Toggle" + 'local-map mode-line-window-dedicated-keymap + 'mouse-face 'mode-line-highlight)) + (t ""))) + +(defvar mode-line-window-dedicated '(:eval (mode-line-window-control)) + "Mode line construct to describe the current window.") +;;;###autoload +(put 'mode-line-window-dedicated 'risky-local-variable t) + (defvar-local mode-line-process nil "Mode line construct for displaying info on process status. Normally nil in most modes, since there is no process to display.") @@ -676,8 +705,9 @@ mode-line-end-spaces 'mode-line-mule-info 'mode-line-client 'mode-line-modified - 'mode-line-remote) - 'display '(min-width (5.0))) + 'mode-line-remote + 'mode-line-window-dedicated) + 'display '(min-width (6.0))) 'mode-line-frame-identification 'mode-line-buffer-identification " " diff --git a/lisp/window.el b/lisp/window.el index 12d3fb1dfe7..06d5cfc0077 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7468,6 +7468,64 @@ display-buffer-mark-dedicated The actual non-nil value of this variable will be copied to the `window-dedicated-p' flag.") +(defcustom toggle-window-dedicated-flag 'interactive + "What dedicated flag should `toggle-window-dedicated' use by default. + +If `toggle-window-dedicated' does not receive a flag argument, +the value of this variable is used and passed to +`set-window-dedicated-p'. Setting this to t will make +`toggle-window-dedicated' use strong dedication by default. Any +other non-nil value will result in the same kind of non-strong +dedication." + :type '(choice (const :tag "Strongly dedicated" t) + (const :tag "Dedicated" interactive)) + :version "30.0" + :group 'windows) + +(defun toggle-window-dedicated (&optional window flag interactive) + "Toggle whether WINDOW is dedicated to its current buffer. + +WINDOW must be a live window and defaults to the selected one. +If FLAG is t (interactively, the prefix argument), make the window +\"strongly\" dedicated to its buffer. FLAG defaults to a non-nil, +non-t value, and is passed to `set-window-dedicated-p', which see. +If INTERACTIVE is non-nil, print a message describing the dedication +status of WINDOW, after toggling it. Interactively, this argument is +always non-nil. + +When a window is dedicated to its buffer, `display-buffer' will avoid +displaying another buffer in it, if possible. When a window is +strongly dedicated to its buffer, changing the buffer shown in the +window will usually signal an error. + +You can control the default of FLAG with +`toggle-window-dedicated-flag'. Consequently, if you set that +variable to t, strong dedication will be used by default and +\\[universal-argument] will make the window weakly dedicated. + +See the info node `(elisp)Dedicated Windows' for more details." + (interactive "i\nP\np") + (setq window (window-normalize-window window)) + (setq flag (cond + ((consp flag) + (if (eq toggle-window-dedicated-flag t) + 'interactive + t)) + ((null flag) toggle-window-dedicated-flag) + (t flag))) + (if (window-dedicated-p window) + (set-window-dedicated-p window nil) + (set-window-dedicated-p window flag)) + (when interactive + (message "Window is %s dedicated to buffer %s" + (let ((status (window-dedicated-p window))) + (cond + ((null status) "no longer") + ((eq status t) "now strongly") + (t "now"))) + (current-buffer)) + (force-mode-line-update))) + (defconst display-buffer--action-function-custom-type '(choice :tag "Function" (const :tag "--" ignore) ; default for insertion @@ -10748,6 +10806,7 @@ window-prefix-map "2" #'split-root-window-below "3" #'split-root-window-right "s" #'window-toggle-side-windows + "d" #'toggle-window-dedicated "^ f" #'tear-off-window "^ t" #'tab-window-detach "-" #'fit-window-to-buffer commit d5e5ea4e36bf1f31a06430f780445343f5932c33 Author: Eli Zaretskii Date: Wed Oct 25 16:32:01 2023 +0300 Fix guessing commands for zstandard archives in Dired * lisp/dired-aux.el (dired-guess-shell-alist-default): Fix zstdandard commands. (Bug#66532) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index fc3f6f4f04d..3f803551f38 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1172,7 +1172,7 @@ dired-guess-shell-alist-default "unxz") ;; zstandard archives - `(,(rx (or ".tar.zst" ".tzst") eos) "unzstd -c %i | tar -xf -") + `(,(rx (or ".tar.zst" ".tzst") eos) "unzstd -c ? | tar -xf -") `(,(rx ".zst" eos) "unzstd --rm") '("\\.shar\\.Z\\'" "zcat * | unshar") commit 90db29aff86b96290fd90983b9b5b1749e51897f Author: Matthew Woodcraft Date: Sun Oct 15 19:50:26 2023 +0100 Fix eglot.texi (JSONRPC objects in Elisp) example * doc/misc/eglot.texi (JSONRPC objects in Elisp): Correct the example. (Bug#66569) Copyright-paperwork-exempt: yes diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 6eb212ca841..3ddbac01ce8 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -1234,8 +1234,8 @@ JSONRPC objects in Elisp @lisp (:pylsp (:plugins (:jedi_completion (:include_params t :fuzzy t - :cache_for ["pandas" "numpy"] - :pylint (:enabled :json-false)))) + :cache_for ["pandas" "numpy"]) + :pylint (:enabled :json-false))) :gopls (:usePlaceholders t)) @end lisp @@ -1249,7 +1249,7 @@ JSONRPC objects in Elisp "jedi_completion": @{ "include_params": true, "fuzzy": true, - "cache_for": [ "pandas", "numpy" ], + "cache_for": [ "pandas", "numpy" ] @}, "pylint": @{ "enabled": false @@ -1257,8 +1257,8 @@ JSONRPC objects in Elisp @} @}, "gopls": @{ - "usePlaceholders":true - @}, + "usePlaceholders": true + @} @} @end example commit 74330c0b96970b7a056f54e9d9199c0bc5ad4b04 Author: Ulrich Müller Date: Wed Oct 25 15:20:46 2023 +0200 ; Fix spelling of my name in all ChangeLog files diff --git a/ChangeLog.1 b/ChangeLog.1 index 654cb43d4dc..597b320dff4 100644 --- a/ChangeLog.1 +++ b/ChangeLog.1 @@ -1494,7 +1494,7 @@ 2014-01-05 Paul Eggert Port to GNU/Linux with recent grsecurity/PaX patches (Bug#16343). - Problem and proposed patch reported by Ulrich Mueller; + Problem and proposed patch reported by Ulrich Müller; this patch uses a somewhat-different approach. * configure.ac (SETFATTR): New variable. diff --git a/ChangeLog.3 b/ChangeLog.3 index 85cccf0d6ed..a67f50668c6 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -3672,7 +3672,7 @@ * lib-src/emacsclient.c (set_local_socket): Revert to the Emacs 27 behavior of not trying TMPDIR if XDG_RUNTIME_DIR is set. This is one of the suggestions made by Jim Porter and - independently by Ulrich Mueller in Bug#51327. + independently by Ulrich Müller in Bug#51327. 2021-12-09 Cameron Desautels @@ -44923,7 +44923,7 @@ * etc/NEWS: Announce the new 'cham' input method. * etc/HELLO: Fix the order of letters in the Cham greeting. - Remove redundant newlines (reported by Ulrich Mueller + Remove redundant newlines (reported by Ulrich Müller ). * lisp/language/cham.el ("Cham"): Add input-method entry. @@ -155306,7 +155306,7 @@ Set group when installing, too - From a patch by Ulrich Mueller in: + From a patch by Ulrich Müller in: https://lists.gnu.org/r/emacs-devel/2018-06/msg00687.html * Makefile.in (set_installuser): Also set the group, in order to match install(1) behavior. Also, don’t clutter stderr @@ -161872,7 +161872,7 @@ Port to 32-bit sparc64 - Problem reported by Ulrich Mueller; fix suggested by Eli Zaretskii + Problem reported by Ulrich Müller; fix suggested by Eli Zaretskii and Andreas Schwab (Bug#30855). * src/alloc.c (mark_memory): Call mark_maybe_object only on pointers that are properly aligned for Lisp_Object. @@ -178544,7 +178544,7 @@ Port to 32-bit sparc64 Backport from master. - Problem reported by Ulrich Mueller; fix suggested by Eli Zaretskii + Problem reported by Ulrich Müller; fix suggested by Eli Zaretskii and Andreas Schwab (Bug#30855). * src/alloc.c (mark_memory): Call mark_maybe_object only on pointers that are properly aligned for Lisp_Object. diff --git a/ChangeLog.4 b/ChangeLog.4 index 06b833bac81..24afabdbbb1 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -295,7 +295,7 @@ value of SMALL_JA_DIC option used to produce ja-dic.el. * leim/Makefile.in (small-ja-dic-option): New target, triggers regeneration of ja-dic.el when the value of SMALL_JA_DIC option - changes by the configure script. Suggested by Ulrich Mueller + changes by the configure script. Suggested by Ulrich Müller . (${leimdir}/ja-dic/ja-dic.el): Depend on 'small-ja-dic-option'. (Bug#66125) diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1 index 1cf26aeff06..6e20eb942ce 100644 --- a/doc/emacs/ChangeLog.1 +++ b/doc/emacs/ChangeLog.1 @@ -5771,7 +5771,7 @@ Add view-external-packages on C-h C-e. Add view-order-manuals on C-h C-m. -2008-02-17 Ulrich Mueller +2008-02-17 Ulrich Müller * msdog-xtra.texi (MS-DOS): Docstring fix. diff --git a/doc/lispref/ChangeLog.1 b/doc/lispref/ChangeLog.1 index c96ba40dbe5..95a23e981cc 100644 --- a/doc/lispref/ChangeLog.1 +++ b/doc/lispref/ChangeLog.1 @@ -5792,7 +5792,7 @@ * display.texi (Face Functions): Mention define-obsolete-face-alias. -2009-08-26 Ulrich Mueller +2009-08-26 Ulrich Müller * nonascii.texi (Character Codes): Fix typos. diff --git a/doc/man/ChangeLog.1 b/doc/man/ChangeLog.1 index ccc53810547..71662625fb9 100644 --- a/doc/man/ChangeLog.1 +++ b/doc/man/ChangeLog.1 @@ -74,7 +74,7 @@ * emacs.1: Small fixes. -2010-10-12 Ulrich Mueller +2010-10-12 Ulrich Müller * emacs.1: Update license description. @@ -82,7 +82,7 @@ * b2m.1: Remove file. -2010-09-25 Ulrich Mueller +2010-09-25 Ulrich Müller * etags.1: xz compression is now supported. diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1 index 2cd3c3f6b54..832dbd846a6 100644 --- a/doc/misc/ChangeLog.1 +++ b/doc/misc/ChangeLog.1 @@ -4374,7 +4374,7 @@ * sc.texi (Getting Connected): Remove old index entries. -2011-02-12 Ulrich Mueller +2011-02-12 Ulrich Müller * url.texi: Remove duplicate @dircategory (Bug#7942). @@ -5126,7 +5126,7 @@ * gnus.texi (NoCeM): Remove. (Startup Variables): No jingle. -2010-09-25 Ulrich Mueller +2010-09-25 Ulrich Müller * woman.texi (Interface Options): xz compression is now supported. diff --git a/etc/CALC-NEWS b/etc/CALC-NEWS index 8fd5365011f..a466a9db40b 100644 --- a/etc/CALC-NEWS +++ b/etc/CALC-NEWS @@ -856,7 +856,7 @@ For changes in Emacs 23.1 and later, see the main Emacs NEWS file. ** Fixed obsolete trail tags gsmp, gneg, ginv to jsmp, jneg, jinv. -** Fixed some errors and made improvements in units table [Ulrich Mueller]. +** Fixed some errors and made improvements in units table [Ulrich Müller]. * Version 1.07: diff --git a/etc/ChangeLog.1 b/etc/ChangeLog.1 index 68c15fc6e69..f7786775e50 100644 --- a/etc/ChangeLog.1 +++ b/etc/ChangeLog.1 @@ -1778,7 +1778,7 @@ * refcards/orgcard.tex: Cleanup. -2010-11-27 Ulrich Mueller +2010-11-27 Ulrich Müller * HELLO: Add ancient Greek (Bug#7418). @@ -2497,7 +2497,7 @@ * NEWS: New function `locate-user-emacs-file'. -2008-10-18 Ulrich Mueller +2008-10-18 Ulrich Müller * MACHINES: Add section for SuperH. @@ -2914,7 +2914,7 @@ emacs48_mac.png, emacs256_mac.png, and emacs512_mac.png, respectively. -2007-12-08 Ulrich Mueller (tiny change) +2007-12-08 Ulrich Müller (tiny change) * emacs.desktop (Exec, Icon, Categories): Fix entries. diff --git a/lib-src/ChangeLog.1 b/lib-src/ChangeLog.1 index 136e8917d50..7a540979613 100644 --- a/lib-src/ChangeLog.1 +++ b/lib-src/ChangeLog.1 @@ -1853,7 +1853,7 @@ * emacsclient.c (main): Remove unused variables. (start_daemon_and_retry_set_socket): Use EXIT_FAILURE. -2010-09-25 Ulrich Mueller +2010-09-25 Ulrich Müller * etags.c (compressors, print_language_names): Support xz compression. @@ -2498,7 +2498,7 @@ * makefile.w32-in ($(BLD)/sorted-doc.$(O)): Remove spurious backslash. Reported by Guillaume Conjat . -2008-10-29 Ulrich Mueller +2008-10-29 Ulrich Müller * emacsclient.c (set_local_socket): Use TMPDIR (default /tmp) instead of hardcoded /tmp. @@ -2539,7 +2539,7 @@ * Makefile.in (CFLAGS): Drop -universal under NS_IMPL_COCOA. (.m.o): Dispense with GNUstep-specific flags. -2008-08-05 Ulrich Mueller +2008-08-05 Ulrich Müller * pop.c (socket_connection): Add conditionals for HAVE_KRB5_ERROR_TEXT and HAVE_KRB5_ERROR_E_TEXT to support @@ -3003,7 +3003,7 @@ * Makefile.in (etags, ctags): Define EMACS_NAME as "GNU Emacs". -2007-02-20 Ulrich Mueller (tiny change) +2007-02-20 Ulrich Müller (tiny change) * Makefile.in (EMACS, EMACSOPT): New variables. (blessmail): Use `--no-site-file' when compiling. diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13 index 49ff87f464c..ac382e1685d 100644 --- a/lisp/ChangeLog.13 +++ b/lisp/ChangeLog.13 @@ -7753,7 +7753,7 @@ * textmodes/remember.el (remember-buffer): Use define-obsolete-function-alias rather than defalias. -2007-11-03 Ulrich Mueller (tiny change) +2007-11-03 Ulrich Müller (tiny change) * simple.el (bad-packages-alist): Anchor semantic regexp. @@ -12516,7 +12516,7 @@ * net/tramp-ftp.el (top): Autoload `tramp-set-connection-property'. (tramp-ftp-file-name-handler): Set "started" property. -2007-08-24 Ulrich Mueller (tiny change) +2007-08-24 Ulrich Müller (tiny change) * files.el (backup-buffer-copy): Don't wrap delete in condition-case, only try to delete if file exists. diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index 129621791c0..8c965abd98a 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -39,7 +39,7 @@ * language/korean.el (korean-cp949): New coding system. Set cp949 as an alias to it. -2009-06-18 Ulrich Mueller +2009-06-18 Ulrich Müller * pgg-gpg.el (pgg-gpg-lookup-key-owner): Handle colon listings format used by GnuPG 2.0.11. @@ -459,7 +459,7 @@ * subr.el (assoc-default): Doc fix. -2009-04-29 Ulrich Mueller +2009-04-29 Ulrich Müller * files.el (hack-local-variables-prop-line) (hack-local-variables, dir-locals-read-from-file): @@ -3281,7 +3281,7 @@ (ispell-find-aspell-dictionaries): Better error message. Use correct dictionary alist for default. Better fallback default dictionary. -2009-01-16 Ulrich Mueller +2009-01-16 Ulrich Müller * international/quail.el (quail-insert-kbd-layout): Delete superfluous handling of 8-bit code. (Bug#1418) @@ -3736,7 +3736,7 @@ * simple.el (visual-line-mode-map): Remove M-[ and M-] bindings. -2009-01-04 Ulrich Mueller +2009-01-04 Ulrich Müller * progmodes/sh-script.el (sh-ancestor-alist): Doc fix. @@ -4380,7 +4380,7 @@ 2008-12-10 Juanma Barranquero * net/tramp.el (top): Don't fail if there is no current message. - [Ulrich Mueller sent a patch, which I saw too late.] (Bug#1514) + [Ulrich Müller sent a patch, which I saw too late.] (Bug#1514) 2008-12-10 Kenichi Handa @@ -5317,7 +5317,7 @@ (math-standard-units): Fix typo in constant's description. (math-additional-units): Fix typo in docstring. -2008-11-19 Ulrich Mueller +2008-11-19 Ulrich Müller * calc/calc-units.el (math-standard-units): Add eps0, permittivity of vacuum. @@ -6087,7 +6087,7 @@ * progmodes/gud.el (gud-tooltip-mode): Use `tooltip-functions'. -2008-10-29 Ulrich Mueller +2008-10-29 Ulrich Müller * server.el (server-socket-dir): Use TMPDIR (default /tmp) instead of hardcoded /tmp. @@ -6284,7 +6284,7 @@ * pcmpl-rpm.el (pcomplete/rpm): Make "rpm -qp" use file completion. -2008-10-23 Ulrich Mueller +2008-10-23 Ulrich Müller * international/mule-cmds.el (describe-language-environment): Indent sample text. @@ -7198,7 +7198,7 @@ * play/fortune.el (fortune-program-options): Change to a list. (fortune-in-buffer): Use apply. -2008-09-20 Ulrich Mueller +2008-09-20 Ulrich Müller * emacs-lisp/authors.el: Change encoding of file to utf-8. (authors-coding-system): Likewise. diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 6bd61211d47..f0c613f37c7 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -3931,7 +3931,7 @@ * emacs-lisp/autoload.el (autoload-find-destination): The function coding-system-eol-type may return non-numeric values. (Bug#7414) -2010-11-18 Ulrich Mueller +2010-11-18 Ulrich Müller * server.el (server-force-stop): Ensure the server is stopped (Bug#7409). @@ -6386,7 +6386,7 @@ * eshell/esh-util.el, eshell/esh-var.el: Remove leading `*' from docs of faces and defcustoms. -2010-09-25 Ulrich Mueller +2010-09-25 Ulrich Müller * eshell/em-ls.el (eshell-ls-archive-regexp): * eshell/esh-util.el (eshell-tar-regexp): @@ -14485,7 +14485,7 @@ color queries. Recompute faces after getting the background color. -2009-12-07 Ulrich Mueller +2009-12-07 Ulrich Müller * emacs-lisp/bytecomp.el (byte-compile-insert-header): Put the version number comment back on its own line, for easier parsing. @@ -17532,7 +17532,7 @@ (flyspell-word-search-backward): Remove nil argument in calls to flyspell-get-word, since it is not needed now. -2009-10-17 Ulrich Mueller +2009-10-17 Ulrich Müller * play/doctor.el (doctor-adverbp): Exclude some nouns. (Bug#4565) diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index f7dcda87466..0006383c1fb 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -15382,7 +15382,7 @@ * calendar/calendar.el (calendar-mode): Locally set scroll-margin to 0. (Bug#10379) -2012-01-06 Ulrich Mueller +2012-01-06 Ulrich Müller * play/doctor.el (doctor-death): Escape "," characters. (Bug#10370) @@ -17133,7 +17133,7 @@ (mouse-drag-vertical-line): Call mouse-drag-line. * window.el (window-at-side-p, windows-at-side): New functions. -2011-10-21 Ulrich Mueller +2011-10-21 Ulrich Müller * tar-mode.el (tar-grind-file-mode): Fix handling of setuid/setgid, handle sticky bit. (Bug#9817) diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index 3377da7c54d..19b8e1e28eb 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -24676,7 +24676,7 @@ * frame.el (display-monitor-attributes-list): Add NS case. (ns-display-monitor-attributes-list): Declare. -2013-05-09 Ulrich Mueller +2013-05-09 Ulrich Müller * descr-text.el (describe-char): Fix %d/%x typo. (Bug#14360) diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4 index f0dd1295dd7..702a059ce65 100644 --- a/lisp/ChangeLog.4 +++ b/lisp/ChangeLog.4 @@ -1055,7 +1055,7 @@ (gud-irixdbx-marker-filter): New function. (dbx): Insert case for Irix. -1994-04-27 Ulrich Mueller (ulm@vsnhd1.cern.ch) +1994-04-27 Ulrich Müller (ulm@vsnhd1.cern.ch) * case-table.el (describe-buffer-case-table): Don't use text-char-description. @@ -4189,7 +4189,7 @@ * paths.el (rmail-spool-directory): Use dgux, not dgux-unix. * lpr.el (lpr-command): Use dgux, not dgux-unix. -1993-12-14 Ulrich Mueller (ulm@vsnhd1.cern.ch) +1993-12-14 Ulrich Müller (ulm@vsnhd1.cern.ch) * gud.el (gud-format-command): Use gud-last-last-frame if gud-last-frame is nil. @@ -4200,7 +4200,7 @@ * info.el (Info-insert-dir): For generated menu items, add ::. -1993-12-13 Ulrich Mueller (ulm@vsnhd1.cern.ch) +1993-12-13 Ulrich Müller (ulm@vsnhd1.cern.ch) * gud.el (gud-mipsdbx-massage-args, gud-mipsdbx-marker-filter): New functions for dbx support on Mips under Ultrix. diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5 index 96bda7650e2..a9f1beaaae8 100644 --- a/lisp/ChangeLog.5 +++ b/lisp/ChangeLog.5 @@ -5463,7 +5463,7 @@ (makefile-font-lock-keywords): Use makefile-tab-face. (makefile-font-lock-keywords): Use defvar, not defconst. -1994-10-28 Ulrich Mueller +1994-10-28 Ulrich Müller * iso-acc.el (iso-accents-mode): Variable renamed from iso-accents-minor-mode. diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6 index 0fc8ffcf591..fcad77bd38f 100644 --- a/lisp/ChangeLog.6 +++ b/lisp/ChangeLog.6 @@ -7197,7 +7197,7 @@ * faces.el (x-font-regexp): Add \\(\\) for substring extraction. -1995-07-27 Ulrich Mueller +1995-07-27 Ulrich Müller * fortran.el (fortran-break-line): Fixed a bug that sometimes deleted first character in statement field of continuation line. diff --git a/oldXMenu/ChangeLog.1 b/oldXMenu/ChangeLog.1 index 2de6071a33c..0e0d0ea4ce5 100644 --- a/oldXMenu/ChangeLog.1 +++ b/oldXMenu/ChangeLog.1 @@ -240,7 +240,7 @@ * Relicense all FSF files to GPLv3 or later. -2007-06-04 Ulrich Mueller (tiny change) +2007-06-04 Ulrich Müller (tiny change) * ChgPane.c, ChgSel.c: Quiet --with-x-toolkit=no compilation warnings: #include . @@ -249,7 +249,7 @@ * Version 22.1 released. -2007-05-30 Ulrich Mueller (tiny change) +2007-05-30 Ulrich Müller (tiny change) * XMakeAssoc.c (XMakeAssoc): Use malloc rather than xmalloc. diff --git a/src/ChangeLog.11 b/src/ChangeLog.11 index bfd4fef4e80..b1e476e56fd 100644 --- a/src/ChangeLog.11 +++ b/src/ChangeLog.11 @@ -12876,7 +12876,7 @@ * editfns.c (Ftranspose_regions): Doc fix (Bug#3248). -2009-05-10 Ulrich Mueller +2009-05-10 Ulrich Müller * s/gnu-linux.h: Make GCPROs and UNGCPRO no-ops also on SuperH. @@ -12978,7 +12978,7 @@ * process.c (create_process): Clean up merger residues of 2008-07-17 change. -2009-04-29 Ulrich Mueller +2009-04-29 Ulrich Müller * lread.c (Vread_circle): New variable. (read1): Disable recursive read if Vread_circle is nil. @@ -14860,7 +14860,7 @@ * process.c (Fsystem_process_attributes, syms_of_process): Fix typo in name of Ssystem_process_attributes. - Reported by Ulrich Mueller . + Reported by Ulrich Müller . 2008-12-11 Juanma Barranquero @@ -15356,7 +15356,7 @@ * keyboard.c (command_loop_1): Handle NORECORD in call of Fselect_frame (currently ifdefd). -2008-11-02 Ulrich Mueller +2008-11-02 Ulrich Müller * emacs.c (USAGE2): Untabify. @@ -15626,7 +15626,7 @@ (Fset_window_buffer): Respect any non-nil dedicated value for window. Rename "buffer" argument to "buffer_or_name". -2008-10-18 Ulrich Mueller +2008-10-18 Ulrich Müller * m/sh3.h: New file, machine description for SuperH. @@ -23405,7 +23405,7 @@ * Makefile.in (lisp): Add ${lispsource}language/tai-viet.el. (shortlisp): Add ../lisp/language/tai-viet.el. -2008-02-01 Ulrich Mueller +2008-02-01 Ulrich Müller * Makefile.in (${lispsource}international/charprop.el): Depend on temacs${EXEEXT}. diff --git a/src/ChangeLog.4 b/src/ChangeLog.4 index 0c47d979ecc..8d4b3594eaf 100644 --- a/src/ChangeLog.4 +++ b/src/ChangeLog.4 @@ -3490,7 +3490,7 @@ * Makefile.in.in (temacs): Delete redundant use of LDFLAGS. -1994-01-02 Ulrich Mueller (ulm@vsnhd1.cern.ch) +1994-01-02 Ulrich Müller (ulm@vsnhd1.cern.ch) * sysdep.c (get_system_name): If the official name of the host is not a fully qualified domain name, then try to find one in the commit 5ef48ad6a3766a42b7c6f071d7a64785d8c5291c Author: Eli Zaretskii Date: Wed Oct 25 16:14:39 2023 +0300 ; Fix one author's name. diff --git a/admin/authors.el b/admin/authors.el index 41ae67e34d9..266b52f4c90 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -87,7 +87,7 @@ authors-aliases ("David M. Koppelman" "David Koppelman") ("David M. Smith" "David Smith" "David M Smith") ("David O'Toole" "David T. O'Toole") - (nil "dalanicolai") + ("Daniel Laurens Nicolai" "dalanicolai") (nil "deech@deech") ("Deepak Goel" "D. Goel") ("Earl Hyatt" "Earl" "ej32u@protonmail\\.com") commit 95d56b92a6b9916e2923f8c45a93d312604f5c66 Author: dalanicolai Date: Sat Oct 21 17:39:17 2023 +0200 Fix 'locate-dominating-file' when FILE is not a directory. * lisp/files.el (locate-dominating-file): Handle FILE that is not a directory. (Bug#66542) diff --git a/lisp/files.el b/lisp/files.el index 1be5b374ae8..3d838cd3b8c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1135,9 +1135,11 @@ locate-dominating-file (while (not (or root (null file) (string-match locate-dominating-stop-dir-regexp file))) - (setq try (if (stringp name) - (and (file-directory-p file) - (file-exists-p (expand-file-name name file))) + (setq file (if (file-directory-p file) + file + (file-name-directory file)) + try (if (stringp name) + (file-exists-p (expand-file-name name file)) (funcall name file))) (cond (try (setq root file)) ((equal file (setq file (file-name-directory commit 8d2a04f4c0bf423e17b8dc97fb4a5743b1b3793a Author: Jens Schmidt Date: Thu Oct 19 23:00:32 2023 +0200 Better handle errors when writing r-o files without backup * lisp/files.el (basic-save-buffer-2): Restore file permissions when writing read-only files without backup fails. (Bug#66546) diff --git a/lisp/files.el b/lisp/files.el index adfe8bd44b9..1be5b374ae8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5934,9 +5934,10 @@ basic-save-buffer-2 t)) ;; If file not writable, see if we can make it writable ;; temporarily while we write it (its original modes will be - ;; restored in 'basic-save-buffer'). But no need to do so if - ;; we have just backed it up (setmodes is set) because that - ;; says we're superseding. + ;; restored in 'basic-save-buffer' or, in case of an error, in + ;; the `unwind-protect' below). But no need to do so if we + ;; have just backed it up (setmodes is set) because that says + ;; we're superseding. (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes @@ -5946,7 +5947,12 @@ basic-save-buffer-2 (file-extended-attributes buffer-file-name)) buffer-file-name)) ;; If set-file-extended-attributes fails to make the - ;; file writable, fall back on set-file-modes. + ;; file writable, fall back on set-file-modes. Calling + ;; set-file-extended-attributes here may or may not be + ;; actually necessary. However, since its exact + ;; behavior is highly port-specific, since calling it + ;; does not do any harm, and since the call has a long + ;; history, we decided to leave it in (bug#66546). (with-demoted-errors "Error setting attributes: %s" (set-file-extended-attributes buffer-file-name (nth 1 setmodes))) @@ -5963,12 +5969,22 @@ basic-save-buffer-2 buffer-file-name nil t buffer-file-truename) (when save-silently (message nil)) (setq success t)) - ;; If we get an error writing the new file, and we made - ;; the backup by renaming, undo the backing-up. - (and setmodes (not success) - (progn - (rename-file (nth 2 setmodes) buffer-file-name t) - (setq buffer-backed-up nil))))))) + (cond + ;; If we get an error writing the file, and there is no + ;; backup file, then we (most likely) made that file + ;; writable above. Attempt to undo the write-access. + ((and setmodes (not success) + (equal (nth 2 setmodes) buffer-file-name)) + (with-demoted-errors "Error setting file modes: %S" + (set-file-modes buffer-file-name (car setmodes))) + (with-demoted-errors "Error setting attributes: %s" + (set-file-extended-attributes buffer-file-name + (nth 1 setmodes)))) + ;; If we get an error writing the new file, and we made + ;; the backup by renaming, undo the backing-up. + ((and setmodes (not success)) + (rename-file (nth 2 setmodes) buffer-file-name t) + (setq buffer-backed-up nil))))))) setmodes)) (declare-function diff-no-select "diff" commit 90474045c079af992d7a1aea2016d90a3f6d8a01 Author: Stefan Kangas Date: Wed Oct 25 14:23:59 2023 +0200 Add HTTPS to mh-access-types * lisp/mh-e/mh-mime.el (mh-access-types): Add HTTPS. diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 6c498d8df71..b493f7d86dd 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1355,6 +1355,7 @@ mh-access-types ("ftp") ; RFC2046 File Transfer Protocol ("gopher") ; RFC1738 The Gopher Protocol ("http") ; RFC1738 Hypertext Transfer Protocol + ("https") ; RFC2818 HTTP Over TLS ("local-file") ; RFC2046 Local file access ("mail-server") ; RFC2046 mail-server Electronic mail address ("mailto") ; RFC1738 Electronic mail address commit 0ce068c298d9aa35614bc6c3fc2ce3dc683e9310 Author: Stefan Kangas Date: Wed Oct 25 12:49:19 2023 +0200 Respect browse-url-default-scheme on Haiku * lisp/net/browse-url.el (browse-url-default-haiku-browser): Respect 'browse-url-default-scheme', which currently defaults to "http". diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 11bfeb1b339..7cbc8e569a5 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1305,7 +1305,7 @@ browse-url-default-haiku-browser (let* ((scheme (save-match-data (if (string-match "\\(.+\\):/" url) (match-string 1 url) - "http"))) + browse-url-default-scheme))) (mime (concat "application/x-vnd.Be.URL." scheme))) (haiku-roster-launch mime (vector url)))) commit 8fef7150d6be20b1a2154d501f75bee4977328b5 Author: Stefan Kangas Date: Wed Oct 25 12:27:31 2023 +0200 Prefer HTTPS in `M-x webjump´ * lisp/net/webjump.el (webjump-url-fix): Prefer HTTPS to HTTP. (webjump-sites): Document the above change. (webjump-sample-sites): Change some links to HTTP only. diff --git a/etc/NEWS b/etc/NEWS index 29744d3ad77..746d4a8a3df 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -922,6 +922,14 @@ When this is non-nil, the lines of key sequences are displayed with the most recent line first. This is can be useful when working with macros with many lines, such as from 'kmacro-edit-lossage'. +** Miscellaneous + +--- +*** Webjump now assumes URIs are HTTPS instead of HTTP. +For links in 'webjump-sites' without an explicit URI scheme, it was +previously assumed that they should be prefixed with "http://". Such +URIs are now prefixed with "https://" instead. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index b377d0798ed..77f00578a48 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -123,7 +123,7 @@ webjump-sample-sites ;; Misc. general interest. ("National Weather Service" . webjump-to-iwin) ("Usenet FAQs" . - "www.faqs.org/faqs/") + "http://www.faqs.org/faqs/") ("RTFM Usenet FAQs by Group" . "ftp://rtfm.mit.edu/pub/usenet-by-group/") ("RTFM Usenet FAQs by Hierarchy" . @@ -132,7 +132,7 @@ webjump-sample-sites ;; Computer social issues, privacy, professionalism. ("Association for Computing Machinery" . "www.acm.org") - ("Computer Professionals for Social Responsibility" . "www.cpsr.org") + ("Computer Professionals for Social Responsibility" . "http://www.cpsr.org") ("Electronic Frontier Foundation" . "www.eff.org") ("IEEE Computer Society" . "www.computer.org") ("Risks Digest" . webjump-to-risks) @@ -194,7 +194,7 @@ webjump-sites Web site name (the one you specified in the CAR of the alist cell) as a parameter. This might come in handy for various kludges. -For convenience, if the `http://', `ftp://', or `file://' prefix is missing +For convenience, if the `https://', `ftp://', or `file://' prefix is missing from a URL, WebJump will make a guess at what you wanted and prepend it before submitting the URL." :type '(alist :key-type (string :tag "Name") @@ -369,9 +369,11 @@ webjump-url-fix ((string-match "^[a-zA-Z]+:" url) url) ((string-match "^/" url) (concat "file://" url)) ((string-match "^\\([^\\./]+\\)" url) + ;; FIXME: ftp.gnu.org and many others now prefer HTTPS instead + ;; of FTP. Does this heuristic make sense these days? (concat (if (string= (downcase (match-string 1 url)) "ftp") "ftp" - "http") + "https") "://" url)) (t url))))) commit 5e451b8b305aeedaae2b71c1da2f23dcb2437c7a Author: Stefan Kangas Date: Wed Oct 25 09:37:36 2023 +0200 Silence makeinfo 7.1 warnings in Tramp manual * doc/misc/tramp.texi: Fix makinfo warning "@indent is useless inside of a paragraph". diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 64d47515978..6e3a1a0eee1 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -6092,17 +6092,17 @@ Traces and Profiles The verbosity levels are @w{ 0} silent (no @value{tramp} messages at all) -@*@indent @w{ 1} errors -@*@indent @w{ 2} warnings -@*@indent @w{ 3} connection to remote hosts (default verbosity) -@*@indent @w{ 4} activities -@*@indent @w{ 5} internal -@*@indent @w{ 6} sent and received strings -@*@indent @w{ 7} connection properties -@*@indent @w{ 8} file caching -@*@indent @w{ 9} test commands -@*@indent @w{10} traces (huge) -@*@indent @w{11} call traces (maintainer only) +@* @w{ 1} errors +@* @w{ 2} warnings +@* @w{ 3} connection to remote hosts (default verbosity) +@* @w{ 4} activities +@* @w{ 5} internal +@* @w{ 6} sent and received strings +@* @w{ 7} connection properties +@* @w{ 8} file caching +@* @w{ 9} test commands +@* @w{10} traces (huge) +@* @w{11} call traces (maintainer only) With @code{tramp-verbose} greater than or equal to 4, messages are also written to the @value{tramp} debug buffer @file{*debug commit 71c366ba0216c0a551c9d02391d6565610019c63 Author: Stefan Kangas Date: Wed Oct 25 09:25:39 2023 +0200 Reduce code duplication in webjump * lisp/net/webjump.el (webjump): Simplify. diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index fe7c3679876..b377d0798ed 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -1,6 +1,6 @@ ;;; webjump.el --- programmable Web hotlist -*- lexical-binding: t; -*- -;; Copyright (C) 1996-1997, 2001-2023 Free Software Foundation, Inc. +;; Copyright (C) 1996-2023 Free Software Foundation, Inc. ;; Author: Neil W. Van Dyke ;; Maintainer: emacs-devel@gnu.org @@ -262,33 +262,22 @@ webjump (completing-read "WebJump to site: " webjump-sites nil t) webjump-sites t)) (name (car item)) - (expr (cdr item))) - (if webjump-use-internal-browser - (browse-url-with-browser-kind - 'internal (webjump-url-fix - (cond ((not expr) "") - ((stringp expr) expr) - ((vectorp expr) (webjump-builtin expr name)) - ((listp expr) (eval expr t)) - ((symbolp expr) - (if (fboundp expr) - (funcall expr name) - (error "WebJump URL function \"%s\" undefined" - expr))) - (t (error "WebJump URL expression for \"%s\" invalid" - name))))) - (browse-url (webjump-url-fix - (cond ((not expr) "") - ((stringp expr) expr) - ((vectorp expr) (webjump-builtin expr name)) - ((listp expr) (eval expr t)) - ((symbolp expr) - (if (fboundp expr) - (funcall expr name) - (error "WebJump URL function \"%s\" undefined" - expr))) - (t (error "WebJump URL expression for \"%s\" invalid" - name)))))))) + (expr (cdr item)) + (fun (if webjump-use-internal-browser + (apply-partially #'browse-url-with-browser-kind 'internal) + #'browse-url))) + (funcall fun (webjump-url-fix + (cond ((not expr) "") + ((stringp expr) expr) + ((vectorp expr) (webjump-builtin expr name)) + ((listp expr) (eval expr t)) + ((symbolp expr) + (if (fboundp expr) + (funcall expr name) + (error "WebJump URL function \"%s\" undefined" + expr))) + (t (error "WebJump URL expression for \"%s\" invalid" + name))))))) (defun webjump-builtin (expr name) (if (< (length expr) 1) commit c4e9a6159a3603c94ffbf5fe05f50c93f4ccc451 Author: Michael Albinus Date: Wed Oct 25 12:24:34 2023 +0200 * doc/man/emacsclient.1: Fix --tramp option. diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index acc2edd4609..0acf3dd339e 100644 --- a/doc/man/emacsclient.1 +++ b/doc/man/emacsclient.1 @@ -1,5 +1,5 @@ .\" See section COPYING for conditions for redistribution. -.TH EMACSCLIENT 1 "2023-10-16" "GNU Emacs" "GNU" +.TH EMACSCLIENT 1 "2023-10-25" "GNU Emacs" "GNU" .\" NAME should be all caps, SECTION should be 1-8, maybe w/ subsection .\" other params are allowed: see man(7), man(1) .SH NAME @@ -119,7 +119,7 @@ This can also be specified via the EMACS_SOCKET_NAME environment variable. .B \-nw, \-t, \-\-tty Open a new Emacs frame on the current terminal. .TP -.B \-T, \-\-tramp-prefix=PREFIX +.B \-T, \-\-tramp=PREFIX Set PREFIX to add to filenames for Emacs to locate files on remote machines using TRAMP. This is mostly useful in combination with using the Emacs server over TCP with --server-file. This can also be commit e3da8edf5e56ef4044da76ac2991aff0dedc33f5 Author: Mattias Engdegård Date: Wed Oct 25 12:14:57 2023 +0200 LLDB support: cope with inserted text being write-protected * lisp/progmodes/gud.el (gud-lldb-marker-filter): Force deletion of the part of the buffer being moved back into filtering again (bug#66738). diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 8692a6be023..70af736372e 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3905,7 +3905,8 @@ gud-lldb-marker-filter ;; can delete parts of it. (setq string (concat (buffer-substring-no-properties bol (point)) string)) - (delete-region bol (point)))) + (let ((inhibit-read-only t)) + (delete-region bol (point))))) (let ((ofs 0)) (while (string-match (rx (group (* (not (in "\e\n")))) ; preceding chars "\e[" ; CSI @@ -3926,12 +3927,13 @@ gud-lldb-marker-filter 0))) ;; Erase in display (ED): no further action. prefix-end))) + ;; Delete the control sequence and possibly part of the preceding chars. (setq string (concat (substring string 0 keep-end) (substring string end))) (setq ofs start)))) string) -;; According to SBCommanInterpreter.cpp, the return value of +;; According to SBCommandInterpreter.cpp, the return value of ;; HandleCompletions is as follows: ;; ;; Index 1 to the end contain all the completions. commit b36e2b1772680b8fce067c6ea2cdf582af982aaa Author: Po Lu Date: Wed Oct 25 10:28:54 2023 +0800 Documentation copy-edits * doc/emacs/input.texi (Touchscreens): * doc/lispref/frames.texi (Other Selections): Insubstantial copy-edits and improvements to word choice. diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index 5b559652896..0dd7fca41cc 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -25,11 +25,12 @@ Touchscreens Touchscreen input is the manipulation of a frame's contents by the placement and motion of tools (instanced by fingers and such pointing -devices as styluses) on a monitor or computer terminal where a frame -is displayed. +devices as styluses) on a monitor or computer terminal where it is +displayed. - Under the X Window System or Android, Emacs detects and maps the -following sequences of movements (``gestures'') to common actions: + Under the X Window System or Android, Emacs detects and translates +the following sequences of movements (@dfn{gestures}) to common +actions: @itemize @bullet @item @@ -58,7 +59,7 @@ Touchscreens tool on the display and leaving it there awhile before moving it to another position, will move point to the tool's initial position, and commence selecting text under the tool as it continues its motion, as -if @code{mouse-1} were to be held down and a mouse moved anologously. +if @code{mouse-1} were to be held down and a mouse moved analogously. @xref{Mouse Commands}. @vindex touch-screen-word-select diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index fb19317cedf..1a7af04b103 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4670,10 +4670,17 @@ Other Selections of available selection data types, as elsewhere. @cindex Android selections - Under Android, @code{gui-get-selection} is capable of returning -UTF-8 string data of the type @code{STRING}, or image and application -data associated with a MIME type. @code{gui-set-selection} will only -set string data, as on MS-Windows. + Much like MS-Windows, Android provides a clipboard but no primary or +secondary selection; @code{gui-set-selection} simulates the primary +selection by saving the value supplied into a variable subsequent +calls to @code{gui-get-selection} return. + + From the clipboard, @code{gui-get-selection} is capable of returning +UTF-8 string data of the type @code{STRING}, the @code{TAREGTS} data +type, or image and application data of any MIME type. +@code{gui-set-selection} sets only string data, much as under +MS-Windows, although this data is not affected by the value of +@code{selection-coding-system}. @node Yanking Media @section Yanking Media commit eff1313c6b7eb7bec217f7b9178857abe8c77356 Author: Po Lu Date: Wed Oct 25 10:19:36 2023 +0800 Correct computation of intermediate axis coordinates * src/sfnt.c (sfnt_compute_tuple_scale, sfnt_vary_simple_glyph) (sfnt_vary_compound_glyph): Correct typos involving intermediate_end (or something of the like) being set to intermediate_start. diff --git a/src/sfnt.c b/src/sfnt.c index 01d061be79c..7559055e8c2 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -14116,7 +14116,7 @@ sfnt_compute_tuple_scale (struct sfnt_blend *blend, bool intermediate_p, if (intermediate_p) { start = intermediate_start[i] * 4; - end = intermediate_start[i] * 4; + end = intermediate_end[i] * 4; } /* Ignore tuples that can be skipped. */ @@ -14669,7 +14669,7 @@ sfnt_vary_simple_glyph (struct sfnt_blend *blend, sfnt_glyph id, coords = alloca (gvar->axis_count * sizeof *coords * 3); intermediate_start = coords + gvar->axis_count; - intermediate_end = coords + gvar->axis_count; + intermediate_end = intermediate_start + gvar->axis_count; /* Allocate arrays of booleans and fwords to keep track of which points have been touched. */ @@ -15041,7 +15041,7 @@ sfnt_vary_compound_glyph (struct sfnt_blend *blend, sfnt_glyph id, coords = alloca (gvar->axis_count * sizeof *coords * 3); intermediate_start = coords + gvar->axis_count; - intermediate_end = coords + gvar->axis_count; + intermediate_end = intermediate_start + gvar->axis_count; while (ntuples--) { commit 6dca3a8eab24135cff56ac1f4671040ef73e9ba3 Author: Stefan Kangas Date: Wed Oct 25 01:06:27 2023 +0200 Improve `nsm-protocol-check--3des-cipher` docstring * lisp/net/nsm.el (nsm-protocol-check--3des-cipher): Update docstring to reflect current NIST policy. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index dc04bf50c24..870ab3066a8 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -550,14 +550,14 @@ nsm-protocol-check--3des-cipher ciphertext collision is highly likely when 2^32 blocks are encrypted with the same key bundle under 3-key 3DES. Practical birthday attacks of this kind have been demonstrated by Sweet32[1]. -As such, NIST is in the process of disallowing its use in TLS[2]. +As such, NIST has disallowed its use after December 31, 2023[2]. [1]: Bhargavan, Leurent (2016). \"On the Practical (In-)Security of 64-bit Block Ciphers — Collision Attacks on HTTP over TLS and OpenVPN\", `https://sweet32.info/' -[2]: NIST Information Technology Laboratory (Jul 2017). \"Update to -Current Use and Deprecation of TDEA\", -`https://csrc.nist.gov/News/2017/Update-to-Current-Use-and-Deprecation-of-TDEA'" +[2]: National Institute of Standards and Technology (Mar 2019). +\"Transitioning the Use of Cryptographic Algorithms and Key +Lengths\", `https://doi.org/10.6028/NIST.SP.800-131Ar2'" (let ((cipher (plist-get status :cipher))) (and (string-match "\\b3DES\\b" cipher) (format-message commit 643c67cf239cbb9621b3c2aaadd58697d87996f5 Author: Stefan Kangas Date: Tue Oct 24 22:40:12 2023 +0200 Prefer HTTPS to HTTP in ffap * lisp/ffap.el (ffap-fixup-machine): Prefer HTTPS to HTTP for things looking like URIs (for example www.example.org). diff --git a/lisp/ffap.el b/lisp/ffap.el index 6f477dd790b..942e218bf23 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -554,7 +554,7 @@ ffap-fixup-machine (concat "gopher://" mach "/")) ;; www.ncsa.uiuc.edu ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) - (concat "http://" mach "/")) + (concat "https://" mach "/")) ;; More cases? (ffap-ftp-regexp (ffap-host-to-filename mach)) )) commit 64aa01f60ad17af2bd438895a19343f3c369bc43 Author: Jim Porter Date: Mon Oct 9 20:25:28 2023 -0700 Add a new Eshell special reference type for markers * lisp/eshell/esh-arg.el (eshell-get-marker, eshell-insert-marker) (eshell-complete-marker-ref): New functions... (eshell-special-ref-alist): ... Add them to the new "marker" entry. * test/lisp/eshell/esh-arg-tests.el (esh-arg-test/special-reference/marker) (esh-arg-test/special-reference/nested) (esh-arg-test/special-reference/lisp-form): * test/lisp/eshell/em-cmpl-tests.el (em-cmpl-test/special-ref-completion/type) (em-cmpl-test/special-ref-completion/marker): New tests. * doc/misc/eshell.texi (Arguments): Document the new special ref type. * etc/NEWS: Announce this change (bug#66458). diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index b5cc9faeec2..e8aa8cdc6a3 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -400,6 +400,14 @@ Arguments @samp{$(get-buffer-create "@var{name}")} (@pxref{Creating Buffers, , , elisp, The Emacs Lisp Reference Manual}). +@item # +Return a marker at @var{position} in the buffer @var{buffer-or-name}. +@var{buffer-or-name} can either be a string naming a buffer or an +actual buffer object. This is roughly equivalent to creating a new +marker and calling @samp{$(set-marker marker @var{position} +@var{buffer-or-name})} (@pxref{Moving Markers, , , elisp, The Emacs +Lisp Reference Manual}). + @item # Return the process named @var{name}. This is equivalent to @samp{$(get-process "@var{name}")} (@pxref{Process Information, , , diff --git a/etc/NEWS b/etc/NEWS index e6c47660522..29744d3ad77 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -430,6 +430,14 @@ appropriate, but still allow piping the output elsewhere if desired. For more information, see the "(eshell) Built-ins" node in the Eshell manual. ++++ +*** New special reference type '#'. +This special reference type returns a marker at 'POSITION' in +'BUFFER'. You can insert it by typing or using the new interactive +command 'eshell-insert-marker'. You can also insert markers of any +type with the new command 'eshell-insert-special-reference'. See the +"(eshell) Arguments" node in the Eshell manual for more details. + +++ *** New splice operator for Eshell dollar expansions. Dollar expansions in Eshell now let you splice the elements of the diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index d5fcabccb14..2bdfdff8a3a 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -169,7 +169,11 @@ eshell-special-ref-alist '(("buffer" (creation-function eshell-get-buffer) (insertion-function eshell-insert-buffer-name) - (completion-function eshell-complete-buffer-ref))) + (completion-function eshell-complete-buffer-ref)) + ("marker" + (creation-function eshell-get-marker) + (insertion-function eshell-insert-marker) + (completion-function eshell-complete-marker-ref))) "Alist of special reference types for Eshell. Each entry is a list of the form (TYPE (KEY VALUE)...). TYPE is the name of the special reference type, and each KEY/VALUE pair @@ -717,5 +721,26 @@ eshell-complete-buffer-ref "Perform completion for buffer references." (pcomplete-here (mapcar #'buffer-name (buffer-list)))) +(defun eshell-get-marker (position buffer-or-name) + "Return the marker for character number POSITION in BUFFER-OR-NAME. +BUFFER-OR-NAME can be a buffer or a string. If a string and a +live buffer with that name exists, use that buffer. If no such +buffer exists, create a new buffer with that name and use it." + (let ((marker (make-marker))) + (set-marker marker (string-to-number position) + (get-buffer-create buffer-or-name)))) + +(defun eshell-insert-marker (position buffer-name) + "Insert a marker into the current buffer at point. +This marker will point to POSITION in BUFFER-NAME." + (interactive "nPosition: \nBName of buffer: ") + (insert-and-inherit "#")) + +(defun eshell-complete-marker-ref () + "Perform completion for marker references." + (pcomplete-here) + (pcomplete-here (mapcar #'buffer-name (buffer-list)))) + (provide 'esh-arg) ;;; esh-arg.el ends here diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el index 29a41625d5e..dd3c338ac54 100644 --- a/test/lisp/eshell/em-cmpl-tests.el +++ b/test/lisp/eshell/em-cmpl-tests.el @@ -243,14 +243,17 @@ em-cmpl-test/lisp-function-completion "echo $(eshell/echo")))) (ert-deftest em-cmpl-test/special-ref-completion/type () - "Test completion of the start of special references like \"#." (with-temp-eshell (should (equal (eshell-insert-and-complete "echo hi > # # # # # # #\". @@ -282,6 +285,31 @@ em-cmpl-test/special-ref-completion/buffer (format "echo hi > # " (string-replace " " "\\ " bufname)))))))) +(ert-deftest em-cmpl-test/special-ref-completion/marker () + "Test completion of special references like \"#\". +See ." + (let (bufname) + (with-temp-buffer + (setq bufname (rename-buffer "my-buffer" t)) + ;; Complete the buffer name in various forms. + (with-temp-eshell + (should (equal (eshell-insert-and-complete + "echo hi > # # " bufname)))) + (with-temp-eshell + (should (equal (eshell-insert-and-complete + "echo hi > # #> " bufname)))) + (with-temp-eshell + (should (equal (eshell-insert-and-complete + "echo hi > # #> " bufname)))) + ;; Partially-complete the "buffer" type name. + (with-temp-eshell + (should (equal (eshell-insert-and-complete + "echo hi > # #." diff --git a/test/lisp/eshell/esh-arg-tests.el b/test/lisp/eshell/esh-arg-tests.el index 0e07d107562..1eb8e08b883 100644 --- a/test/lisp/eshell/esh-arg-tests.el +++ b/test/lisp/eshell/esh-arg-tests.el @@ -118,6 +118,17 @@ esh-arg-test/special-reference/buffer (format "echo #" (buffer-name)) (current-buffer)))) +(ert-deftest esh-arg-test/special-reference/marker () + "Test that \"#\" refers to a marker in the buffer \"buf\"." + (with-temp-buffer + (rename-buffer "my-buffer" t) + (insert "hello") + (let ((marker (make-marker))) + (set-marker marker 1 (current-buffer)) + (eshell-command-result-equal + (format "echo #" (buffer-name)) + marker)))) + (ert-deftest esh-arg-test/special-reference/quoted () "Test that '#' refers to the buffer \"foo bar\"." (with-temp-buffer @@ -129,6 +140,20 @@ esh-arg-test/special-reference/quoted (format "echo #" (buffer-name)) (current-buffer)))) +(ert-deftest esh-arg-test/special-reference/nested () + "Test that nested special references work correctly." + (with-temp-buffer + (rename-buffer "my-buffer" t) + (insert "hello") + (let ((marker (make-marker))) + (set-marker marker 1 (current-buffer)) + (eshell-command-result-equal + (format "echo #>" (buffer-name)) + marker) + (eshell-command-result-equal + (format "echo #>" (buffer-name)) + marker)))) + (ert-deftest esh-arg-test/special-reference/var-expansion () "Test that variable expansion inside special references works." (with-temp-buffer @@ -141,6 +166,19 @@ esh-arg-test/special-reference/var-expansion "echo #" (current-buffer))))) +(ert-deftest esh-arg-test/special-reference/lisp-form () + "Test that Lisp forms inside special references work." + (with-temp-eshell + (let ((marker (make-marker)) + eshell-test-value) + (set-marker marker 1 (current-buffer)) + (eshell-insert-command + "setq eshell-test-value #") + (should (equal eshell-test-value marker)) + (eshell-insert-command + "setq eshell-test-value #>") + (should (equal eshell-test-value marker))))) + (ert-deftest esh-arg-test/special-reference/special-characters () "Test that \"#<...>\" works correctly when escaping special characters." (with-temp-buffer commit 69e8333210ae678407d6a5ba647657cc301932b7 Author: Jim Porter Date: Tue Aug 22 18:43:51 2023 -0700 Add 'eshell-special-ref-alist' to allow extending Eshell special refs * lisp/eshell/esh-cmd.el (eshell--region-p, eshell-with-temp-command): Move to... * lisp/eshell/esh-util.el (eshell--region-p) (eshell-with-temp-command): ... here. * lisp/eshell/em-cmpl.el (eshell-complete-parse-arguments): Fix edge case when 'end' is at beginning of (possibly-narrowed) buffer. * lisp/eshell/esh-arg.el (eshell-special-ref-alist) New variable... (eshell-special-ref-default): ... New option... (eshell--special-ref-function): ... New function... (eshell-parse-special-reference): ... use them. (eshell-insert-special-reference): New function. (eshell-complete-special-reference): Reimplement to use a nested call to Pcomplete. (eshell-complete-buffer-ref): New function. * lisp/eshell/esh-proc.el (eshell-proc-initialize): Add "process" special ref type here. (eshell-complete-process-ref): New function. * doc/misc/eshell.texi (Bugs and ideas): Remove now-implemented idea. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index cc94f610615..b5cc9faeec2 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -2590,11 +2590,6 @@ Bugs and ideas way@dots{}). If input redirection is added, also update the @code{file-name-quote-list}, and the delimiter list. -@item Allow @samp{#<@var{word} @var{arg}>} as a generic syntax - -With the handling of @emph{word} specified by an -@code{eshell-special-alist}. - @item In @code{eshell-eval-using-options}, allow a @code{:complete} tag It would be used to provide completion rules for that command. Then the diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 61f1237b907..0255da88dbd 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -377,7 +377,8 @@ eshell-complete-parse-arguments (throw 'pcompleted (elisp-completion-at-point))) (t (eshell--pcomplete-insert-tab))))) - (when (get-text-property (1- end) 'comment) + (when (and (< begin end) + (get-text-property (1- end) 'comment)) (eshell--pcomplete-insert-tab)) (let ((pos (1- end))) (while (>= pos begin) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index c3d3347e888..d5fcabccb14 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -165,6 +165,39 @@ eshell-parse-argument-hook :type 'hook :group 'eshell-arg) +(defvar eshell-special-ref-alist + '(("buffer" + (creation-function eshell-get-buffer) + (insertion-function eshell-insert-buffer-name) + (completion-function eshell-complete-buffer-ref))) + "Alist of special reference types for Eshell. +Each entry is a list of the form (TYPE (KEY VALUE)...). TYPE is +the name of the special reference type, and each KEY/VALUE pair +represents a parameter for the type. Eshell defines the +following KEYs: + +* `creation-function' + A function taking any number of arguments that returns the Lisp + object for this special ref type. + +* `insertion-function' + An interactive function that returns the special reference in + string form. This string should look like \"#\"; + Eshell will pass the ARGs to `creation-function'. + +* `completion-function' + A function using Pcomplete to perform completion on any + arguments necessary for creating this special reference type.") + +(defcustom eshell-special-ref-default "buffer" + "The default type for special references when the type keyword is omitted. +This should be a key in `eshell-special-ref-alist' (which see). +Eshell will expand special refs like \"#\" into +\"#<`eshell-special-ref-default' ARG...>\"." + :version "30.1" + :type 'string + :group 'eshell-arg) + (defvar-keymap eshell-arg-mode-map "C-c M-b" #'eshell-insert-buffer-name) @@ -554,70 +587,120 @@ eshell-prepare-splice ;;; Special references +(defsubst eshell--special-ref-function (type function) + "Get the specified FUNCTION for a particular special ref TYPE. +If TYPE is nil, get the FUNCTION for the `eshell-special-ref-default'." + (cadr (assq function (assoc (or type eshell-special-ref-default) + eshell-special-ref-alist)))) + (defun eshell-parse-special-reference () "Parse a special syntax reference, of the form `#'. args := `type' `whitespace' `arbitrary-args' | `arbitrary-args' -type := \"buffer\" or \"process\" +type := one of the keys in `eshell-special-ref-alist' arbitrary-args := any number of Eshell arguments If the form has no `type', the syntax is parsed as if `type' were -\"buffer\"." - (when (and (not eshell-current-argument) - (not eshell-current-quoted) - (looking-at (rx "#<" (? (group (or "buffer" "process")) - space)))) - (let ((here (point))) - (goto-char (match-end 0)) ;; Go to the end of the match. - (let ((buffer-p (if (match-beginning 1) - (equal (match-string 1) "buffer") - t)) ; With no type keyword, assume we want a buffer. - (end (eshell-find-delimiter ?\< ?\>))) - (when (not end) +`eshell-special-ref-default'." + (let ((here (point)) + (special-ref-types (mapcar #'car eshell-special-ref-alist))) + (when (and (not eshell-current-argument) + (not eshell-current-quoted) + (looking-at (rx-to-string + `(seq "#<" (? (group (or ,@special-ref-types)) + (+ space))) + t))) + (goto-char (match-end 0)) ; Go to the end of the match. + (let ((end (eshell-find-delimiter ?\< ?\>)) + (creation-fun (eshell--special-ref-function + (match-string 1) 'creation-function))) + (unless end (when (match-beginning 1) (goto-char (match-beginning 1))) (throw 'eshell-incomplete "#<")) (if (eshell-arg-delimiter (1+ end)) (prog1 - (cons (if buffer-p #'eshell-get-buffer #'get-process) + (cons creation-fun (let ((eshell-current-argument-plain t)) (eshell-parse-arguments (point) end))) (goto-char (1+ end))) (ignore (goto-char here))))))) +(defun eshell-insert-special-reference (type &rest args) + "Insert a special reference of the specified TYPE. +ARGS is a list of arguments to pass to the insertion function for +TYPE (see `eshell-special-ref-alist')." + (interactive + (let* ((type (completing-read + (format-prompt "Type" eshell-special-ref-default) + (mapcar #'car eshell-special-ref-alist) + nil 'require-match nil nil eshell-special-ref-default)) + (insertion-fun (eshell--special-ref-function + type 'insertion-function))) + (list :interactive (call-interactively insertion-fun)))) + (if (eq type :interactive) + (car args) + (apply (eshell--special-ref-function type 'insertion-function) args))) + (defun eshell-complete-special-reference () "If there is a special reference, complete it." - (let ((arg (pcomplete-actual-arg))) - (when (string-match - (rx string-start - "#<" (? (group (or "buffer" "process")) space) - (group (* anychar)) - string-end) - arg) - (let ((all-results (if (equal (match-string 1 arg) "process") - (mapcar #'process-name (process-list)) - (mapcar #'buffer-name (buffer-list)))) - (saw-type (match-beginning 1))) - (unless saw-type - ;; Include the special reference types as completion options. - (setq all-results (append '("buffer" "process") all-results))) - (setq pcomplete-stub (replace-regexp-in-string - (rx "\\" (group anychar)) "\\1" - (substring arg (match-beginning 2)))) - ;; When finished with completion, add a trailing ">" (unless - ;; we just completed the initial "buffer" or "process" - ;; keyword). - (add-function - :before (var pcomplete-exit-function) - (lambda (value status) - (when (and (eq status 'finished) - (or saw-type - (not (member value '("buffer" "process"))))) - (if (looking-at ">") - (goto-char (match-end 0)) - (insert ">"))))) - (throw 'pcomplete-completions - (all-completions pcomplete-stub all-results)))))) + (when (string-prefix-p "#<" (pcomplete-actual-arg)) + (let ((special-ref-types (mapcar #'car eshell-special-ref-alist)) + num-args explicit-type) + ;; When finished with completion, add a trailing ">" when + ;; appropriate. + (add-function + :around (var pcomplete-exit-function) + (lambda (oldfun value status) + (when (eq status 'finished) + ;; Don't count the special reference type (e.g. "buffer"). + (when (or explicit-type + (and (= num-args 1) + (member value special-ref-types))) + (setq num-args (1- num-args))) + (let ((creation-fun (eshell--special-ref-function + explicit-type 'creation-function))) + ;; Check if we already have the maximum number of + ;; arguments for this special ref type. If so, finish + ;; the ref with ">". Otherwise, insert a space and set + ;; the completion status to `sole'. + (if (eq (cdr (func-arity creation-fun)) num-args) + (if (looking-at ">") + (goto-char (match-end 0)) + (insert ">")) + (pcomplete-default-exit-function value status) + (setq status 'sole)) + (funcall oldfun value status))))) + ;; Parse the arguments to this special reference and call the + ;; appropriate completion function. + (save-excursion + (eshell-with-temp-command (cons (+ 2 (pcomplete-begin)) (point)) + (goto-char (point-max)) + (let (pcomplete-args pcomplete-last pcomplete-index pcomplete-begins) + (when (let ((eshell-current-argument-plain t)) + (pcomplete-parse-arguments + pcomplete-expand-before-complete)) + (setq num-args (length pcomplete-args)) + (if (= pcomplete-index pcomplete-last) + ;; Call the default special ref completion function, + ;; and also add the known special ref types as + ;; possible completions. + (throw 'pcomplete-completions + (nconc + (mapcar #'car eshell-special-ref-alist) + (catch 'pcomplete-completions + (funcall (eshell--special-ref-function + nil 'completion-function))))) + ;; Get the special ref type and call its completion + ;; function. + (let ((first (pcomplete-arg 'first))) + (when (member first special-ref-types) + ;; "Complete" the ref type (which we already + ;; completed above). + (pcomplete-here) + (setq explicit-type first))) + (funcall (eshell--special-ref-function + explicit-type 'completion-function)))))))))) (defun eshell-get-buffer (buffer-or-name) "Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed. @@ -630,5 +713,9 @@ eshell-insert-buffer-name (interactive "BName of buffer: ") (insert-and-inherit "#")) +(defun eshell-complete-buffer-ref () + "Perform completion for buffer references." + (pcomplete-here (mapcar #'buffer-name (buffer-list)))) + (provide 'esh-arg) ;;; esh-arg.el ends here diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 990d2ca1122..ecd947774ee 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -393,49 +393,6 @@ eshell-commands-for-process ;; Command parsing -(defsubst eshell--region-p (object) - "Return non-nil if OBJECT is a pair of numbers or markers." - (and (consp object) - (number-or-marker-p (car object)) - (number-or-marker-p (cdr object)))) - -(defmacro eshell-with-temp-command (command &rest body) - "Temporarily insert COMMAND into the buffer and execute the forms in BODY. - -COMMAND can be a string to insert, a cons cell (START . END) -specifying a region in the current buffer, or (:file . FILENAME) -to temporarily insert the contents of FILENAME. - -Before executing BODY, narrow the buffer to the text for COMMAND -and and set point to the beginning of the narrowed region. - -The value returned is the last form in BODY." - (declare (indent 1)) - (let ((command-sym (make-symbol "command")) - (begin-sym (make-symbol "begin")) - (end-sym (make-symbol "end"))) - `(let ((,command-sym ,command)) - (if (eshell--region-p ,command-sym) - (save-restriction - (narrow-to-region (car ,command-sym) (cdr ,command-sym)) - (goto-char (car ,command-sym)) - ,@body) - ;; Since parsing relies partly on buffer-local state - ;; (e.g. that of `eshell-parse-argument-hook'), we need to - ;; perform the parsing in the Eshell buffer. - (let ((,begin-sym (point)) ,end-sym) - (with-silent-modifications - (if (stringp ,command-sym) - (insert ,command-sym) - (forward-char (cadr (insert-file-contents (cdr ,command-sym))))) - (setq ,end-sym (point)) - (unwind-protect - (save-restriction - (narrow-to-region ,begin-sym ,end-sym) - (goto-char ,begin-sym) - ,@body) - (delete-region ,begin-sym ,end-sym)))))))) - (defun eshell-parse-command (command &optional args toplevel) "Parse the COMMAND, adding ARGS if given. COMMAND can be a string, a cons cell (START . END) demarcating a diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index ea5896461b4..6561561440e 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'esh-arg) (require 'esh-io) (require 'esh-util) @@ -158,6 +159,14 @@ eshell-proc-mode (defun eshell-proc-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the process handling code." (make-local-variable 'eshell-process-list) + (setq-local eshell-special-ref-alist + (cons + `("process" + (creation-function get-process) + (insertion-function eshell-insert-process) + (completion-function eshell-complete-process-ref)) + eshell-special-ref-alist)) + (eshell-proc-mode)) (define-obsolete-function-alias 'eshell-reset-after-proc @@ -699,5 +708,9 @@ eshell-insert-process (eshell-quote-argument (process-name process)) ">")) +(defun eshell-complete-process-ref () + "Perform completion for process references." + (pcomplete-here (mapcar #'process-name (process-list)))) + (provide 'esh-proc) ;;; esh-proc.el ends here diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index ca2f775318a..b22c286c635 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -242,6 +242,49 @@ eshell--unmark-string-as-output string) string) +(defsubst eshell--region-p (object) + "Return non-nil if OBJECT is a pair of numbers or markers." + (and (consp object) + (number-or-marker-p (car object)) + (number-or-marker-p (cdr object)))) + +(defmacro eshell-with-temp-command (command &rest body) + "Temporarily insert COMMAND into the buffer and execute the forms in BODY. + +COMMAND can be a string to insert, a cons cell (START . END) +specifying a region in the current buffer, or (:file . FILENAME) +to temporarily insert the contents of FILENAME. + +Before executing BODY, narrow the buffer to the text for COMMAND +and and set point to the beginning of the narrowed region. + +The value returned is the last form in BODY." + (declare (indent 1)) + (let ((command-sym (make-symbol "command")) + (begin-sym (make-symbol "begin")) + (end-sym (make-symbol "end"))) + `(let ((,command-sym ,command)) + (if (eshell--region-p ,command-sym) + (save-restriction + (narrow-to-region (car ,command-sym) (cdr ,command-sym)) + (goto-char (car ,command-sym)) + ,@body) + ;; Since parsing relies partly on buffer-local state + ;; (e.g. that of `eshell-parse-argument-hook'), we need to + ;; perform the parsing in the Eshell buffer. + (let ((,begin-sym (point)) ,end-sym) + (with-silent-modifications + (if (stringp ,command-sym) + (insert ,command-sym) + (forward-char (cadr (insert-file-contents (cdr ,command-sym))))) + (setq ,end-sym (point)) + (unwind-protect + (save-restriction + (narrow-to-region ,begin-sym ,end-sym) + (goto-char ,begin-sym) + ,@body) + (delete-region ,begin-sym ,end-sym)))))))) + (defun eshell-find-delimiter (open close &optional bound reverse-p backslash-p) "From point, find the CLOSE delimiter corresponding to OPEN. commit 1c2cb9cd6192e97a29fbe338fd1a639f6dfae2d2 Author: Jim Porter Date: Tue Aug 22 13:13:45 2023 -0700 Support arbitrary Eshell arguments inside special references * lisp/eshell/esh-arg.el (eshell-current-argument-plain): New variable. (eshell-parse-special-reference): Use 'eshell-parse-arguments'. (eshell-get-buffer): New function. (eshell-insert-buffer-name): Properly quote the buffer name. * lisp/eshell/esh-proc.el (eshell-read-process-name): Move to "Special references" section. (eshell-insert-process): Properly quote the process name. * lisp/eshell/em-extpipe.el (eshell-parse-external-pipeline): * lisp/eshell/esh-io.el (eshell-parse-redirection): Don't do anything when 'eshell-argument-plain' is non-nil. * test/lisp/eshell/esh-arg-tests.el (esh-arg-test/special-reference/quoted) (esh-arg-test/special-reference/var-expansion): New tests. (esh-arg-test/special-reference/special): Rename to... (esh-arg-test/special-reference/special-characters): ... this. * test/lisp/eshell/em-extpipe-tests.el (em-extpipe-tests--deftest): Properly quote the buffer name. (em-extpipe-test-4, em-extpipe-test-7): Use 'eshell-get-buffer'. diff --git a/lisp/eshell/em-extpipe.el b/lisp/eshell/em-extpipe.el index 5c9a0a85934..0d5c217f5f0 100644 --- a/lisp/eshell/em-extpipe.el +++ b/lisp/eshell/em-extpipe.el @@ -118,86 +118,87 @@ eshell-parse-external-pipeline ;; other members of `eshell-parse-argument-hook'. We must avoid ;; misinterpreting a quoted `*|', `*<' or `*>' as indicating an ;; external pipeline, hence the structure of the loop in `findbeg1'. - (cl-flet - ((findbeg1 (pat &optional go (bound (point-max))) - (let* ((start (point)) - (result - (catch 'found - (while (> bound (point)) - (let* ((found - (save-excursion - (re-search-forward - "\\(?:#?'\\|\"\\|\\\\\\)" bound t))) - (next (or (and found (match-beginning 0)) - bound))) - (if (re-search-forward pat next t) - (throw 'found (match-beginning 1)) - (goto-char next) - (while (eshell-extpipe--or-with-catch - (eshell-parse-lisp-argument) - (eshell-parse-backslash) - (eshell-parse-double-quote) - (eshell-parse-literal-quote))) - ;; Guard against an infinite loop if none of - ;; the parsers moved us forward. - (unless (or (> (point) next) (eobp)) - (forward-char 1)))))))) - (goto-char (if (and result go) (match-end 0) start)) - result))) - (unless (or eshell-current-argument eshell-current-quoted) - (let ((beg (point)) end - (next-marked (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)")) - (next-unmarked - (or (findbeg1 "\\(?:\\=\\|[^*]\\|\\S-\\*\\)\\(|\\)") - (point-max)))) - (when (and next-marked (> next-unmarked next-marked) - (or (> next-marked (point)) - (looking-back "\\`\\|\\s-" nil))) - ;; Skip to the final segment of the external pipeline. - (while (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*|\\)" t)) - ;; Find output redirections. - (while (findbeg1 - "\\([0-9]?>+&?[0-9]?\\s-*\\S-\\)" t next-unmarked) - ;; Is the output redirection Eshell-specific? We have our - ;; own logic, rather than calling `eshell-parse-argument', - ;; to avoid specifying here all the possible cars of - ;; parsed special references -- `get-buffer-create' etc. - (forward-char -1) - (let ((this-end - (save-match-data - (cond ((looking-at "#<") - (forward-char 1) - (1+ (eshell-find-delimiter ?\< ?\>))) - ((and (looking-at "/\\S-+") - (assoc (match-string 0) - eshell-virtual-targets)) - (match-end 0)))))) - (cond ((and this-end end) - (goto-char this-end)) - (this-end - (goto-char this-end) - (setq end (match-beginning 0))) - (t - (setq end nil))))) - ;; We've moved past all Eshell-specific output redirections - ;; we could find. If there is only whitespace left, then - ;; `end' is right before redirections we should exclude; - ;; otherwise, we must include everything. - (unless (and end (skip-syntax-forward "\s" next-unmarked) - (= next-unmarked (point))) - (setq end next-unmarked)) - (let ((cmd (string-trim - (buffer-substring-no-properties beg end)))) - (goto-char end) - ;; We must now drop the asterisks, unless quoted/escaped. - (with-temp-buffer - (insert cmd) - (goto-char (point-min)) - (cl-loop - for next = (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)" t) - while next do (forward-char -2) (delete-char 1)) - (eshell-finish-arg - `(eshell-external-pipeline ,(buffer-string)))))))))) + (unless eshell-current-argument-plain + (cl-flet + ((findbeg1 (pat &optional go (bound (point-max))) + (let* ((start (point)) + (result + (catch 'found + (while (> bound (point)) + (let* ((found + (save-excursion + (re-search-forward + "\\(?:#?'\\|\"\\|\\\\\\)" bound t))) + (next (or (and found (match-beginning 0)) + bound))) + (if (re-search-forward pat next t) + (throw 'found (match-beginning 1)) + (goto-char next) + (while (eshell-extpipe--or-with-catch + (eshell-parse-lisp-argument) + (eshell-parse-backslash) + (eshell-parse-double-quote) + (eshell-parse-literal-quote))) + ;; Guard against an infinite loop if none of + ;; the parsers moved us forward. + (unless (or (> (point) next) (eobp)) + (forward-char 1)))))))) + (goto-char (if (and result go) (match-end 0) start)) + result))) + (unless (or eshell-current-argument eshell-current-quoted) + (let ((beg (point)) end + (next-marked (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)")) + (next-unmarked + (or (findbeg1 "\\(?:\\=\\|[^*]\\|\\S-\\*\\)\\(|\\)") + (point-max)))) + (when (and next-marked (> next-unmarked next-marked) + (or (> next-marked (point)) + (looking-back "\\`\\|\\s-" nil))) + ;; Skip to the final segment of the external pipeline. + (while (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*|\\)" t)) + ;; Find output redirections. + (while (findbeg1 + "\\([0-9]?>+&?[0-9]?\\s-*\\S-\\)" t next-unmarked) + ;; Is the output redirection Eshell-specific? We have our + ;; own logic, rather than calling `eshell-parse-argument', + ;; to avoid specifying here all the possible cars of + ;; parsed special references -- `get-buffer-create' etc. + (forward-char -1) + (let ((this-end + (save-match-data + (cond ((looking-at "#<") + (forward-char 1) + (1+ (eshell-find-delimiter ?\< ?\>))) + ((and (looking-at "/\\S-+") + (assoc (match-string 0) + eshell-virtual-targets)) + (match-end 0)))))) + (cond ((and this-end end) + (goto-char this-end)) + (this-end + (goto-char this-end) + (setq end (match-beginning 0))) + (t + (setq end nil))))) + ;; We've moved past all Eshell-specific output redirections + ;; we could find. If there is only whitespace left, then + ;; `end' is right before redirections we should exclude; + ;; otherwise, we must include everything. + (unless (and end (skip-syntax-forward "\s" next-unmarked) + (= next-unmarked (point))) + (setq end next-unmarked)) + (let ((cmd (string-trim + (buffer-substring-no-properties beg end)))) + (goto-char end) + ;; We must now drop the asterisks, unless quoted/escaped. + (with-temp-buffer + (insert cmd) + (goto-char (point-min)) + (cl-loop + for next = (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)" t) + while next do (forward-char -2) (delete-char 1)) + (eshell-finish-arg + `(eshell-external-pipeline ,(buffer-string))))))))))) (defun eshell-rewrite-external-pipeline (terms) "Rewrite an external pipeline in TERMS as parsed by diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index e7b5eef11db..c3d3347e888 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -49,6 +49,8 @@ eshell-current-modifiers (defvar eshell-arg-listified nil) (defvar eshell-nested-argument nil) (defvar eshell-current-quoted nil) +(defvar eshell-current-argument-plain nil + "If non-nil, the current argument is \"plain\", and not part of a command.") (defvar eshell-inside-quote-regexp nil) (defvar eshell-outside-quote-regexp nil) @@ -184,11 +186,6 @@ eshell-arg-initialize (add-hook 'pcomplete-try-first-hook #'eshell-complete-special-reference nil t))) -(defun eshell-insert-buffer-name (buffer-name) - "Insert BUFFER-NAME into the current buffer at point." - (interactive "BName of buffer: ") - (insert-and-inherit "#")) - (defsubst eshell-escape-arg (string) "Return STRING with the `escaped' property on it." (if (stringp string) @@ -505,42 +502,6 @@ eshell-unescape-inner-double-quote (goto-char bound) (apply #'concat (nreverse strings)))))) -(defun eshell-parse-special-reference () - "Parse a special syntax reference, of the form `#'. - -args := `type' `whitespace' `arbitrary-args' | `arbitrary-args' -type := \"buffer\" or \"process\" -arbitrary-args := any string of characters. - -If the form has no `type', the syntax is parsed as if `type' were -\"buffer\"." - (when (and (not eshell-current-argument) - (not eshell-current-quoted) - (looking-at (rx "#<" (? (group (or "buffer" "process")) - space)))) - (let ((here (point))) - (goto-char (match-end 0)) ;; Go to the end of the match. - (let ((buffer-p (if (match-beginning 1) - (equal (match-string 1) "buffer") - t)) ; With no type keyword, assume we want a buffer. - (end (eshell-find-delimiter ?\< ?\>))) - (when (not end) - (when (match-beginning 1) - (goto-char (match-beginning 1))) - (throw 'eshell-incomplete "#<")) - (if (eshell-arg-delimiter (1+ end)) - (prog1 - (list (if buffer-p #'get-buffer-create #'get-process) - ;; FIXME: We should probably parse this as a - ;; real Eshell argument so that we get the - ;; benefits of quoting, variable-expansion, etc. - (string-trim-right - (replace-regexp-in-string - (rx "\\" (group anychar)) "\\1" - (buffer-substring-no-properties (point) end)))) - (goto-char (1+ end))) - (ignore (goto-char here))))))) - (defun eshell-parse-delimiter () "Parse an argument delimiter, which is essentially a command operator." ;; this `eshell-operator' keyword gets parsed out by @@ -591,7 +552,38 @@ eshell-prepare-splice (when splicep grouped-args))) -;;;_* Special ref completion +;;; Special references + +(defun eshell-parse-special-reference () + "Parse a special syntax reference, of the form `#'. + +args := `type' `whitespace' `arbitrary-args' | `arbitrary-args' +type := \"buffer\" or \"process\" +arbitrary-args := any number of Eshell arguments + +If the form has no `type', the syntax is parsed as if `type' were +\"buffer\"." + (when (and (not eshell-current-argument) + (not eshell-current-quoted) + (looking-at (rx "#<" (? (group (or "buffer" "process")) + space)))) + (let ((here (point))) + (goto-char (match-end 0)) ;; Go to the end of the match. + (let ((buffer-p (if (match-beginning 1) + (equal (match-string 1) "buffer") + t)) ; With no type keyword, assume we want a buffer. + (end (eshell-find-delimiter ?\< ?\>))) + (when (not end) + (when (match-beginning 1) + (goto-char (match-beginning 1))) + (throw 'eshell-incomplete "#<")) + (if (eshell-arg-delimiter (1+ end)) + (prog1 + (cons (if buffer-p #'eshell-get-buffer #'get-process) + (let ((eshell-current-argument-plain t)) + (eshell-parse-arguments (point) end))) + (goto-char (1+ end))) + (ignore (goto-char here))))))) (defun eshell-complete-special-reference () "If there is a special reference, complete it." @@ -627,5 +619,16 @@ eshell-complete-special-reference (throw 'pcomplete-completions (all-completions pcomplete-stub all-results)))))) +(defun eshell-get-buffer (buffer-or-name) + "Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed. +This is equivalent to `get-buffer-create', but only accepts a +single argument." + (get-buffer-create buffer-or-name)) + +(defun eshell-insert-buffer-name (buffer-name) + "Insert BUFFER-NAME into the current buffer at point." + (interactive "BName of buffer: ") + (insert-and-inherit "#")) + (provide 'esh-arg) ;;; esh-arg.el ends here diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index d0f1e04e925..c29b96dd711 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -196,7 +196,8 @@ eshell-io-initialize (defun eshell-parse-redirection () "Parse an output redirection, such as `2>' or `>&'." - (when (not eshell-current-quoted) + (unless (or eshell-current-quoted + eshell-current-argument-plain) (cond ;; Copying a handle (e.g. `2>&1'). ((looking-at (rx (? (group digit)) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 3c946c22bdc..ea5896461b4 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -227,23 +227,6 @@ eshell/kill (put 'eshell/kill 'eshell-no-numeric-conversions t) -(defun eshell-read-process-name (prompt) - "Read the name of a process from the minibuffer, using completion. -The prompt will be set to PROMPT." - (completing-read prompt - (mapcar - (lambda (proc) - (cons (process-name proc) t)) - (process-list)) - nil t)) - -(defun eshell-insert-process (process) - "Insert the name of PROCESS into the current buffer at point." - (interactive - (list (get-process - (eshell-read-process-name "Name of process: ")))) - (insert-and-inherit "#")) - (defsubst eshell-record-process-object (object) "Record OBJECT as now running." (when (and eshell-subjob-messages @@ -695,5 +678,26 @@ eshell-quit-process ; ;; `eshell-resume-eval'. ; (eshell--reset-after-signal "continue\n"))) +;;; Special references + +(defun eshell-read-process-name (prompt) + "Read the name of a process from the minibuffer, using completion. +The prompt will be set to PROMPT." + (completing-read prompt + (mapcar + (lambda (proc) + (cons (process-name proc) t)) + (process-list)) + nil t)) + +(defun eshell-insert-process (process) + "Insert the name of PROCESS into the current buffer at point." + (interactive + (list (get-process + (eshell-read-process-name "Name of process: ")))) + (insert-and-inherit "#")) + (provide 'esh-proc) ;;; esh-proc.el ends here diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index bdffcd9b320..6984ec2de59 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -55,7 +55,9 @@ em-extpipe-tests--deftest "temp\\([^>]\\|\\'\\)" temp (string-replace "#" - (concat "#") + (format "#" + (eshell-quote-argument + (buffer-name temp-buffer))) input)))) ,@body) (when (buffer-name temp-buffer) @@ -110,7 +112,7 @@ em-extpipe-test-4 '(progn (ignore (eshell-set-output-handle 1 'overwrite - (get-buffer-create "temp"))) + (eshell-get-buffer "temp"))) (eshell-named-command "sh" (list "-c" "echo \"bar\" | rev")))) (with-substitute-for-temp @@ -133,7 +135,7 @@ em-extpipe-test-7 '(progn (ignore (eshell-set-output-handle 1 'overwrite - (get-buffer-create "quux"))) + (eshell-get-buffer "quux"))) (ignore (eshell-set-output-handle 1 'append (get-process "other"))) diff --git a/test/lisp/eshell/esh-arg-tests.el b/test/lisp/eshell/esh-arg-tests.el index c883db3907f..0e07d107562 100644 --- a/test/lisp/eshell/esh-arg-tests.el +++ b/test/lisp/eshell/esh-arg-tests.el @@ -118,7 +118,30 @@ esh-arg-test/special-reference/buffer (format "echo #" (buffer-name)) (current-buffer)))) -(ert-deftest esh-arg-test/special-reference/special () +(ert-deftest esh-arg-test/special-reference/quoted () + "Test that '#' refers to the buffer \"foo bar\"." + (with-temp-buffer + (rename-buffer "foo bar" t) + (eshell-command-result-equal + (format "echo #" (buffer-name)) + (current-buffer)) + (eshell-command-result-equal + (format "echo #" (buffer-name)) + (current-buffer)))) + +(ert-deftest esh-arg-test/special-reference/var-expansion () + "Test that variable expansion inside special references works." + (with-temp-buffer + (rename-buffer "my-buffer" t) + (let ((eshell-test-value (buffer-name))) + (eshell-command-result-equal + "echo #" + (current-buffer)) + (eshell-command-result-equal + "echo #" + (current-buffer))))) + +(ert-deftest esh-arg-test/special-reference/special-characters () "Test that \"#<...>\" works correctly when escaping special characters." (with-temp-buffer (rename-buffer "" t) commit f7d88f4a0478d89f70243456af8c4d4817d6b251 Author: Andrea Corallo Date: Tue Oct 24 17:09:38 2023 +0200 Make eln files re-dumpable (bug#45103) * lisp/loadup.el (load--bin-dest-dir, load--eln-dest-dir): New variable. (load--fixup-all-elns): New function. * src/pdumper.c (Fdump_emacs_portable): Update to call 'load--fixup-all-elns'. * src/print.c (print_vectorlike): Improve CU printing. diff --git a/lisp/loadup.el b/lisp/loadup.el index 35c59dba453..07895228d0d 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -496,23 +496,23 @@ ;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") -(defvar comp-subr-arities-h) -(when (featurep 'native-compile) - ;; Save the arity for all primitives so the compiler can always - ;; retrive it even in case of redefinition. - (mapatoms (lambda (f) - (when (subr-primitive-p (symbol-function f)) - (puthash f (func-arity f) comp-subr-arities-h)))) - ;; Fix the compilation unit filename to have it working when - ;; installed or if the source directory got moved. This is set to be - ;; a pair in the form of: - ;; (rel-filename-from-install-bin . rel-filename-from-local-bin). - (let ((bin-dest-dir (cadr (member "--bin-dest" command-line-args))) - (eln-dest-dir (cadr (member "--eln-dest" command-line-args)))) - (when (and bin-dest-dir eln-dest-dir) - (setq eln-dest-dir - (concat eln-dest-dir "native-lisp/" comp-native-version-dir "/")) - (maphash (lambda (_ cu) +(defvar load--bin-dest-dir nil + "Store the original value passed by \"--bin-dest\" during dump. +Internal use only.") +(defvar load--eln-dest-dir nil + "Store the original value passed by \"--eln-dest\" during dump. +Internal use only.") + +(defun load--fixup-all-elns () + "Fix all compilation unit filename. +This to have it working when installed or if Emacs source +directory got moved. This is set to be a pair in the form of: +\(rel-filename-from-install-bin . rel-filename-from-local-bin)." + (when (and load--bin-dest-dir load--eln-dest-dir) + (setq eln-dest-dir + (concat load--eln-dest-dir "native-lisp/" comp-native-version-dir "/")) + (maphash (lambda (_ cu) + (when (stringp (native-comp-unit-file cu)) (let* ((file (native-comp-unit-file cu)) (preloaded (equal (substring (file-name-directory file) -10 -1) @@ -529,10 +529,20 @@ comp-subr-arities-h (file-name-nondirectory file) eln-dest-dir-eff) - bin-dest-dir) + load--bin-dest-dir) ;; Relative filename from the built uninstalled binary. - (file-relative-name file invocation-directory))))) - comp-loaded-comp-units-h))) + (file-relative-name file invocation-directory)))))) + comp-loaded-comp-units-h))) + +(defvar comp-subr-arities-h) +(when (featurep 'native-compile) + ;; Save the arity for all primitives so the compiler can always + ;; retrive it even in case of redefinition. + (mapatoms (lambda (f) + (when (subr-primitive-p (symbol-function f)) + (puthash f (func-arity f) comp-subr-arities-h)))) + (setq load--bin-dest-dir (cadr (member "--bin-dest" command-line-args))) + (setq load--eln-dest-dir (cadr (member "--eln-dest" command-line-args))) ;; Set up the mechanism to allow inhibiting native-comp via ;; file-local variables. (defvar comp--no-native-compile (make-hash-table :test #'equal))) diff --git a/src/pdumper.c b/src/pdumper.c index ce4faefdaea..315a31e2bcb 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4090,6 +4090,10 @@ DEFUN ("dump-emacs-portable", if (!NILP (XCDR (Fall_threads ()))) error ("No other Lisp threads can be running when this function is called"); +#ifdef HAVE_NATIVE_COMP + CALLN (Ffuncall, intern_c_string ("load--fixup-all-elns")); +#endif + check_pure_size (); /* Clear out any detritus in memory. */ diff --git a/src/print.c b/src/print.c index eb20cfb1c47..4eee8319f65 100644 --- a/src/print.c +++ b/src/print.c @@ -2008,7 +2008,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, { struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (obj); print_c_string ("#file, printcharfun); + print_object (cu->file, printcharfun, escapeflag); printchar (' ', printcharfun); print_object (cu->optimize_qualities, printcharfun, escapeflag); printchar ('>', printcharfun); commit 522a74d60a915ca9e922ad42dedc19d9f72e3ae5 Author: Harald Jörg Date: Tue Oct 24 17:54:39 2023 +0200 ; cperl-mode.el: Remove functions using mode-compile.el mode-compile.el is no longer available from any maintained repository, its archived version does not work since Emacs 27. The menu options tested for availability of mode-compile and therefore were disabled, the function was not documented. * lisp/progmodes/cperl-mode.el (cperl-tips): Remove reference to mode-compile.el. (cperl-menu): Remove defunct entries requiring mode-compile. (cperl-check-syntax): Remove function. (cperl-extra-perl-args): Remove user option only used by cperl-check-syntax. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index d525b069407..807927aa86d 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -473,12 +473,6 @@ cperl-under-as-char :group 'cperl) (make-obsolete-variable 'cperl-under-as-char 'superword-mode "24.4") -(defcustom cperl-extra-perl-args "" - "Extra arguments to use when starting Perl. -Currently used with `cperl-check-syntax' only." - :type 'string - :group 'cperl) - (defcustom cperl-message-electric-keyword t "Non-nil means that the `cperl-electric-keyword' prints a help message." :type 'boolean @@ -631,10 +625,7 @@ cperl-hash-face ;;; Short extra-docs. (defvar cperl-tips 'please-ignore-this-line - "Note that to enable Compile choices in the menu you need to install -mode-compile.el. - -If your Emacs does not default to `cperl-mode' on Perl files, and you + "If your Emacs does not default to `cperl-mode' on Perl files, and you want it to: put the following into your .emacs file: (add-to-list \\='major-mode-remap-alist \\='(perl-mode . cperl-mode)) @@ -1056,12 +1047,6 @@ cperl-menu ["Comment region" cperl-comment-region (use-region-p)] ["Uncomment region" cperl-uncomment-region (use-region-p)] "----" - ["Run" mode-compile (fboundp 'mode-compile)] - ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) - (get-buffer "*compilation*"))] - ["Next error" next-error (get-buffer "*compilation*")] - ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] - "----" ["Debugger" cperl-db t] "----" ("Tools" @@ -6561,13 +6546,6 @@ cperl-set-style-back cperl-old-style (cdr cperl-old-style)) (set (car setting) (cdr setting))))) -(defvar perl-dbg-flags) -(defun cperl-check-syntax () - (interactive) - (require 'mode-compile) - (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc"))) - (eval '(mode-compile)))) ; Avoid a warning - (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case noerror)) commit 87b8a9da0158e5cfcc0193937fc7c308f623790d Author: Stefan Kangas Date: Tue Oct 24 17:48:44 2023 +0200 ; Add missing documentation tags to etc/NEWS diff --git a/etc/NEWS b/etc/NEWS index 52fc02df36a..e6c47660522 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -62,12 +62,14 @@ more details. ** Emacs now supports Unicode Standard version 15.1. ++++ ** The Network Security Manager now warns about 3DES by default. This cypher is no longer recommended owing to a major vulnerability disclosed in 2016, and its small 112 bit key size. Emacs now warns about its use also when 'network-security-level' is set to 'medium' (the default). See 'network-security-protocol-checks'. +--- ** The Network Security Manager now warns about <2048 bits in DH key exchange. Emacs used to warn for Diffie-Hellman key exchanges with prime numbers smaller than 1024 bits. Since more servers now support it, this commit d2830c9f319d33f68fad4966ccf9d6b272233973 Author: Stefan Kangas Date: Tue Oct 24 17:28:51 2023 +0200 Make NSM warn if DH key exchange has less than 2048 bit primes The previous default was to warn when servers supported only 1024 bit primes in Diffie-Hellman key exchanges. This highly conservative number was based on the observation that, in November 2018, no less than 12.7% of servers still only supported 1024 bit primes (less than 0.1% supported only 768 and 512 bits). Five years later, in October 2023, only 3.7 % of servers remain with only 1024 bit support. SSL Labs summarizes: "At this time, 2048 bits is the minimum expected strength." Therefore, it is reasonable to start warning users about this in Emacs 30.1, at which time even fewer servers with such poor capabilities will remain. Note that key exchanges based on 1024 bit prime number were considered broken for security purposes already in 2015 (see Logjam below). For more information: https://www.ssllabs.com/ssl-pulse/ https://en.wikipedia.org/wiki/Logjam_(computer_security) * lisp/net/nsm.el (nsm-protocol-check--dhe-prime-kx): Bump expected minimum number of prime bits to 2048. diff --git a/etc/NEWS b/etc/NEWS index 9268575c246..52fc02df36a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -68,6 +68,11 @@ disclosed in 2016, and its small 112 bit key size. Emacs now warns about its use also when 'network-security-level' is set to 'medium' (the default). See 'network-security-protocol-checks'. +** The Network Security Manager now warns about <2048 bits in DH key exchange. +Emacs used to warn for Diffie-Hellman key exchanges with prime numbers +smaller than 1024 bits. Since more servers now support it, this +number has been bumped to 2048 bits. + ** Help *** 'describe-function' shows function inferred type when available. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 478a2998830..274cca7123a 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -387,12 +387,11 @@ nsm-protocol-check--dhe-prime-kx connections to insecure 512-bit export grade cryptography. The Logjam paper suggests using 1024-bit prime on the client to -mitigate some effects of this attack, and upgrade to 2048-bit as -soon as server configurations allow. According to SSLLabs' SSL -Pulse tracker, only about 75% of server support 2048-bit key -exchange in June 2018[2]. To provide a balance between -compatibility and security, this function only checks for a -minimum key strength of 1024-bit. +mitigate some effects of this attack, and upgrading to 2048-bit +as soon as server configurations allow. According to SSLLabs' +SSL Pulse tracker the overwhelming majority of servers support +2048-bit key exchange in October 2023[2]. This function +therefore checks for a minimum key strength of 2048 bits. See also: `nsm-protocol-check--dhe-kx' @@ -404,10 +403,10 @@ nsm-protocol-check--dhe-prime-kx `https://www.ssllabs.com/ssl-pulse/'" (let ((prime-bits (plist-get status :diffie-hellman-prime-bits))) (if (and (string-match "^\\bDHE\\b" (plist-get status :key-exchange)) - (< prime-bits 1024)) + (< prime-bits 2048)) (format-message "Diffie-Hellman key strength (%s bits) too weak (%s bits)" - prime-bits 1024)))) + prime-bits 2048)))) (defun nsm-protocol-check--dhe-kx (_host _port status &optional _settings) "Check for existence of DH key exchange based on integer factorization. commit dbcaaf375f285a42ff1a81c313a454264374cbdb Author: Stefan Kangas Date: Tue Oct 24 16:20:42 2023 +0200 Warn about 3DES when network-security-level is medium * lisp/net/nsm.el (network-security-protocol-checks): Bump deprecated and insecure '3des-cipher' to 'medium'. * doc/emacs/misc.texi (Network Security): Document the above change. Ref: https://nvd.nist.gov/vuln/detail/CVE-2016-2183 diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index a05b7f6c6ea..d7168fa1ca0 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -399,18 +399,18 @@ Network Security these if what you're doing requires higher security. (This is the @code{ssl} check in @code{network-security-protocol-checks}). +@item Triple DES (or @acronym{3DES}) cipher +The @acronym{3DES} stream cipher provides at most 112 bits of +effective security, and a major security vulnerability in it was +disclosed in 2016 (CVE-2016-2183). It has been deprecated by NIST in +all applications from late 2023 onwards. (This is the +@code{3des-cipher} check in @code{network-security-protocol-checks}). @end table If @code{network-security-level} is @code{high}, the following checks will be made, in addition to the above: @table @asis -@item @acronym{3DES} cipher -The @acronym{3DES} stream cipher provides at most 112 bits of -effective security, which is considered to be towards the low end. -(This is the @code{3des} check in -@code{network-security-protocol-checks}). - @item a validated certificate changes the public key Servers change their keys occasionally, and that is normally nothing to be concerned about. However, if you are worried that your network diff --git a/etc/NEWS b/etc/NEWS index 8becfae7bb9..9268575c246 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -62,6 +62,12 @@ more details. ** Emacs now supports Unicode Standard version 15.1. +** The Network Security Manager now warns about 3DES by default. +This cypher is no longer recommended owing to a major vulnerability +disclosed in 2016, and its small 112 bit key size. Emacs now warns +about its use also when 'network-security-level' is set to 'medium' +(the default). See 'network-security-protocol-checks'. + ** Help *** 'describe-function' shows function inferred type when available. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 8558a1fd5d1..478a2998830 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -149,10 +149,11 @@ network-security-protocol-checks (dhe-prime-kx medium) (sha1-sig medium) (ecdsa-cbc-cipher medium) + ;; Deprecated by NIST from 2016/2023 (see also CVE-2016-2183). + (3des-cipher medium) ;; Towards TLS 1.3 (dhe-kx high) (rsa-kx high) - (3des-cipher high) (cbc-cipher high)) "This variable specifies what TLS connection checks to perform. It's an alist where the key is the name of the check, and the @@ -169,13 +170,13 @@ network-security-protocol-checks See also: `nsm-check-tls-connection', `nsm-save-host-names', `nsm-settings-file'" - :version "27.1" :type '(repeat (list (symbol :tag "Check function") (choice :tag "Level" :value medium (const :tag "Low" low) (const :tag "Medium" medium) - (const :tag "High" high))))) + (const :tag "High" high)))) + :version "30.1") (defun nsm-save-fingerprint-maybe (host port status &rest _) "Save the certificate's fingerprint. commit a59d1da0dde890da59dc007d39efb1a0892ebbb6 Author: Stefan Kangas Date: Tue Oct 24 16:09:30 2023 +0200 ; Fix typo diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 7cbeb48f5be..8558a1fd5d1 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -484,7 +484,7 @@ nsm-protocol-check--cbc-cipher padding oracle attacks[1]. Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[2] has -been enabled by default[3]. If encrypt-then-MAC is negotiated, +been enabled by default[3]. If encrypt-then-MAC is negotiated, this check has no effect. Reference: commit 4bf6f8d99765851e46f58488bae75c19bcc6c797 Author: Po Lu Date: Tue Oct 24 21:12:32 2023 +0800 Introduce an option which controls touch screen hscroll * doc/emacs/input.texi (Touchscreens): Document this new function and revise this node for clarity and pithiness. * lisp/touch-screen.el (touch-screen): New custom group. (touch-screen-display-keyboard, touch-screen-delay) (touch-screen-precision-scroll, touch-screen-word-select) (touch-screen-extend-selection, touch-screen-preview-select): Move such options to that group. (touch-screen-enable-hscroll): New user option. (touch-screen-handle-scroll): If it is disabled, maintain the hscroll accumulators but refrain from scrolling the window. diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index db0e88a1c9c..5b559652896 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -23,56 +23,56 @@ Touchscreens @section Using Emacs on Touchscreens @cindex touchscreen input - Touchscreen input works by pressing and moving tools (which include -fingers and some pointing devices--styluses, for example) onto a frame -in order to manipulate its contents. + Touchscreen input is the manipulation of a frame's contents by the +placement and motion of tools (instanced by fingers and such pointing +devices as styluses) on a monitor or computer terminal where a frame +is displayed. - When running under the X Window System or Android, Emacs -automatically detects and maps the following sequences of movements -(``gestures'') to common actions: + Under the X Window System or Android, Emacs detects and maps the +following sequences of movements (``gestures'') to common actions: @itemize @bullet @item @cindex tapping, touchscreens - ``Tapping'', briefly placing and lifting a tool from the display, -will result in Emacs selecting the window that was tapped, and -executing any command bound to @code{mouse-1} at that location in the -window. If the tap happened on top of a link (@pxref{Mouse -References}), then Emacs will follow the link instead. - - If a command bound to @code{down-mouse-1} is bound to the location -where the tap took place, Emacs will execute that command as well. + @dfn{Tapping}, briefly placing and lifting a tool from the display, +will select the window that was tapped, and execute any command bound +to @code{mouse-1} at that location in the window. If a link +(@pxref{Mouse References}) exists there, then Emacs will follow that +link instead (insofar as such action differs from that taken upon the +simulation of a @code{mouse-1} event). @item @cindex scrolling, touchscreens - ``Scrolling'', meaning to place a tool on the display and move it up -or down, will result in Emacs scrolling the window contents in the -direction where the tool moves. - - If the tool is moved left or right, Emacs additionally scrolls the -window horizontally to follow (@pxref{Horizontal Scrolling}.) +@vindex touch-screen-enable-hscroll + @dfn{Scrolling}, which is continuous vertical or horizontal motion +on the screen, will scroll the contents of the window beneath the +tool's initial location in the direction of movement. The user option +@code{touch-screen-enable-hscroll} governs whether horizontal +scrolling (@pxref{Horizontal Scrolling}) is performed in reaction to +this gesture. @item @cindex dragging, touchscreens @cindex long-press, touchscreens - ``Dragging'', which is performing a @dfn{long-press} by placing a -tool on the display and leaving it there for a while prior to moving -the tool around will make Emacs set the point to where the tool was -and begin selecting text under the tool as it moves around, as if -@code{mouse-1} were to be held down. @xref{Mouse Commands}. + @dfn{Dragging}, which is performing a @dfn{long-press} by placing a +tool on the display and leaving it there awhile before moving it to +another position, will move point to the tool's initial position, and +commence selecting text under the tool as it continues its motion, as +if @code{mouse-1} were to be held down and a mouse moved anologously. +@xref{Mouse Commands}. @vindex touch-screen-word-select @cindex word selection mode, touchscreens - Some people find it difficult to position a tool accurately on a -touch screen display, to the detriment of text selection. The user -option @code{touch-screen-word-select} enables ``word selection -mode'', causing dragging to select the complete word, not only the -character containing the position of the tool. + To the detriment of text selection, it can prove challenging to +position a tool accurately on a touch screen display. The user option +@code{touch-screen-word-select}, which when enabled, prompts dragging +to select the complete word under the tool. (Normally, the selection +is only extended to encompass the character beneath the tool.) @vindex touch-screen-extend-selection @cindex extending the selection, touchscreens - Similarly, it may be difficult to select all of the text intended -within a single gesture. If the user option + In the same vein, it may be difficult to select all of the text +intended within a single gesture. If the user option @code{touch-screen-extend-selection} is enabled, taps on the locations of the point or the mark within a window will begin a new ``drag'' gesture, where the region will be extended in the direction of any @@ -80,21 +80,19 @@ Touchscreens @vindex touch-screen-preview-select @cindex previewing the region during selection, touchscreens - Difficulties in making accurate adjustments to the region can also -be alleviated by indicating the position of the point relative to its -containing line within the echo area, since the window cursor may be -physically obscured by the tool. If + Difficulties in making accurate adjustments to the region from the +cursor being physically obscured by the tool can be mitigated by +indicating the position of the point within the echo area. If @code{touch-screen-preview-select} is non-@code{nil}, the line -containing point is displayed in the echo area (@pxref{Echo Area}) -during the motion of the tool, followed by another line indicating the -position of point within the first line. +surrounding point is displayed in the echo area (@pxref{Echo Area}) +during the motion of the tool, below which is another line indicating +the position of point relative to the first. @end itemize @vindex touch-screen-delay - By default, Emacs considers a tool as having been left on the -display long enough to trigger a ``long-press'' after 0.7 seconds, but -this can be changed by customizing the variable -@code{touch-screen-delay}. + Emacs registers a long-press after the time a tool has been placed +upon the screen exceeds 0.7 seconds. This delay can be adjusted +through customizing the variable @code{touch-screen-delay}. @node On-Screen Keyboards @section Using Emacs with Virtual Keyboards diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 2621aebf037..ea1e27a263b 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -58,25 +58,30 @@ touch-screen-translate-prompt If non-nil, the touch screen key event translation machinery 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") + (defcustom touch-screen-display-keyboard nil "If non-nil, always display the on screen keyboard. A buffer local value means to always display the on screen keyboard when the buffer is selected." :type 'boolean - :group 'mouse + :group 'touch-screen :version "30.1") (defcustom touch-screen-delay 0.7 "Delay in seconds before Emacs considers a touch to be a long-press." :type 'number - :group 'mouse + :group 'touch-screen :version "30.1") (defcustom touch-screen-precision-scroll nil "Whether or not to use precision scrolling for touch screens. See `pixel-scroll-precision-mode' for more details." :type 'boolean - :group 'mouse + :group 'touch-screen :version "30.1") (defcustom touch-screen-word-select nil @@ -84,7 +89,7 @@ touch-screen-word-select If non-nil, long-press events (see `touch-screen-delay') followed by dragging will try to select entire words." :type 'boolean - :group 'mouse + :group 'touch-screen :version "30.1") (defcustom touch-screen-extend-selection nil @@ -93,7 +98,7 @@ touch-screen-extend-selection mark will resume dragging where it left off while the region is active." :type 'boolean - :group 'mouse + :group 'touch-screen :version "30.1") (defcustom touch-screen-preview-select nil @@ -102,7 +107,15 @@ touch-screen-preview-select will be displayed in the echo area while dragging combined with an indication of the position of point within that line." :type 'boolean - :group 'mouse + :group 'touch-screen + :version "30.1") + +(defcustom touch-screen-enable-hscroll t + "If non-nil, hscroll can be changed from the touch screen. +When enabled, tapping on a window and dragging your finger left +or right will scroll that window horizontally." + :type 'boolean + :group 'touch-screen :version "30.1") (defvar-local touch-screen-word-select-bounds nil @@ -229,7 +242,12 @@ touch-screen-handle-scroll (>= (- accumulator) column-width)) (progn (setq accumulator (+ accumulator column-width)) - (scroll-right 1) + ;; Maintain both hscroll counters even when + ;; it's disabled to prevent unintentional or + ;; patently horizontal gestures from + ;; scrolling the window vertically. + (when touch-screen-enable-hscroll + (scroll-right 1)) (setq lines-hscrolled (1+ lines-hscrolled)) (when (not (zerop accumulator)) ;; If there is still an outstanding amount @@ -238,7 +256,8 @@ touch-screen-handle-scroll (when (and (> accumulator 0) (>= accumulator column-width)) (setq accumulator (- accumulator column-width)) - (scroll-left 1) + (when touch-screen-enable-hscroll + (scroll-left 1)) (setq lines-hscrolled (1+ lines-hscrolled)) (when (not (zerop accumulator)) ;; If there is still an outstanding amount to commit 408c904d6602cf269c128a5b5e7b9d0e0b4f7d69 Author: Ulrich Müller Date: Tue Oct 24 07:53:17 2023 +0200 * Makefile.in (sanity-check): Add the -Q option. (Bug#66721) diff --git a/Makefile.in b/Makefile.in index 51a27cc1814..45540d2742f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -421,7 +421,7 @@ advice-on-failure: sanity-check: @[ -f .no-advice-on-failure ] && exit 0; true - @v=`src/emacs${EXEEXT} --batch --eval \ + @v=`src/emacs${EXEEXT} --batch -Q --eval \ '(progn (defun f (n) (if (= 0 n) 1 (* n (f (- n 1))))) (princ (f 10)))' \ 2> /dev/null`; \ [ "X$$v" = "X3628800" ] && exit 0; \ commit 04215e616f58ea9849bfc4e3dce08eee2debd301 Author: Lassi Kortela Date: Sat Oct 21 13:10:50 2023 +0300 Recognize backslash in `dns-mode` quoted values * lisp/textmodes/dns-mode.el (dns-mode-syntax-table): Recognize backslash as an escape character. (Bug#66660) (cherry picked from commit e6f05e189db73a0f0b29f987381ffef61a409232) diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 1b5f0c1d94b..bc3fa8d8e3a 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -132,6 +132,7 @@ dns-mode-syntax-table (modify-syntax-entry ?\; "< " table) (modify-syntax-entry ?\n "> " table) (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\\ "\\" table) table) "Syntax table in use in DNS master file buffers.") commit 6629e861b355366ff9d258eb02c184d219a932b8 Author: Stefan Kangas Date: Tue Sep 5 23:06:21 2023 +0200 Make `dns-mode` fontify quoted values correctly * lisp/textmodes/dns-mode.el (dns-mode-syntax-table): Fontify quoted values correctly. (Bug#62214) Suggested by Trent W. Buck . (cherry picked from commit c586d984f279aa61de4f5dfc4f6df660188dd0f6) diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 0167c757473..1b5f0c1d94b 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -131,6 +131,7 @@ dns-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\; "< " table) (modify-syntax-entry ?\n "> " table) + (modify-syntax-entry ?\" "\"" table) table) "Syntax table in use in DNS master file buffers.") commit f1ae3c944a6cb6e268c6e95fc20988322ed1dc11 Author: Stefan Kangas Date: Tue Oct 24 12:15:14 2023 +0200 ; Minor copyedits in the drag-and-drop docs * doc/lispref/frames.texi (Drag and Drop): Copyedits, mostly to use simpler and more direct language. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 56e4fe419e3..fb19317cedf 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4886,30 +4886,30 @@ Drag and Drop @cindex initiating drag-and-drop It is also possible to drag content from Emacs to other programs -whenever this is supported for the current window-system. The -functions which provide for this are as follows: +when this is supported by the current window-system. The functions +which provide for this are as follows: @cindex drop target, in drag-and-drop operations @defun dnd-begin-text-drag text &optional frame action allow-same-frame -This function commences a drag-and-drop operation from @var{frame} to +This function starts a drag-and-drop operation from @var{frame} to another program (dubbed the @dfn{drop target}), and returns when @var{text} is dropped or the operation is canceled. @var{action} must be one of the symbols @code{copy} or @code{move}, where @code{copy} means that @var{text} should be inserted by the drop -target, and @code{move} means the same as @code{copy}, but furthermore -enjoins the caller to delete @var{text} from its source as explained -in the list below. +target, and @code{move} means the same as @code{copy}, but the caller +must also delete @var{text} from its source as explained in the list +below. @var{frame} is the frame where the mouse is currently held down, or @code{nil}, which means to use the selected frame. Since this -function is liable to return promptly if no mouse buttons are held -down, it should be only called in response to a @code{down-mouse-1} or +function might return promptly if no mouse buttons are held down, it +should be only called in response to a @code{down-mouse-1} or analogous event (@pxref{Mouse Events}), with @var{frame} set to the frame where that event was generated (@pxref{Click Events}). If @var{allow-same-frame} is @code{nil}, drops on top of @var{frame} -will be disregarded. +will be ignored. The return value reflects the action that the drop target actually performed, and thus also what action, if any, the caller should in @@ -4934,7 +4934,7 @@ Drag and Drop @end defun @defun dnd-begin-file-drag file &optional frame action allow-same-frame -This function commences a drag-and-drop operation from @var{frame} to +This function starts a drag-and-drop operation from @var{frame} to another program (dubbed the @dfn{drop target}), and returns when @var{file} is dropped or the operation is canceled. commit 27ab3b14de1c881cd57c4c6d96c736f48909323d Author: Mattias Engdegård Date: Tue Oct 24 11:48:43 2023 +0200 Better LLDB frame information (bug#66604) Instead of modifying `frame-format` to be entirely machine-readable, keep the original human-readable format and append a second, machine-readable line that we remove after parsing. * lisp/progmodes/gud.el (gud-lldb-marker-filter): Parse the new line format and filter it out. * lisp/progmodes/gud.el (gud-lldb-def-python-completion-function): Rename to... (gud--lldb-python-init-string): ...this and add modification of `frame-format`, which seems easiest done from Python. (gud-lldb-frame-format): Remove. (gud-lldb-initialize): Update, remove no longer needed parts. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 1d3c2a72863..8692a6be023 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3868,24 +3868,32 @@ gud-gud-lldb-command-name (defun gud-lldb-marker-filter (string) "Deduce interesting stuff from process output STRING." - (cond - ;; gud-info: (function-name args...) - ((string-match (rx line-start (0+ blank) "gud-info:" (0+ blank) - (group "(" (1+ (not ")")) ")")) - string) - (let* ((form (string-replace "///" "\"" (match-string 1 string))) - (form (car (read-from-string form)))) - (when (eq (car form) 'gud-lldb-stop) - (let ((plist (cdr form))) - (setq gud-last-frame (list (plist-get plist :file) - (plist-get plist :line) - (plist-get plist :column))))))) - ;; Process 72874 exited with status = 9 (0x00000009) killed. - ;; Doesn't seem to be changeable as of LLDB 17.0.2. - ((string-match (rx "Process " (1+ digit) " exited with status") - string) - (setq gud-last-last-frame nil) - (setq gud-overlay-arrow-position nil))) + + ;; Pick information from our own frame info line "!gud LINE:COL:FILE" + ;; because the file name in the standard LLDB frame-format doesn't have + ;; a directory. + (setq string + (replace-regexp-in-string + (rx bol "!gud " + (group (+ digit)) ":" ; 1: line + (group (* digit)) ":" ; 2: column + (group (+ (not (in "\n\r")))) ; 3: file + (* "\r") "\n") + (lambda (m) + (let ((line (string-to-number (match-string 1 m))) + (col (string-to-number (match-string 2 m))) + (file (match-string 3 m))) + (setq gud-last-frame (list file line col))) + ;; Remove the line so that the user won't see it. + "") + string t t)) + + (when (string-match (rx "Process " (1+ digit) " exited with status") + string) + ;; Process 72874 exited with status = 9 (0x00000009) killed. + ;; Doesn't seem to be changeable as of LLDB 17.0.2. + (setq gud-last-last-frame nil) + (setq gud-overlay-arrow-position nil)) ;; LLDB sometimes emits certain ECMA-48 sequences even if TERM is "dumb": ;; CHA (Character Horizontal Absolute) and ED (Erase in Display), @@ -3946,8 +3954,13 @@ gud-lldb-max-completions :type 'integer :version "30.1") -(defvar gud-lldb-def-python-completion-function - " +(defconst gud--lldb-python-init-string + "\ +deb = lldb.debugger +inst = deb.GetInstanceName() +ff = deb.GetInternalVariableValue('frame-format', inst).GetStringAtIndex(0) +ff = ff[:-1] + '!gud ${line.number}:${line.column}:${line.file.fullpath}\\\\n\"' +_ = deb.SetInternalVariable('frame-format', ff, inst) def gud_complete(s, max): interpreter = lldb.debugger.GetCommandInterpreter() string_list = lldb.SBStringList() @@ -3959,7 +3972,7 @@ gud-lldb-def-python-completion-function print(f'\"{string_list.GetStringAtIndex(i)}\" ') print(')##') " - "LLDB Python function for completion.") + "Python code sent to LLDB for gud-specific initialisation.") (defun gud-lldb-fetch-completions (context command) "Return the data to complete the LLDB command before point. @@ -4010,15 +4023,6 @@ gud-lldb-completion-at-point (completion-table-dynamic (apply-partially #'gud-lldb-completions context))))) -(defvar gud-lldb-frame-format - (concat "gud-info: (gud-lldb-stop " - ;; Quote the filename this way to avoid quoting issues in - ;; the interplay between Emacs and LLDB. The quotes are - ;; corrected in the process filter. - ":file ///${line.file.fullpath}/// " - ":line ${line.number} " - ":column ${line.column})\\n")) - (defun gud-lldb-send-python (python) (gud-basic-call "script --language python --") (mapc #'gud-basic-call (split-string python "\n")) @@ -4026,12 +4030,9 @@ gud-lldb-send-python (defun gud-lldb-initialize () "Initialize the LLDB process as needed for this debug session." - (gud-lldb-send-python gud-lldb-def-python-completion-function) + (gud-lldb-send-python gud--lldb-python-init-string) (gud-basic-call "settings set stop-line-count-before 0") - (gud-basic-call "settings set stop-line-count-after 0") - (gud-basic-call (format "settings set frame-format \"%s\"" - gud-lldb-frame-format)) - (gud-basic-call "script --language python -- print('Gud initialized.')")) + (gud-basic-call "settings set stop-line-count-after 0")) ;;;###autoload (defun lldb (command-line) commit aa253c533d23d0fda1ecc512d94dea24501803ed Author: Stefan Kangas Date: Tue Oct 24 09:37:21 2023 +0200 ; Fix broken links to gmane.org diff --git a/ChangeLog.2 b/ChangeLog.2 index 11e6049b0bd..d40401093c5 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -10661,8 +10661,8 @@ * lisp/gnus/nnir.el (nnir-request-update-mark): Default to the original mark. - cf. - and + cf. [dead link] + and [dead link] 2016-01-19 Glenn Morris @@ -12012,7 +12012,7 @@ (Maybe this is the last merge from Gnus git to Emacs git) Cf. discussion on ding mailing list, messages in - . + . [dead link] Common code from the three files mml-smime.el, mml1991.el, and mml2015.el is moved to mml-sec.el. Auxiliary functions are added to gnus-util.el. @@ -15206,8 +15206,9 @@ Remove nnml-retrieve-groups that is unnecessary and somewhat problematic * lisp/gnus/nnml.el (nnml-retrieve-groups): Remove. See: - and - + [dead link] + and + [dead link] 2015-11-25 Paul Eggert @@ -30968,7 +30969,7 @@ 2015-05-28 Katsumi Yamaoka * lisp/gnus/gnus-art.el (gnus-button-alist): Re-revert last change. - cf. + cf. [dead link] 2015-05-28 Samer Masterson diff --git a/ChangeLog.3 b/ChangeLog.3 index 85cccf0d6ed..4401dd10920 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -234791,7 +234791,7 @@ (Maybe this is the last merge from Gnus git to Emacs git) Cf. discussion on ding mailing list, messages in - . + . [dead link] Common code from the three files mml-smime.el, mml1991.el, and mml2015.el is moved to mml-sec.el. Auxiliary functions are added to gnus-util.el. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index d8136baacba..9c7ce4be216 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -25338,7 +25338,7 @@ Gmane Spam Reporting articles groups will be reported to the Gmane administrators via a HTTP request. -Gmane was formerly found at @uref{http://gmane.org}. +Gmane is at @uref{https://gmane.io}. @emph{WARNING} @@ -28805,7 +28805,7 @@ No Gnus different Emacs versions, you may set @code{mm-auto-save-coding-system} to @code{emacs-mule}. @c FIXME: Untested. (Or did anyone test it?) -@c Cf. http://thread.gmane.org/gmane.emacs.gnus.general/66251/focus=66344 +@c Cf. http://thread.gmane.org/gmane.emacs.gnus.general/66251/focus=66344 [dead link] @item Lisp files are now installed in @file{.../site-lisp/gnus/} by default. It defaulted to @file{.../site-lisp/} formerly. In addition to this, diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index 9bc440626dc..88d3a41461c 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -6789,8 +6789,8 @@ 2006-09-04 Daiki Ueno * pgg-gpg.el (pgg-gpg-process-region): Revert two patches from Satyaki - Das. http://article.gmane.org/gmane.emacs.gnus.general/49947 - http://article.gmane.org/gmane.emacs.gnus.general/50457 + Das. http://article.gmane.org/gmane.emacs.gnus.general/49947 [dead link] + http://article.gmane.org/gmane.emacs.gnus.general/50457 [dead link] 2006-09-03 Chong Yidong diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index 09bc4f6c4eb..bdf5948e748 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -15985,7 +15985,7 @@ (imap-message-copyuid-1): Use it. (imap-message-appenduid-1): Likewise. Based on patch by Nathan J. Williams in - . + . [dead link] 2008-04-02 Alan Mackenzie diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index af3203444ae..3c75ab8ce88 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -14019,7 +14019,7 @@ * font-lock.el (font-lock-refresh-defaults): New function, which can be used to let font-lock react to external changes in variables like font-lock-defaults and keywords. - See http://thread.gmane.org/gmane.emacs.devel/118777/focus=118802 + See http://thread.gmane.org/gmane.emacs.devel/118777/focus=118802 [dead link] 2009-12-28 Dan Nicolaescu diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index 6dda3703e6d..c898eb61d47 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -2573,7 +2573,7 @@ * progmodes/grep.el (rgrep): Escape command line. Sometimes, it is too long for Tramp. See discussion in - . + . [dead link] * progmodes/compile.el (compilation-start): Remove line escape template. diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index d0b195e5f13..0fc5c093371 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -578,7 +578,7 @@ * gnus-start.el (gnus-dribble-read-file): Don't stop the auto-saving of the dribble buffer even when it is shrunk a lot. - + [dead link] 2014-06-26 Glenn Morris diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index ce8220f3a6e..aee122aa557 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -61,12 +61,12 @@ ;; (define-key global-map "\C-crl" 'gnus-bookmark-bmenu-list) ;; FIXME: Add keybindings, see -;; http://thread.gmane.org/gmane.emacs.gnus.general/63101/focus=63379 -;; http://thread.gmane.org/v9fxx9fkm4.fsf@marauder.physik.uni-ulm.de +;; http://thread.gmane.org/gmane.emacs.gnus.general/63101/focus=63379 [dead link] +;; http://thread.gmane.org/v9fxx9fkm4.fsf@marauder.physik.uni-ulm.de [dead link] ;; FIXME: Check if `gnus-bookmark.el' should use ;; `bookmark-make-record-function'. -;; Cf. http://article.gmane.org/gmane.emacs.gnus.general/66076 +;; Cf. http://article.gmane.org/gmane.emacs.gnus.general/66076 [dead link] (defgroup gnus-bookmark nil "Setting, annotation and jumping to Gnus bookmarks." diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 0467907ec94..ac2596243b1 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1436,14 +1436,8 @@ gnus-number-of-unseen-articles-in-group ;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't ;; update the state (enabled/disabled) of the icon `gnus-group-describe-group' -;; automatically. After `C-l' the state is correct. See the following report -;; on emacs-devel -;; : -;; From: Reiner Steib -;; Subject: tool bar icons not updated according to :active condition -;; Newsgroups: gmane.emacs.devel -;; Date: Mon, 23 Jan 2006 19:59:13 +0100 -;; Message-ID: +;; automatically. After `C-l' the state is correct. +;; See: https://lists.gnu.org/r/emacs-devel/2006-01/msg00853.html ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might ;; be confusing, so maybe we shouldn't call it by default. @@ -2336,7 +2330,7 @@ gnus-read-ephemeral-gmane-group-url (cond ;; URLs providing `group', `start' and `range': ((string-match - ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525 + ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525 [dead link] "^http://thread\\.gmane\\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$" url) (setq group (match-string 1 url) @@ -2347,7 +2341,7 @@ gnus-read-ephemeral-gmane-group-url start -1))) ;; URLs providing `group' and `start': ((or (string-match - ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584 + ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584 [dead link] "^http://\\(?:thread\\|article\\|permalink\\)\\.gmane\\.org/\\([^/]+\\)/\\([0-9]+\\)" url) (string-match @@ -2355,7 +2349,7 @@ gnus-read-ephemeral-gmane-group-url "^\\(?:nntp\\|news\\)://news\\.gmane\\.org/\\([^/]+\\)/\\([0-9]+\\)" url) (string-match - ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t + ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t [dead link] "^http://news\\.gmane\\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)" url)) (setq group (match-string 1 url) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index b8dd61de3b9..eb5ce7b141c 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -148,8 +148,8 @@ mml2015-extract-cleartext-signature ;; ;; This function doesn't handle NotDashEscaped correctly. EasyPG handles it ;; correctly. - ;; http://thread.gmane.org/gmane.emacs.gnus.general/66062/focus=66082 - ;; http://thread.gmane.org/gmane.emacs.gnus.general/65087/focus=65109 + ;; http://thread.gmane.org/gmane.emacs.gnus.general/66062/focus=66082 [dead link] + ;; http://thread.gmane.org/gmane.emacs.gnus.general/65087/focus=65109 [dead link] (goto-char (point-min)) (forward-line) ;; We need to be careful not to strip beyond the armor headers. diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index cdba6e663bf..5dc5bf1fd75 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -85,7 +85,7 @@ nnheader-head-chop-length (defvar nnheader-read-timeout (if (memq system-type '(windows-nt cygwin)) - ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de + ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de [dead link] ;; ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS. ;; diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 39513b8f602..d59a314c26e 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -240,7 +240,7 @@ browse-url-button-regexp (concat "\\(?:" ;; Match paired parentheses, e.g. in Wikipedia URLs: - ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com + ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com [dead link] "[" chars punct "]+" "(" "[" chars punct "]+" ")" "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?" "\\|" diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index f45490ef6c3..6fd59ed3f93 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -768,7 +768,7 @@ inferior-octave-mode (setq-local comint-prompt-read-only inferior-octave-prompt-read-only) (add-hook 'comint-input-filter-functions 'inferior-octave-directory-tracker nil t) - ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 + ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 [dead link] (add-hook 'window-configuration-change-hook 'inferior-octave-track-window-width-change nil t) (setq-local compilation-error-regexp-alist inferior-octave-error-regexp-alist) @@ -1007,7 +1007,7 @@ inferior-octave-minimal-columns (defvar inferior-octave-last-column-width nil) (defun inferior-octave-track-window-width-change () - ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 + ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 [dead link] (let ((width (max inferior-octave-minimal-columns (window-width)))) (unless (eq inferior-octave-last-column-width width) (setq-local inferior-octave-last-column-width width) diff --git a/nextstep/ChangeLog.1 b/nextstep/ChangeLog.1 index 26def2266fe..cd6bfbfbbbe 100644 --- a/nextstep/ChangeLog.1 +++ b/nextstep/ChangeLog.1 @@ -6,7 +6,7 @@ * Makefile.in (links): New phony target to create a fake installation pointing back to the source tree to run GUI Emacs - in-place (http://article.gmane.org/gmane.emacs.devel:178330). + in-place (http://article.gmane.org/gmane.emacs.devel:178330). [dead link] 2014-11-22 Glenn Morris diff --git a/src/w32.c b/src/w32.c index a6bc0f4b2ee..da4c7df340e 100644 --- a/src/w32.c +++ b/src/w32.c @@ -9387,7 +9387,7 @@ sys_write (int fd, const void * buffer, unsigned int count) break them into smaller chunks. See the Comments section of the MSDN documentation of WriteFile for details behind the choice of the value of CHUNK below. See also the thread - http://thread.gmane.org/gmane.comp.version-control.git/145294 + http://thread.gmane.org/gmane.comp.version-control.git/145294 [dead link] in the git mailing list. */ const unsigned char *p = buffer; const bool is_pipe = (fd < MAXDESC commit 9e9bc2af51485f6a9ce9a37d504249af14ab909d Author: Po Lu Date: Tue Oct 24 07:32:25 2023 +0000 Correct documentation of selection-coding-system * doc/lispref/frames.texi (Window System Selections): Don't assert that selection-coding-system functions everywhere or that its default value is always utf-16le-dos. (Drag and Drop): Fix a typo. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 9f969603023..56e4fe419e3 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4053,10 +4053,20 @@ Window System Selections @end defun @defopt selection-coding-system -This variable specifies the coding system to use when reading and -writing selections or the clipboard. @xref{Coding -Systems}. The default is @code{compound-text-with-extensions}, which -converts to the text representation that X11 normally uses. +This variable provides a coding system (@pxref{Coding Systems}) which +is used to encode selection data, and takes effect on MS-DOS, +MS-Windows and X@. + +Under MS-DOS and MS-Windows, it is the coding system by which all +clipboard text will be encoded and decoded, whereas on X it merely +supplies the EOL format of the selection text sent in response to a +request for text encoded by a matching coding system; which is to say +that if its value is @code{utf-8-dos}, it will influence requests for +@code{UTF8_STRING} data, but not those for @code{STRING}. + +Its default value is the system code page under MS-Windows 95, 98 or +Me, @code{utf-16le-dos} under NT/W2K/XP, @code{iso-latin-1-dos} on +MS-DOS, and @code{nil} elsewhere. @end defopt For backward compatibility, there are obsolete aliases @@ -4810,10 +4820,10 @@ Drag and Drop @cindex direct save protocol @vindex x-dnd-direct-save-function The X Direct Save (@acronym{XDS}) protocol enables programs to -devolve responsibility for naming a dropped file file upon the -recipient. When such a drop transpires, DND handlers and the -foregoing X-specific interface are largely circumvented, tasking a -different function with responding to the drop. +devolve responsibility for naming a dropped file upon the recipient. +When such a drop transpires, DND handlers and the foregoing X-specific +interface are largely circumvented, tasking a different function with +responding to the drop. @defvar x-dnd-direct-save-function This variable should be set to a function that registers and names commit 30abe63c4d65851bbfdc659146c01ce6a43e8792 Author: Po Lu Date: Tue Oct 24 06:27:48 2023 +0000 * doc/lispref/frames.texi (Drag and Drop): Fix typo. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 99493b59d71..9f969603023 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4811,9 +4811,9 @@ Drag and Drop @vindex x-dnd-direct-save-function The X Direct Save (@acronym{XDS}) protocol enables programs to devolve responsibility for naming a dropped file file upon the -recipient. When such a drop transpires, DND handlers and the forgoing -X-specific interface are largely circumvented, tasking a different -function with responding to the drop. +recipient. When such a drop transpires, DND handlers and the +foregoing X-specific interface are largely circumvented, tasking a +different function with responding to the drop. @defvar x-dnd-direct-save-function This variable should be set to a function that registers and names commit bcdfd7b091cc71dd75b6e91a55c2813f895fb4ef Author: Po Lu Date: Tue Oct 24 05:37:24 2023 +0000 Rewrite all sections of the drag-and-drop documentation * doc/lispref/frames.texi (Other Selections): Correct punctuation in one paragraph. (Drag and Drop): Rewrite last two sections for clarity. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 5e2fdf1231c..99493b59d71 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4589,7 +4589,7 @@ Other Selections @w{@code{(@var{key} @var{type} @var{value})}}. In this list, @var{key} must be the name of the data being transferred, generally that of a MIME type, for example @samp{"text/plain"}, and @var{type} -is a symbol or a number designating the type of the data, thus also +is a symbol or a number designating the type of the data; thus also governing the interpretation of @var{value}; following is a list of valid data types and how each of them will cause @var{value} to be interpreted. @@ -4809,16 +4809,17 @@ Drag and Drop @cindex XDS @cindex direct save protocol @vindex x-dnd-direct-save-function - When Emacs runs on the X window system, it supports the X Direct -Save (@acronym{XDS}) protocol, which allows users to save a file by -dragging and dropping it onto an Emacs window, such as a Dired window. -To comply with the unique requirements of @acronym{XDS}, these -drag-and-drop requests are processed specially: instead of being -handled according to @code{x-dnd-types-alist}, they are handled by the -@dfn{direct-save function} that is the value of the variable -@code{x-dnd-direct-save-function}. The value should be a function of -two arguments, @var{need-name} and @var{filename}. The @acronym{XDS} -protocol uses a two-step procedure for dragging files: + The X Direct Save (@acronym{XDS}) protocol enables programs to +devolve responsibility for naming a dropped file file upon the +recipient. When such a drop transpires, DND handlers and the forgoing +X-specific interface are largely circumvented, tasking a different +function with responding to the drop. + +@defvar x-dnd-direct-save-function +This variable should be set to a function that registers and names +files dropped using the @acronym{XDS} protocol in a two-step +procedure. It is provided two arguments, @var{need-name} and +@var{filename}. @enumerate 1 @item @@ -4846,8 +4847,9 @@ Drag and Drop there. @end enumerate -The default value of @code{x-dnd-direct-save-function} is +Its default @code{x-dnd-direct-save-function} is @code{x-dnd-save-direct}. +@end defvar @defun x-dnd-save-direct need-name filename When called with the @var{need-name} argument non-@code{nil}, this @@ -4873,48 +4875,47 @@ Drag and Drop @end defun @cindex initiating drag-and-drop - On capable window systems, Emacs also supports dragging contents -from its frames to windows of other applications. + It is also possible to drag content from Emacs to other programs +whenever this is supported for the current window-system. The +functions which provide for this are as follows: @cindex drop target, in drag-and-drop operations @defun dnd-begin-text-drag text &optional frame action allow-same-frame -This function begins dragging text from @var{frame} to another program -(known as the @dfn{drop target}), and returns the result of -drag-and-drop operation when the text is dropped or the drag-and-drop -operation is canceled. @var{text} is the text that will be inserted -by the drop target. +This function commences a drag-and-drop operation from @var{frame} to +another program (dubbed the @dfn{drop target}), and returns when +@var{text} is dropped or the operation is canceled. @var{action} must be one of the symbols @code{copy} or @code{move}, where @code{copy} means that @var{text} should be inserted by the drop -target, and @code{move} means the same as @code{copy}, but in addition -the caller may have to delete @var{text} from its source as explained -below. +target, and @code{move} means the same as @code{copy}, but furthermore +enjoins the caller to delete @var{text} from its source as explained +in the list below. @var{frame} is the frame where the mouse is currently held down, or -@code{nil}, which means to use the selected frame. This function may -return immediately if no mouse buttons are held down, so it should be -only called immediately after a @code{down-mouse-1} or similar event -(@pxref{Mouse Events}), with @var{frame} set to the frame where that -event was generated (@pxref{Click Events}). +@code{nil}, which means to use the selected frame. Since this +function is liable to return promptly if no mouse buttons are held +down, it should be only called in response to a @code{down-mouse-1} or +analogous event (@pxref{Mouse Events}), with @var{frame} set to the +frame where that event was generated (@pxref{Click Events}). -@var{allow-same-frame} specifies whether or not drops on top of -@var{frame} itself are to be ignored. +If @var{allow-same-frame} is @code{nil}, drops on top of @var{frame} +will be disregarded. -The return value specifies the action that the drop target actually -performed, and optionally what the caller should do. It can be one of -the following symbols: +The return value reflects the action that the drop target actually +performed, and thus also what action, if any, the caller should in +turn take. It is one of the following symbols: @table @code @item copy The drop target inserted the dropped text. @item move -The drop target inserted the dropped text, but in addition the caller -should delete @var{text} from wherever it originated, such as its -buffer. +The drop target inserted the dropped text, and the caller should +delete @var{text} from the buffer where it was extracted from, if +applicable. @item private -The drop target performed some other unspecified action. +The drop target took some other unspecified action. @item nil The drag-and-drop operation was canceled. @@ -4923,11 +4924,12 @@ Drag and Drop @end defun @defun dnd-begin-file-drag file &optional frame action allow-same-frame -This function begins dragging @var{file} from @var{frame} to another -program, and returns the result of the drag-and-drop operation when -the file is dropped or the drag-and-drop operation is canceled. +This function commences a drag-and-drop operation from @var{frame} to +another program (dubbed the @dfn{drop target}), and returns when +@var{file} is dropped or the operation is canceled. -If @var{file} is a remote file, then a temporary copy will be made. +If @var{file} is a remote file, then a temporary local copy will be +made. @var{action} must be one of the symbols @code{copy}, @code{move} or @code{link}, where @code{copy} means that @var{file} should be opened @@ -4936,11 +4938,11 @@ Drag and Drop target should create a symbolic link to @var{file}. It is an error to specify @code{link} as the action if @var{file} is a remote file. -@var{frame} and @var{allow-same-frame} have the same meaning as in -@code{dnd-begin-text-drag}. +@var{frame} and @var{allow-same-frame} mean the same as they do in +calls to @code{dnd-begin-text-drag}. The return value is the action that the drop target actually -performed, which can be one of the following symbols: +performed, which is one of the following symbols: @table @code @item copy @@ -4969,19 +4971,18 @@ Drag and Drop @end defun @defun dnd-direct-save file name &optional frame allow-same-frame -This function is similar to @code{dnd-begin-file-drag} (with the -default action of copy), but instead of specifying the action you -specify the name of the copy created by the target program in -@code{name}. +The behavior of this function is akin to that of +@code{dnd-begin-file-drag} (when the default action @code{copy} is +used), except that it accepts a name under which the copy is meant to +be filed. @end defun @cindex initiating drag-and-drop, low-level The high-level interfaces described above are implemented on top of -a lower-level primitive. If you need to drag content other than files -or text, use the low-level interface @code{x-begin-drag} -instead. However, using it will require detailed knowledge of the -data types and actions used by the programs to transfer content via -drag-and-drop on each platform you want to support. +a lower-level primitive. The low-level interface @code{x-begin-drag} +is also available for dragging content besides text and files. It +demands detailed knowledge of the data types and actions understood by +programs on each platform its callers wish to support. @defun x-begin-drag targets &optional action frame return-frame allow-current-frame follow-tooltip This function begins a drag from @var{frame}, and returns when the @@ -4993,60 +4994,59 @@ Drag and Drop drag-and-drop operation begins, this function may immediately return @code{nil}. -@var{targets} is a list of strings describing selection targets, much -like the @var{data-type} argument to @code{gui-get-selection}, that -the drop target can request from Emacs (@pxref{Window System +@var{targets} is a list of strings representing selection targets, +much like the @var{data-type} argument to @code{gui-get-selection}, +that the drop target can request from Emacs (@pxref{Window System Selections}). -@var{action} is a symbol describing the action recommended to the -target. It can either be @code{XdndActionCopy}, which -means to copy the contents of the selection @code{XdndSelection} to -the drop target; or @code{XdndActionMove}, which means copy as with -@code{XdndActionCopy}, and in addition the caller should delete -whatever was stored in that selection after copying it. +@var{action} is a symbol designating the action recommended to the +target. It can either be @code{XdndActionCopy} or +@code{XdndActionMove}; both imply copying the contents of the +selection @code{XdndSelection} to the drop target, but the latter +moreover conveys a promise to delete the contents of the selection +after the copying. @var{action} may also be an alist which associates between symbols -describing the available actions, and strings that the drop target is -expected to present to the user to choose between the available -actions. +representing available actions, and strings that the drop target +presents to the user for him to select between those actions. If @var{return-frame} is non-@code{nil} and the mouse moves over an Emacs frame after first moving out of @var{frame}, then the frame to which the mouse moves will be returned immediately. If -@var{return-frame} is the symbol @code{now}, then any frame underneath +@var{return-frame} is the symbol @code{now}, then any frame beneath the mouse pointer will be returned without waiting for the mouse to first move out of @var{frame}. @var{return-frame} is useful when you want to treat dragging content from one frame to another specially, -while also being able to drag content to other programs, but it is not -guaranteed to work on all systems and with all window managers. +while also dragging content to other programs, but it is not +guaranteed to function on all systems and with all window managers. If @var{follow-tooltip} is non-@code{nil}, the position of any tooltip -(such as one shown by @code{tooltip-show}) will follow the location of -the mouse pointer whenever it moves during the drag-and-drop +(such as one displayed by @code{tooltip-show}) will follow the +location of the mouse pointer as it moves during the drag-and-drop operation. The tooltip will be hidden once all mouse buttons are released. If the drop was rejected or no drop target was found, this function -returns @code{nil}. Otherwise, it returns a symbol describing the -action the target chose to perform, which can differ from @var{action} -if that isn't supported by the drop target. @code{XdndActionPrivate} -is also a valid return value in addition to @code{XdndActionCopy} and -@code{XdndActionMove}; it means that the drop target chose to perform -an unspecified action, and no further processing is required by the -caller. - -The caller must cooperate with the target to fully perform the action -chosen by the target. For example, callers should delete the buffer -text that was dragged if this function returns @code{XdndActionMove}. +returns @code{nil}. Otherwise, it returns a symbol representing the +action the target opted to take, which can differ from @var{action} if +that isn't supported by the drop target. @code{XdndActionPrivate} is +also a valid return value in addition to @code{XdndActionCopy} and +@code{XdndActionMove}; it suggests that the drop target opted for an +indeterminate action, and no further action is required of the caller. + +The caller must cooperate with the target to complete the action +selected by the target. For example, callers should delete any buffer +text that was dragged if this function returns @code{XdndActionMove}, +and likewise for other drag data where comparable criteria apply. @end defun @cindex drag and drop protocols, X - On X Windows, several different drag-and-drop protocols are -supported by @code{x-begin-drag}. When dragging content that is known -to not be supported by a specific drag-and-drop protocol, it might be -desirable to turn that protocol off, by changing the values of the -following variables: + The function @code{x-begin-drag} leverages several drag-and-drop +protocols ``behind the scenes''. When dragging content that is known +to not be supported by a specific drag-and-drop protocol, that +protocol can be disabled by changing the values of the following +variables: @defvar x-dnd-disable-motif-protocol When this is non-@code{nil}, the Motif drag and drop protocols are @@ -5070,8 +5070,8 @@ Drag and Drop doesn't support any drag-and-drop protocol at all. A side effect is that Emacs will become the owner of the primary -selection upon such a drop. If that is not desired, then the drop -emulation can be disabled by setting this variable to @code{nil}. +selection upon such a drop. Such emulation can be disabled by setting +this variable to @code{nil}. @end defvar @node Color Names commit eea7214113b14f5b34ed7cfae0365c7509e5d5ac Author: Po Lu Date: Tue Oct 24 03:04:51 2023 +0000 Rewrite first two sections of the drag-and-drop documentation * doc/lispref/frames.texi (Accessing Selections): Refine wording. (Drag and Drop): Rewrite for clarity and enter into detail upon various function arguments. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index d840f281849..5e2fdf1231c 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4076,12 +4076,12 @@ Accessing Selections system-specific code to be rendered suitable for transfer to the window system or requesting clients. - The most comprehensive implementation of selections is that under -the X Window System. This is both an artifact of history (X was the -first window system supported by Emacs) and one occasioned by -technical considerations: X selections are not merely an expedient for -the transfer of text and multimedia content between clients, but a -general inter-client communication system, a design that has yielded a + The most comprehensive implementation of selections exists under the +X Window System. This is both an artifact of history (X was the first +window system supported by Emacs) and one occasioned by technical +considerations: X selections are not merely an expedient for the +transfer of text and multimedia content between clients, but a general +inter-client communication system, a design that has yielded a proliferation of selection and data types. Compounding this confusion, there is another inter-client @@ -4705,74 +4705,112 @@ Drag and Drop @section Drag and Drop @cindex drag and drop - When the user drops something from another application over Emacs, -Emacs will try to insert any text and open any URL that was dropped. -If text was dropped, then it will always be inserted at the location -of the mouse pointer where the drop happened, or saved in the kill -ring if insertion failed, which could happen if the buffer was -read-only. If a URL was dropped instead, then Emacs will first try to -call an appropriate handler function by matching the URL against -regexps defined in the variable @code{dnd-protocol-alist}, and then -against those defined in the variables @code{browse-url-handlers} and -@code{browse-url-default-handlers}. Should no suitable handler be -located, Emacs will fall back to inserting the URL as plain text. + Data transferred by drag and drop is generally either plain text or +a URL designating a file or another resource. When text is dropped, +it is inserted at the location of the drop, with recourse to saving it +into the kill ring if that is not possible. + + URLs dropped are supplied to pertinent @dfn{DND handler functions} +in the variable @code{dnd-protocol-alist}, or alternatively ``URL +handlers'' as set forth by the variables @code{browse-url-handlers} +and @code{browse-url-default-handlers}; absent matching handlers of +either type, they are treated as plain text and inserted in the +buffer. @defvar dnd-protocol-alist - This variable is a list of cons cells of the form -@w{@code{(@var{pattern} . @var{action})}}. @var{pattern} is a regexp -that URLs are matched against after being dropped. @var{action} is a -function that is called with two arguments, should a URL being dropped -match @var{pattern}: the URL being dropped, and the action being -performed for the drop, which is one of the symbols @code{copy}, -@code{move}, @code{link}, @code{private} or @code{ask}. - -If @var{action} is @var{private}, then it means the program that -initiated the drop wants Emacs to perform an unspecified action with -the URL; a reasonable action to perform in that case is to open the URL -or copy its contents into the current buffer. Otherwise, @var{action} -has the same meaning as the @var{action} argument to +This variable is an alist between regexps against which URLs are +matched and DND handler functions called on the dropping of matching +URLs. + +Each handler function is called with the URL that matched it and one +of the symbols @code{copy}, @code{move}, @code{link}, @code{private} +or @code{ask} identifying the action to be taken. + +If @var{action} is @code{private}, the program that initiated the drop +does not insist on any particular behavior on the part of its +recipient; a reasonable action to take in that case is to open the URL +or copy its contents into the current buffer. The other values of +@var{action} imply much the same as in the @var{action} argument to @code{dnd-begin-file-drag}. @end defvar @cindex drag and drop, X @cindex drag and drop, other formats - Emacs implements receiving text and URLs individually for each -window system, and does not by default support receiving other kinds -of data as drops. To support receiving other kinds of data, use the -X-specific interface described below. - -@vindex x-dnd-test-function -@vindex x-dnd-known-types - When a user drags something from another application over Emacs -under the X Window System, that other application expects Emacs to -tell it if Emacs understands the data being dragged. The function in -the variable @code{x-dnd-test-function} is called by Emacs to -determine what to reply to any such inquiry. The default value is -@code{x-dnd-default-test-function}, which accepts drops if the type of -the data to be dropped is present in @code{x-dnd-known-types}. -Changing the variables @code{x-dnd-test-function} and -@code{x-dnd-known-types} can make Emacs accept or reject drops based -on some other criteria. - -@vindex x-dnd-types-alist - If you want to change the way Emacs receives drops of different data -types, or you want to enable it to understand a new type, change the variable -@code{x-dnd-types-alist}. Doing so correctly requires detailed -knowledge of what data types other applications use for drag and drop. - - These data types are typically implemented as special data types -that can be obtained from an X selection provided by the other -application. In most cases, they are either the same data types that -are typically accepted by @code{gui-set-selection}, or MIME types, -depending on the specific drag-and-drop protocol being used. For -example, the data type used for plain text may be either -@code{"STRING"} or @code{"text/plain"}. + Emacs does not take measures to accept data besides text and URLs by +default, for the window system interfaces which enable this are too +far removed from each other to abstract over consistently. Nor are +DND handlers accorded the capacity to influence the action they are +meant to take, as particular drag-and-drop protocols deny recipients +such control. The X11 drag-and-drop implementation rests on several +underlying protocols that make use of selection transfer and share +much in common, to which low level access is provided through the +following functions and variables: + +@defvar x-dnd-test-function +This function is called to ascertain whether Emacs should accept a +drop. It is called with three arguments: + +@itemize @bullet +@item +The window under the item being dragged, which is to say the window +whose buffer is to receive the drop. If the item is situated over a +non-window component of a frame (such as scroll bars, tool bars and +things to that effect), the frame itself is provided in its place. + +@item +One of the symbols @code{move}, @code{copy}, @code{link} or +@code{ask}, representing an action to take on the item data suggested +by the drop source. These symbols carry the same implications as in +@code{x-begin-drag}. + +@item +A vector of selection data types (@pxref{X Selections}) the item +provides. +@end itemize + +This function must return @code{nil} to reject the drop or a cons of +the action that will be taken (such as through transfer to a DND +handler function) and the selection data type to be requested. The +action returned in that cons may also be the symbol @code{private}, +which intimates that the action taken is as yet indeterminate. +@end defvar + +@defvar x-dnd-known-types +Modifying @code{x-dnd-test-function} is generally unwarranted, for its +default set of criteria for accepting a drop can be adjusted by +changing this list of selection data types. Each element is a string, +which if found as the symbol name of an element within the list of +data types by the default ``test function'', will induce that function +to accept the drop. + +Introducing a new entry into this list is not useful unless a +counterpart handler function is appended to @code{x-dnd-types-alist}. +@end defvar + +@defvar x-dnd-types-alist +This variable is an alist between strings designating selection data +types and functions which are called when things of such types are +dropped. + +Each such function is supplied three arguments; the first is the +window or frame below the location of the drop, as in +@code{x-dnd-test-function}; the second is the action to be taken, +which may be any of the actions returned by test functions, and third +is the selection data itself (@pxref{Accessing Selections}). +@end defvar + + Selection data types as provided by X11 drag-and-drop protocols are +sometimes distinct from those provided by the ICCCM and conforming +clipboard or primary selection owners. Frequently, the name of a MIME +type, such as @code{"text/plain;charset=utf-8"} (with discrepant +capitalization of the ``utf-8''), is substitued for a standard X +selection name such as @code{UTF8_STRING}. @cindex XDS @cindex direct save protocol @vindex x-dnd-direct-save-function - When Emacs runs on X window system, it supports the X Direct Save -(@acronym{XDS}) protocol, which allows users to save a file by + When Emacs runs on the X window system, it supports the X Direct +Save (@acronym{XDS}) protocol, which allows users to save a file by dragging and dropping it onto an Emacs window, such as a Dired window. To comply with the unique requirements of @acronym{XDS}, these drag-and-drop requests are processed specially: instead of being commit b376580e975b311390308e49a2b4c951ff6a7574 Author: Stefan Kangas Date: Tue Oct 24 01:01:07 2023 +0200 Prefer HTTPS to HTTP in thing-at-point * lisp/thingatpt.el (thing-at-point-url-at-point): Prefer HTTPS to HTTP. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 72acb0b749f..5d4f4df9131 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -565,9 +565,9 @@ thing-at-point-url-at-point ;; If it looks like ftp.example.com. treat it as ftp. (if (string-match "\\`ftp\\." str) (setq str (concat "ftp://" str))) - ;; If it looks like www.example.com. treat it as http. + ;; If it looks like www.example.com. treat it as https. (if (string-match "\\`www\\." str) - (setq str (concat "http://" str))) + (setq str (concat "https://" str))) ;; Otherwise, it just isn't a URI. (setq str nil))) str))) commit ad47beb8231524457fb9415a823db7c224793839 Author: Stefan Kangas Date: Tue Oct 24 00:21:20 2023 +0200 Remove gmane.org support from nnweb * lisp/gnus/nnweb.el (nnweb-type, nnweb-type-definition): Remove gmane. (nnweb-gmane-create-mapping, nnweb-gmane-wash-article) (nnweb-gmane-search, nnweb-gmane-identity): Make obsolete. (nnweb-definition, nnweb-init): Raise user-error when 'nnweb-type' is 'gmane'. * doc/misc/gnus.texi (Registry Article Refer Method): Update example to not use gmane.org. Ref: https://gmane.io/ diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 8a50f064326..4b1ef5c27b4 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26434,12 +26434,12 @@ Registry Article Refer Method (setq gnus-refer-article-method '(current (nnregistry) - (nnweb "gmane" (nnweb-type gmane)))) + (nnweb "google" (nnweb-type google)))) @end example The example above instructs Gnus to first look up the article in the current group, or, alternatively, using the registry, and finally, if -all else fails, using Gmane. +all else fails, using Google. @node Fancy splitting to parent @subsection Fancy splitting to parent diff --git a/etc/NEWS b/etc/NEWS index d0880669752..8becfae7bb9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -732,6 +732,13 @@ interactive Python interpreter specified by 'python-interpreter'. *** New ':vc' keyword. This keyword enables the user to install packages using 'package-vc'. +** Gnus + +*** The 'nnweb-type' option 'gmane' has been removed. +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 the 'gmane'. + ** Rmail --- diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 779ec911682..f175379f53d 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -42,7 +42,7 @@ nnweb-directory (defvoo nnweb-type 'google "What search engine type is being used. -Valid types include `google', `dejanews', and `gmane'.") +Valid types include `google' and `dejanews'.") (defvar nnweb-type-definition '((google @@ -55,6 +55,7 @@ nnweb-type-definition (address . "https://groups.google.com/groups") (base . "https://groups.google.com") (identifier . nnweb-google-identity)) + ;; FIXME: Make obsolete? (dejanews ;; alias of google (id . "https://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") (result . "https://groups.google.com/group/%s/msg/%s?dmode=source") @@ -64,15 +65,7 @@ nnweb-type-definition (search . nnweb-google-search) (address . "https://groups.google.com/groups") (base . "https://groups.google.com") - (identifier . nnweb-google-identity)) - (gmane - (article . nnweb-gmane-wash-article) - (id . "http://gmane.org/view.php?group=%s") - (reference . identity) - (map . nnweb-gmane-create-mapping) - (search . nnweb-gmane-search) - (address . "http://search.gmane.org/nov.php") - (identifier . nnweb-gmane-identity))) + (identifier . nnweb-google-identity))) "Type-definition alist.") (defvoo nnweb-search nil @@ -254,6 +247,8 @@ nnweb-read-active (defun nnweb-definition (type &optional noerror) "Return the definition of TYPE." + (when (eq nnweb-type 'gmane) + (user-error "`gmane' is no longer a valid value for `nnweb-type'")) (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition))))) (when (and (not def) (not noerror)) @@ -277,6 +272,8 @@ nnweb-init (unless (gnus-buffer-live-p nnweb-buffer) (setq nnweb-buffer (save-current-buffer + (when (eq nnweb-type 'gmane) + (user-error "`gmane' is no longer a valid value for `nnweb-type'")) (nnheader-set-temp-buffer (format " *nnweb %s %s %s*" nnweb-type nnweb-search server)) @@ -437,10 +434,11 @@ nnweb-google-identity url)) ;;; -;;; gmane.org +;;; gmane.org -- now obsolete as the gmane.org web interface is gone ;;; (defun nnweb-gmane-create-mapping () "Perform the search and create a number-to-url alist." + (declare (obsolete nil "30.1")) (with-current-buffer nnweb-buffer (let ((case-fold-search t) (active (or (cadr (assoc nnweb-group nnweb-group-alist)) @@ -484,6 +482,7 @@ nnweb-gmane-create-mapping (sort (nconc nnweb-articles map) #'car-less-than-car))))) (defun nnweb-gmane-wash-article () + (declare (obsolete nil "30.1")) (let ((case-fold-search t)) (goto-char (point-min)) (when (search-forward "" nil t) @@ -495,6 +494,7 @@ nnweb-gmane-wash-article (mm-url-remove-markup)))) (defun nnweb-gmane-search (search) + (declare (obsolete nil "30.1")) (mm-url-insert (concat (nnweb-definition 'address) @@ -511,6 +511,7 @@ nnweb-gmane-search (defun nnweb-gmane-identity (url) "Return a unique identifier based on URL." + (declare (obsolete nil "30.1")) (if (string-match "group=\\(.+\\)" url) (match-string 1 url) url)) commit cc3e436c822343f72f3ede6b638e1b68cd434583 Author: Stefan Kangas Date: Tue Oct 24 00:37:23 2023 +0200 Change news.gmane.org to news.gmane.io * admin/notes/emba: * doc/misc/gnus.texi (Group Parameters) (Non-ASCII Group Names, Filling In Threads) (Selection Groups, Spam Package Configuration Examples) (Terminology): * lisp/gnus/gnus-group.el (gnus-useful-groups): * lisp/gnus/gnus-sum.el (gnus-fetch-old-headers): * lisp/gnus/spam-report.el (spam-report-gmane-use-article-number) (spam-report-gmane-internal): * test/lisp/gnus/gnus-group-tests.el (gnus-short-group-name): Change news.gmane.org to news.gmane.io. Ref: https://news.gmane.io/ diff --git a/admin/notes/emba b/admin/notes/emba index 564cc3c54ac..6970279d3af 100644 --- a/admin/notes/emba +++ b/admin/notes/emba @@ -21,7 +21,7 @@ If you want to receive these notifications, please subscribe at . Alternatively, these notifications can be read via gmane at -. +. The messages contain a URL to the log file of the failed job, like . diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 216bbed4966..d8136baacba 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -3372,7 +3372,7 @@ Group Parameters group by reverse date to see the latest news at the top and an @acronym{RSS} group by subject. In this example, the first group is the Debian daily news group @code{gmane.linux.debian.user.news} from -news.gmane.org. The @acronym{RSS} group corresponds to the Debian +news.gmane.io. The @acronym{RSS} group corresponds to the Debian weekly news RSS feed @url{https://packages.debian.org/unstable/newpkg_main.en.rdf}, @xref{RSS}. @@ -4426,7 +4426,7 @@ Non-ASCII Group Names @lisp (nntp "gmane" - (nntp-address "news.gmane.org") + (nntp-address "news.gmane.io") (nntp-end-of-line "\n") (nntp-open-connection-function nntp-open-via-rlogin-and-telnet) @@ -7279,7 +7279,7 @@ Filling In Threads @cindex Gmane, @code{gnus-fetch-old-headers} This feature can seriously impact performance it ignores all locally cached header entries. Setting it to @code{t} for groups for a server -that doesn't expire articles (such as news.gmane.org), leads to very +that doesn't expire articles (such as news.gmane.io), leads to very slow summary generation. @item gnus-fetch-old-ephemeral-headers @@ -18017,7 +18017,7 @@ Selection Groups (nnselect-args . [["nnimap+work:mail" 595 100] ["nnimap+home:sent" 223 100] - ["nntp+news.gmane.org:gmane.emacs.gnus.general" 23666 100]])) + ["nntp+news.gmane.io:gmane.emacs.gnus.general" 23666 100]])) @end lisp The function is the identity and the argument is just the list of @@ -25152,9 +25152,9 @@ Spam Package Configuration Examples @end lisp Additionally, I use @code{(setq spam-report-gmane-use-article-number nil)} -because I don't read the groups directly from news.gmane.org, but +because I don't read the groups directly from news.gmane.io, but through my local news server (leafnode). I.e., the article numbers are -not the same as on news.gmane.org, thus @code{spam-report.el} has to check +not the same as on news.gmane.io, thus @code{spam-report.el} has to check the @code{X-Report-Spam} header to find the correct number. @node Spam Back Ends @@ -29318,13 +29318,13 @@ Terminology You can also have any number of foreign groups active at the same time. These are groups that use non-native non-secondary back ends for getting news. Foreign groups have names like -@samp{nntp+news.gmane.org:gmane.emacs.gnus.devel}. +@samp{nntp+news.gmane.io:gmane.emacs.gnus.devel}. @item secondary @cindex secondary Secondary back ends are somewhere half-way between being native and being foreign, but they mostly act like they are native, but they, too -have names like @samp{nntp+news.gmane.org:gmane.emacs.gnus.devel}. +have names like @samp{nntp+news.gmane.io:gmane.emacs.gnus.devel}. @item article @cindex article diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 070d1223e2c..0467907ec94 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -286,10 +286,10 @@ gnus-group-update-hook :type 'hook) (defcustom gnus-useful-groups - '(("(ding) mailing list mirrored at gmane.org" + '(("(ding) mailing list mirrored at gmane.io" "gmane.emacs.gnus.general" (nntp "Gmane" - (nntp-address "news.gmane.org"))) + (nntp-address "news.gmane.io"))) ("Gnus bug archive" "gnus.gnus-bug" (nntp "news.gnus.org" diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9992f46bbd5..3b25d3e2c07 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -120,7 +120,7 @@ gnus-fetch-old-headers This feature can seriously impact performance it ignores all locally cached header entries. Setting it to t for groups for a -server that doesn't expire articles (such as news.gmane.org), +server that doesn't expire articles (such as news.gmane.io), leads to very slow summary generation." :group 'gnus-thread :type '(choice (const :tag "off" nil) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 9f1ec7e3677..8435d2d0124 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -49,7 +49,7 @@ spam-report-gmane-use-article-number "Whether the article number (faster!) or the header should be used. You must set this to nil if you don't read Gmane groups directly -from news.gmane.org, e.g. when using local newsserver such as +from news.gmane.io, e.g. when using local newsserver such as leafnode." :type 'boolean) @@ -149,6 +149,8 @@ spam-report-gmane-internal (when (and gnus-newsgroup-name (or (null spam-report-gmane-regex) (string-match spam-report-gmane-regex gnus-newsgroup-name))) + ;; FIXME: These addresses are down. There is also no + ;; unspam.gmane.io or spam.gmane.io. (let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org"))) (gnus-message 6 "Reporting article %d to %s..." article rpt-host) (cond diff --git a/test/lisp/gnus/gnus-group-tests.el b/test/lisp/gnus/gnus-group-tests.el index e12f42711ea..3f5cbefc6ea 100644 --- a/test/lisp/gnus/gnus-group-tests.el +++ b/test/lisp/gnus/gnus-group-tests.el @@ -38,7 +38,7 @@ gnus-short-group-name ;; This is a very aggressive shortening of the left hand side. ("nnimap+email@banana.salesman.example.com:234" . "email@banana:234") ("nntp+some.where.edu:soc.motss" . "some:s.motss") - ("nntp+news.gmane.org:gmane.emacs.gnus.general" . "news:g.e.g.general") + ("nntp+news.gmane.io:gmane.emacs.gnus.general" . "news:g.e.g.general") ("nntp+news.gnus.org:gmane.text.docbook.apps" . "news:g.t.d.apps") ;; nnimap groups. commit 6f07ec1913dc2a1d5a0faa87d506f8fefb45ca35 Author: Stefan Kangas Date: Tue Oct 24 00:07:41 2023 +0200 ; Fix broken link diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 295ef2b3f4c..5ed4e46e0a5 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -725,7 +725,7 @@ xterm--report-background-handler ;; `tty-set-up-initial-frame-faces' only once, but that ;; caused the light background faces to be computed ;; incorrectly. See: - ;; http://permalink.gmane.org/gmane.emacs.devel/119627 + ;; https://lists.gnu.org/r/emacs-devel/2010-01/msg00439.html (when recompute-faces (tty-set-up-initial-frame-faces)))))) commit be9761bc5e47f7395174fd8837cc3abae8142b1f Author: Stefan Kangas Date: Mon Oct 23 23:59:29 2023 +0200 Prefer HTTPS to HTTP for Google Groups * lisp/gnus/nnweb.el (nnweb-type-definition): Prefer HTTPS to HTTP when accessing Google Groups. diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index d3bf138edeb..779ec911682 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -46,24 +46,24 @@ nnweb-type (defvar nnweb-type-definition '((google - (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") - (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") + (id . "https://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "https://groups.google.com/group/%s/msg/%s?dmode=source") (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) - (address . "http://groups.google.com/groups") - (base . "http://groups.google.com") + (address . "https://groups.google.com/groups") + (base . "https://groups.google.com") (identifier . nnweb-google-identity)) (dejanews ;; alias of google - (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") - (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") + (id . "https://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "https://groups.google.com/group/%s/msg/%s?dmode=source") (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) - (address . "http://groups.google.com/groups") - (base . "http://groups.google.com") + (address . "https://groups.google.com/groups") + (base . "https://groups.google.com") (identifier . nnweb-google-identity)) (gmane (article . nnweb-gmane-wash-article) commit 297fe945c57c33b51b890ea105d5f7c15a520bd0 Author: Mauro Aranda Date: Mon Oct 23 18:04:25 2023 -0300 Fix minor defcustom issues in Gnus (Bug#66715) * lisp/gnus/gnus-art.el (gnus-button-prefer-mid-or-mail): Allow function and add :tag to const values. * lisp/gnus/gnus-bookmark.el (gnus-bookmark-bookmark-inline-details): Fix docstring. * lisp/gnus/gnus-sum.el (gnus-simplify-subject-fuzzy-regexp): Allow a single regexp as value. * lisp/gnus/message.el (message-indent-citation-function): Allow a single function as value. (message-mail-alias-type): Allow for a list of options as value. (message-dont-reply-to-names): Allow a function as value. * lisp/gnus/spam-report.el (spam-report-url-ping-function): Fix default value for the function widget. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ce7a4488a7f..18f25b1c17a 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1622,7 +1622,8 @@ gnus-article-encrypt-protocol "The protocol used for encrypt articles. It is a string, such as \"PGP\". If nil, ask user." :version "22.1" - :type 'string + :type '(choice (const :tag "Ask me" nil) + string) :group 'mime-security) (defcustom gnus-use-idna t @@ -7553,10 +7554,11 @@ gnus-button-prefer-mid-or-mail :version "22.1" :group 'gnus-article-buttons :type '(choice (function-item :tag "Heuristic function" - gnus-button-mid-or-mail-heuristic) - (const ask) - (const mid) - (const mail))) + gnus-button-mid-or-mail-heuristic) + (const :tag "Query me" ask) + (const :tag "Assume it's a message ID" mid) + (const :tag "Assume it's a mail address" mail) + function)) (defcustom gnus-button-mid-or-mail-heuristic-alist '((-10.0 . ".+\\$.+@") diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 1a926619e14..ce8220f3a6e 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -112,7 +112,7 @@ gnus-bookmark-use-annotations (defcustom gnus-bookmark-bookmark-inline-details '(author) "Details to be shown with `gnus-bookmark-bmenu-toggle-infos'. -The default value is \(subject)." +The default value is (author)." :type '(list :tag "Gnus bookmark details" (set :inline t (const :tag "Author" author) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 0e81f95cd15..9992f46bbd5 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -315,7 +315,8 @@ gnus-simplify-subject-fuzzy-regexp that will be removed from subject strings if fuzzy subject simplification is selected." :group 'gnus-thread - :type '(repeat regexp)) + :type '(choice regexp + (repeat regexp))) (defcustom gnus-show-threads t "If non-nil, display threads in summary mode." diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b0407cc12eb..ff33133a9a1 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1147,7 +1147,8 @@ message-indent-citation-function This can also be a list of functions. Each function can find the citation between (point) and (mark t). And each function should leave point and mark around the citation text as modified." - :type 'function + :type '(choice function + (repeat function)) :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) @@ -1408,8 +1409,9 @@ message-mail-alias-type :group 'message :link '(custom-manual "(message)Mail Aliases") :type '(choice (const :tag "Use Mailabbrev" abbrev) - (const :tag "Use ecomplete" ecomplete) - (const :tag "No expansion" nil))) + (const :tag "Use ecomplete" ecomplete) + (set (const :tag "Use Mailabbrev" abbrev) + (const :tag "Use ecomplete" ecomplete)))) (defcustom message-self-insert-commands '(self-insert-command) "List of `self-insert-command's used to trigger ecomplete. @@ -1453,8 +1455,9 @@ message-dont-reply-to-names :group 'message :link '(custom-manual "(message)Wide Reply") :type '(choice (const :tag "Yourself" nil) - regexp - (repeat :tag "Regexp List" regexp))) + regexp + (repeat :tag "Regexp List" regexp) + function)) (defsubst message-dont-reply-to-names () (if (functionp message-dont-reply-to-names) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 7e0392797f9..9f1ec7e3677 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -64,7 +64,7 @@ spam-report-url-ping-function spam-report-url-ping-mm-url) (const :tag "Store request URLs in `spam-report-requests-file'" spam-report-url-to-file) - (function :tag "User defined function" nil))) + (function :tag "User defined function"))) (defcustom spam-report-requests-file (nnheader-concat gnus-directory "spam/" "spam-report-requests.url") commit 391420d0c0beb699d79a66c26824d5bbefca905b Author: Dmitry Gutov Date: Mon Oct 23 23:51:08 2023 +0300 xref-backend-references: Avoid finding duplicates * lisp/progmodes/xref.el (xref-backend-references): Cull subdirectories of other elements (bug#66683). diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index fd788ec8f32..81618428bf3 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -281,9 +281,10 @@ xref-backend-references (xref-references-in-directory identifier dir) (message "Searching %s... done" dir))) (let ((pr (project-current t))) - (cons - (xref--project-root pr) - (project-external-roots pr))))) + (project-combine-directories + (cons + (xref--project-root pr) + (project-external-roots pr)))))) (cl-defgeneric xref-backend-apropos (backend pattern) "Find all symbols that match PATTERN string. commit 3beb5f5e2403571085b99d05e4ee781281a1fd9c Author: Lin Sun Date: Mon Oct 23 05:00:01 2023 +0000 ; * doc/misc/gnus.texi: Fix unmatched quote in gnus doc. (Bug#66710) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 86819b8707a..216bbed4966 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -3216,7 +3216,7 @@ Group Parameters @end example To generate tests for multiple email-addresses use a group parameter -like @code{(sieve address "sender" ("name@@one.org" else@@two.org"))}. +like @code{(sieve address "sender" ("name@@one.org" "else@@two.org"))}. When generating a sieve script (@pxref{Sieve Commands}) Sieve code like the following is generated: commit eab9bdf79f5b0e9cafe84b88f9fd44d607fff509 Author: Mattias Engdegård Date: Mon Oct 23 19:09:01 2023 +0200 More robust control sequence handling in LLDB output (bug#66604) * lisp/progmodes/gud.el (gud-lldb-marker-filter): Slightly more elaborate interpretation of CHA and ED sequences in LLDB output, allowing edits to previously emitted characters on the same line. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d3064b6116c..1d3c2a72863 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3886,13 +3886,42 @@ gud-lldb-marker-filter string) (setq gud-last-last-frame nil) (setq gud-overlay-arrow-position nil))) - ;; While being attached to a process, LLDB emits control sequences, - ;; even if TERM is "dumb". This is the case in at least LLDB - ;; version 14 to 17. The control sequences are filtered out by - ;; Emacs after this process filter runs, but LLDB also prints an - ;; extra space after the prompt, which we fix here. - (replace-regexp-in-string (rx "(lldb)" (group (1+ blank)) "\e[8") - " " string nil nil 1)) + + ;; LLDB sometimes emits certain ECMA-48 sequences even if TERM is "dumb": + ;; CHA (Character Horizontal Absolute) and ED (Erase in Display), + ;; seemingly to undo previous output on the same line. + ;; Filter out these sequences here while carrying out their edits. + (let ((bol (pos-bol))) + (when (> (point) bol) + ;; Move the current line to the string, so that control sequences + ;; can delete parts of it. + (setq string (concat (buffer-substring-no-properties bol (point)) + string)) + (delete-region bol (point)))) + (let ((ofs 0)) + (while (string-match (rx (group (* (not (in "\e\n")))) ; preceding chars + "\e[" ; CSI + (? (group (+ digit))) ; argument + (group (in "GJ"))) ; CHA or ED + string ofs) + (let* ((start (match-beginning 1)) + (prefix-end (match-end 1)) + (op (aref string (match-beginning 3))) + (end (match-end 0)) + (keep-end + (if (eq op ?G) + ;; Move to absolute column (CHA) + (min prefix-end + (+ start + (if (match-beginning 2) + (1- (string-to-number (match-string 2 string))) + 0))) + ;; Erase in display (ED): no further action. + prefix-end))) + (setq string (concat (substring string 0 keep-end) + (substring string end))) + (setq ofs start)))) + string) ;; According to SBCommanInterpreter.cpp, the return value of ;; HandleCompletions is as follows: commit 85d08d5788eba1e7195f6ea8888e802aea87f19d Author: Michael Albinus Date: Mon Oct 23 17:07:17 2023 +0200 Minor connection-local variables fixes * doc/emacs/custom.texi (Connection Variables): Warn about specifying the same variable twice. * lisp/files-x.el (connection-local-get-profiles): Normalize criteria. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 09473d7deb7..2bc39095f3c 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1572,6 +1572,10 @@ Connection Variables method) or @code{:user} (a remote user name). The @code{nil} criteria matches all buffers with a remote default directory. + Be careful when declaring different profiles with the same variable, +and setting these profiles to criteria which could match in parallel. +It is unspecified which variable value is used then. + @node Key Bindings @section Customizing Key Bindings @cindex key bindings diff --git a/lisp/files-x.el b/lisp/files-x.el index 9b1a7a17902..477ca059b2a 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -644,7 +644,8 @@ connection-local-get-profiles "Return the connection profiles list for CRITERIA. CRITERIA is a plist identifying a connection and the application using this connection, see `connection-local-criteria-alist'." - (let (profiles) + (let ((criteria (connection-local-normalize-criteria criteria)) + profiles) (dolist (crit-alist connection-local-criteria-alist) (let ((crit criteria) (match t)) commit 0e30ee84ca4f43f890705a0a5e0afaced7624f9a Author: Stefan Kangas Date: Mon Oct 23 15:08:38 2023 +0200 ; Fix my last commit * test/lisp/erc/erc-tests.el (erc-tests--update-modules): Bind 'text-quoting-style' to 'grave'. (erc--update-modules/unknown): Simplify. Suggested by Mattias Engdegård . diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 92e364503e2..57bf5860ac4 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2574,6 +2574,7 @@ erc-tests--update-modules (let* ((calls nil) (custom-modes nil) (on-load nil) + (text-quoting-style 'grave) (get-calls (lambda () (prog1 (nreverse calls) (setq calls nil)))) @@ -2615,9 +2616,7 @@ erc--update-modules/unknown (let* ((erc-modules '(foo)) (obarray (obarray-make)) (err (should-error (erc--update-modules erc-modules)))) - (should (string-match (rx bos (any "`‘") "foo" (any "'’") - " is not a known ERC module" eos) - (cadr err))) + (should (equal (cadr err) "`foo' is not a known ERC module")) (should (equal (funcall get-calls) `((req . ,(intern-soft "erc-foo"))))))) commit 9e002ef9c00448965dab6f55626c74f423a2863c Author: Mattias Engdegård Date: Sun Oct 22 17:25:56 2023 +0200 Modernise text about using dynamic variables * doc/lispref/variables.texi (Dynamic Binding Tips): Give more useful advice. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 3b271526923..f575b188fc6 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1242,17 +1242,18 @@ Dynamic Binding Tips Dynamic binding is a powerful feature, as it allows programs to refer to variables that are not defined within their local textual scope. However, if used without restraint, this can also make -programs hard to understand. There are two clean ways to use this -technique: +programs hard to understand. + +First, choose the variable's name to avoid name conflicts +(@pxref{Coding Conventions}). @itemize @bullet @item -If a variable has no global definition, use it as a local variable -only within a binding construct, such as the body of the @code{let} -form where the variable was bound. If this convention is followed -consistently throughout a program, the value of the variable will not -affect, nor be affected by, any uses of the same variable symbol -elsewhere in the program. +If the variable is only used when locally bound to a value, declare it +special using a @code{defvar} form without an initial value, and never +assign to it unless it is already bound. This way, any attempt to +refer to the variable when unbound will result in a +@code{void-variable} error. @item Otherwise, define the variable with @code{defvar}, @code{defconst} @@ -1260,8 +1261,7 @@ Dynamic Binding Tips Definitions}). Usually, the definition should be at top-level in an Emacs Lisp file. As far as possible, it should include a documentation string which explains the meaning and purpose of the -variable. You should also choose the variable's name to avoid name -conflicts (@pxref{Coding Conventions}). +variable. Then you can bind the variable anywhere in a program, knowing reliably what the effect will be. Wherever you encounter the variable, it will commit dfee22c312c00f74f2c3deb7e3506f0ecab7f9e3 Author: Mattias Engdegård Date: Sun Oct 22 16:51:48 2023 +0200 Elaborate Elisp dialect selection in manual * doc/lispref/variables.texi (Using Lexical Binding): Rename to... (Selecting Lisp Dialect): ...this. All references updated. Add concrete examples of -*- lines. Move text about special variables from here... (Dynamic Binding): ...to here. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 8bf8358153c..c357c8cb35d 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -537,7 +537,7 @@ Top * Lexical Binding:: The standard type of local variable binding. * Dynamic Binding:: A different type of local variable binding. * Dynamic Binding Tips:: Avoiding problems with dynamic binding. -* Using Lexical Binding:: How to enable lexical binding. +* Selecting Lisp Dialect:: How to select the Emacs Lisp dialect to use. * Converting to Lexical Binding:: Convert existing code to lexical binding. Buffer-Local Variables diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index f594d684338..6128fef5d99 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -97,7 +97,7 @@ Coding Conventions @item We recommend enabling @code{lexical-binding} in new code, and converting existing Emacs Lisp code to enable @code{lexical-binding} -if it doesn't already. @xref{Using Lexical Binding}. +if it doesn't already. @xref{Selecting Lisp Dialect}. @item Put a call to @code{provide} at the end of each separate Lisp file. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index f793a83a703..3b271526923 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1015,7 +1015,7 @@ Variable Scoping * Lexical Binding:: The standard type of local variable binding. * Dynamic Binding:: A different type of local variable binding. * Dynamic Binding Tips:: Avoiding problems with dynamic binding. -* Using Lexical Binding:: How to enable lexical binding. +* Selecting Lisp Dialect:: How to select the Emacs Lisp dialect to use. * Converting to Lexical Binding:: Convert existing code to lexical binding. @end menu @@ -1023,7 +1023,7 @@ Lexical Binding @subsection Lexical Binding Lexical binding is only available in the modern Emacs Lisp dialect. -(@xref{Using Lexical Binding}.) +(@xref{Selecting Lisp Dialect}.) A lexically-bound variable has @dfn{lexical scope}, meaning that any reference to the variable must be located textually within the binding construct. Here is an example @@ -1115,8 +1115,8 @@ Dynamic Binding @subsection Dynamic Binding Local variable bindings are dynamic in the modern Lisp dialect for -special variables, and for all variables in the old Lisp -dialect. (@xref{Using Lexical Binding}.) +special variables (see below), and for all variables in the old Lisp +dialect. (@xref{Selecting Lisp Dialect}.) Dynamic variable bindings have their uses but are in general more error-prone and less efficient than lexical bindings, and the compiler is less able to find mistakes in code using dynamic bindings. @@ -1180,6 +1180,54 @@ Dynamic Binding @end group @end example +@cindex special variables + Even when lexical binding is enabled, certain variables will +continue to be dynamically bound. These are called @dfn{special +variables}. Every variable that has been defined with @code{defvar}, +@code{defcustom} or @code{defconst} is a special variable +(@pxref{Defining Variables}). All other variables are subject to +lexical binding. + +@anchor{Local defvar example} +Using @code{defvar} without a value, it is possible to bind a variable +dynamically just in one file, or in just one part of a file while +still binding it lexically elsewhere. For example: + +@example +@group +(let (_) + (defvar x) ; @r{Let-bindings of @code{x} will be dynamic within this let.} + (let ((x -99)) ; @r{This is a dynamic binding of @code{x}.} + (defun get-dynamic-x () + x))) + +(let ((x 'lexical)) ; @r{This is a lexical binding of @code{x}.} + (defun get-lexical-x () + x)) + +(let (_) + (defvar x) + (let ((x 'dynamic)) + (list (get-lexical-x) + (get-dynamic-x)))) + @result{} (lexical dynamic) +@end group +@end example + +@defun special-variable-p symbol +This function returns non-@code{nil} if @var{symbol} is a special +variable (i.e., it has a @code{defvar}, @code{defcustom}, or +@code{defconst} variable definition). Otherwise, the return value is +@code{nil}. + +Note that since this is a function, it can only return +non-@code{nil} for variables which are permanently special, but not +for those that are only special in the current lexical scope. +@end defun + + The use of a special variable as a formal argument in a function is +not supported. + Dynamic binding is implemented in Emacs Lisp in a simple way. Each symbol has a value cell, which specifies its current dynamic value (or absence of value). @xref{Symbol Components}. When a symbol is given @@ -1234,25 +1282,44 @@ Dynamic Binding Tips @end example @end itemize -@node Using Lexical Binding -@subsection Using Lexical Binding +@node Selecting Lisp Dialect +@subsection Selecting Lisp Dialect - When loading an Emacs Lisp file or evaluating a Lisp buffer, lexical -binding is enabled if the buffer-local variable @code{lexical-binding} -is non-@code{nil}: + When loading an Emacs Lisp file or evaluating a Lisp buffer, the +Lisp dialect is selected using the buffer-local variable +@code{lexical-binding}. @defvar lexical-binding If this buffer-local variable is non-@code{nil}, Emacs Lisp files and -buffers are evaluated using lexical binding instead of dynamic -binding. (However, special variables are still dynamically bound; see -below.) If @code{nil}, dynamic binding is used for all local -variables. This variable is typically set for a whole Emacs Lisp -file, as a file local variable (@pxref{File Local Variables}). -Note that unlike other such variables, this one must be set in the -first line of a file. +buffers are evaluated using the modern Lisp dialect that by default +uses lexical binding instead of dynamic binding. If @code{nil}, the +old dialect is used that uses dynamic binding for all local variables. +This variable is typically set for a whole Emacs Lisp file, as a +file-local variable (@pxref{File Local Variables}). Note that unlike +other such variables, this one must be set in the first line of a +file. @end defvar @noindent +In practice, dialect selection means that the first line in an Emacs +Lisp file looks like: + +@example +;;; ... -*- lexical-binding: t -*- +@end example + +@noindent +for the modern lexical-binding dialect, and + +@example +;;; ... -*- lexical-binding: nil -*- +@end example + +@noindent +for the old dynamic-only dialect. When no declaration is present the +old dialect is used, but this may change in a future release. +The compiler will warn if no declaration is present. + When evaluating Emacs Lisp code directly using an @code{eval} call, lexical binding is enabled if the @var{lexical} argument to @code{eval} is non-@code{nil}. @xref{Eval}. @@ -1266,54 +1333,6 @@ Using Lexical Binding @command{emacsclient} (@pxref{emacsclient Options,,, emacs, The GNU Emacs Manual}). -@cindex special variables - Even when lexical binding is enabled, certain variables will -continue to be dynamically bound. These are called @dfn{special -variables}. Every variable that has been defined with @code{defvar}, -@code{defcustom} or @code{defconst} is a special variable -(@pxref{Defining Variables}). All other variables are subject to -lexical binding. - -@anchor{Local defvar example} -Using @code{defvar} without a value, it is possible to bind a variable -dynamically just in one file, or in just one part of a file while -still binding it lexically elsewhere. For example: - -@example -@group -(let (_) - (defvar x) ; @r{Let-bindings of @code{x} will be dynamic within this let.} - (let ((x -99)) ; @r{This is a dynamic binding of @code{x}.} - (defun get-dynamic-x () - x))) - -(let ((x 'lexical)) ; @r{This is a lexical binding of @code{x}.} - (defun get-lexical-x () - x)) - -(let (_) - (defvar x) - (let ((x 'dynamic)) - (list (get-lexical-x) - (get-dynamic-x)))) - @result{} (lexical dynamic) -@end group -@end example - -@defun special-variable-p symbol -This function returns non-@code{nil} if @var{symbol} is a special -variable (i.e., it has a @code{defvar}, @code{defcustom}, or -@code{defconst} variable definition). Otherwise, the return value is -@code{nil}. - -Note that since this is a function, it can only return -non-@code{nil} for variables which are permanently special, but not -for those that are only special in the current lexical scope. -@end defun - - The use of a special variable as a formal argument in a function is -not supported. - @node Converting to Lexical Binding @subsection Converting to Lexical Binding commit 7e4a4b762e73ec03be18a149b737447facff3612 Author: Mattias Engdegård Date: Sat Oct 21 17:39:25 2023 +0200 Describe lexical binding before dynamic * doc/lispref/variables.texi (Variable Scoping) (Lexical Binding, Dynamic Binding): Alter the presentation order from the point of view that lexical binding is the standard discipline (if not always the default) and dynamic binding an alternative, which corresponds better to Elisp today. Modernise parts of the text. * doc/lispref/elisp.texi (Top): Update menu. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 72441c8d442..8bf8358153c 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -534,9 +534,9 @@ Top Scoping Rules for Variable Bindings -* Dynamic Binding:: The default for binding local variables in Emacs. +* Lexical Binding:: The standard type of local variable binding. +* Dynamic Binding:: A different type of local variable binding. * Dynamic Binding Tips:: Avoiding problems with dynamic binding. -* Lexical Binding:: A different type of local variable binding. * Using Lexical Binding:: How to enable lexical binding. * Converting to Lexical Binding:: Convert existing code to lexical binding. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 779f6233735..f793a83a703 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -976,50 +976,152 @@ Variable Scoping binding can be accessed. @dfn{Extent} refers to @emph{when}, as the program is executing, the binding exists. -@cindex dynamic binding -@cindex dynamic scope -@cindex dynamic extent - By default, the local bindings that Emacs creates are @dfn{dynamic -bindings}. Such a binding has @dfn{dynamic scope}, meaning that any -part of the program can potentially access the variable binding. It -also has @dfn{dynamic extent}, meaning that the binding lasts only -while the binding construct (such as the body of a @code{let} form) is -being executed. - @cindex lexical binding @cindex lexical scope @cindex indefinite extent - Emacs can optionally create @dfn{lexical bindings}. A lexical -binding has @dfn{lexical scope}, meaning that any reference to the -variable must be located textually within the binding + For historical reasons, there are two dialects of Emacs Lisp, +selected via the @code{lexical-binding} buffer-local variable. +In the modern Emacs Lisp dialect, local bindings are lexical by default. +A @dfn{lexical binding} has @dfn{lexical scope}, meaning that any +reference to the variable must be located textually within the binding construct@footnote{With some exceptions; for instance, a lexical binding can also be accessed from the Lisp debugger.}. It also has @dfn{indefinite extent}, meaning that under some circumstances the binding can live on even after the binding construct has finished -executing, by means of special objects called @dfn{closures}. +executing, by means of objects called @dfn{closures}. - The dynamic binding was (and still is) the default in Emacs for many -years, but lately Emacs is moving towards using lexical binding in -more and more places, with the goal of eventually making that the -default. +@cindex dynamic binding +@cindex dynamic scope +@cindex dynamic extent + Local bindings can also be dynamic, which they always are in the +old Emacs Lisp dialect and optionally in the modern dialect. +A @dfn{dynamic binding} has @dfn{dynamic scope}, meaning that any +part of the program can potentially access the variable binding. It +also has @dfn{dynamic extent}, meaning that the binding lasts only +while the binding construct (such as the body of a @code{let} form) is +being executed. - The following subsections describe dynamic binding and lexical + The old dynamic-only Emacs Lisp dialect is still the default in code +loaded or evaluated from Lisp files that lack a dialect declaration. +Eventually the modern dialect will be made the default. +All Lisp files should declare the dialect used to ensure that they +keep working correctly in the future. + + The following subsections describe lexical binding and dynamic binding in greater detail, and how to enable lexical binding in Emacs Lisp programs. @menu -* Dynamic Binding:: The default for binding local variables in Emacs. +* Lexical Binding:: The standard type of local variable binding. +* Dynamic Binding:: A different type of local variable binding. * Dynamic Binding Tips:: Avoiding problems with dynamic binding. -* Lexical Binding:: A different type of local variable binding. * Using Lexical Binding:: How to enable lexical binding. * Converting to Lexical Binding:: Convert existing code to lexical binding. @end menu +@node Lexical Binding +@subsection Lexical Binding + +Lexical binding is only available in the modern Emacs Lisp dialect. +(@xref{Using Lexical Binding}.) +A lexically-bound variable has @dfn{lexical scope}, meaning that any +reference to the variable must be located textually within the binding +construct. Here is an example + +@example +@group +(let ((x 1)) ; @r{@code{x} is lexically bound.} + (+ x 3)) + @result{} 4 + +(defun getx () + x) ; @r{@code{x} is used free in this function.} + +(let ((x 1)) ; @r{@code{x} is lexically bound.} + (getx)) +@error{} Symbol's value as variable is void: x +@end group +@end example + +@noindent +Here, the variable @code{x} has no global value. When it is lexically +bound within a @code{let} form, it can be used in the textual confines +of that @code{let} form. But it can @emph{not} be used from within a +@code{getx} function called from the @code{let} form, since the +function definition of @code{getx} occurs outside the @code{let} form +itself. + +@cindex lexical environment + Here is how lexical binding works. Each binding construct defines a +@dfn{lexical environment}, specifying the variables that are bound +within the construct and their local values. When the Lisp evaluator +wants the current value of a variable, it looks first in the lexical +environment; if the variable is not specified in there, it looks in +the symbol's value cell, where the dynamic value is stored. + +@cindex closures, example of using + Lexical bindings have indefinite extent. Even after a binding +construct has finished executing, its lexical environment can be +``kept around'' in Lisp objects called @dfn{closures}. A closure is +created when you define a named or anonymous function with lexical +binding enabled. @xref{Closures}, for details. + + When a closure is called as a function, any lexical variable +references within its definition use the retained lexical environment. +Here is an example: + +@example +(defvar my-ticker nil) ; @r{We will use this dynamically bound} + ; @r{variable to store a closure.} + +(let ((x 0)) ; @r{@code{x} is lexically bound.} + (setq my-ticker (lambda () + (setq x (1+ x))))) + @result{} (closure ((x . 0)) () + (setq x (1+ x))) + +(funcall my-ticker) + @result{} 1 + +(funcall my-ticker) + @result{} 2 + +(funcall my-ticker) + @result{} 3 + +x ; @r{Note that @code{x} has no global value.} +@error{} Symbol's value as variable is void: x +@end example + +@noindent +The @code{let} binding defines a lexical environment in which the +variable @code{x} is locally bound to 0. Within this binding +construct, we define a lambda expression which increments @code{x} by +one and returns the incremented value. This lambda expression is +automatically turned into a closure, in which the lexical environment +lives on even after the @code{let} binding construct has exited. Each +time we evaluate the closure, it increments @code{x}, using the +binding of @code{x} in that lexical environment. + + Note that unlike dynamic variables which are tied to the symbol +object itself, the relationship between lexical variables and symbols +is only present in the interpreter (or compiler). Therefore, +functions which take a symbol argument (like @code{symbol-value}, +@code{boundp}, and @code{set}) can only retrieve or modify a +variable's dynamic binding (i.e., the contents of its symbol's value +cell). + @node Dynamic Binding @subsection Dynamic Binding - By default, the local variable bindings made by Emacs are dynamic -bindings. When a variable is dynamically bound, its current binding + Local variable bindings are dynamic in the modern Lisp dialect for +special variables, and for all variables in the old Lisp +dialect. (@xref{Using Lexical Binding}.) +Dynamic variable bindings have their uses but are in general more +error-prone and less efficient than lexical bindings, and the compiler +is less able to find mistakes in code using dynamic bindings. + + When a variable is dynamically bound, its current binding at any point in the execution of the Lisp program is simply the most recently-created dynamic local binding for that symbol, or the global binding if there is no such local binding. @@ -1086,9 +1188,6 @@ Dynamic Binding value cell. When the binding construct finishes executing, Emacs pops the old value off the stack, and puts it in the value cell. - Note that when code using Dynamic Binding is native compiled the -native compiler will not perform any Lisp specific optimization. - @node Dynamic Binding Tips @subsection Proper Use of Dynamic Binding @@ -1135,109 +1234,6 @@ Dynamic Binding Tips @end example @end itemize -@node Lexical Binding -@subsection Lexical Binding - - Lexical binding was introduced to Emacs, as an optional feature, in -version 24.1. We expect its importance to increase with time. -Lexical binding opens up many more opportunities for optimization, so -programs using it are likely to run faster in future Emacs versions. -Lexical binding is also more compatible with concurrency, which was -added to Emacs in version 26.1. - - A lexically-bound variable has @dfn{lexical scope}, meaning that any -reference to the variable must be located textually within the binding -construct. Here is an example -@iftex -(see the next subsection, for how to actually enable lexical binding): -@end iftex -@ifnottex -(@pxref{Using Lexical Binding}, for how to actually enable lexical binding): -@end ifnottex - -@example -@group -(let ((x 1)) ; @r{@code{x} is lexically bound.} - (+ x 3)) - @result{} 4 - -(defun getx () - x) ; @r{@code{x} is used free in this function.} - -(let ((x 1)) ; @r{@code{x} is lexically bound.} - (getx)) -@error{} Symbol's value as variable is void: x -@end group -@end example - -@noindent -Here, the variable @code{x} has no global value. When it is lexically -bound within a @code{let} form, it can be used in the textual confines -of that @code{let} form. But it can @emph{not} be used from within a -@code{getx} function called from the @code{let} form, since the -function definition of @code{getx} occurs outside the @code{let} form -itself. - -@cindex lexical environment - Here is how lexical binding works. Each binding construct defines a -@dfn{lexical environment}, specifying the variables that are bound -within the construct and their local values. When the Lisp evaluator -wants the current value of a variable, it looks first in the lexical -environment; if the variable is not specified in there, it looks in -the symbol's value cell, where the dynamic value is stored. - -@cindex closures, example of using - Lexical bindings have indefinite extent. Even after a binding -construct has finished executing, its lexical environment can be -``kept around'' in Lisp objects called @dfn{closures}. A closure is -created when you define a named or anonymous function with lexical -binding enabled. @xref{Closures}, for details. - - When a closure is called as a function, any lexical variable -references within its definition use the retained lexical environment. -Here is an example: - -@example -(defvar my-ticker nil) ; @r{We will use this dynamically bound} - ; @r{variable to store a closure.} - -(let ((x 0)) ; @r{@code{x} is lexically bound.} - (setq my-ticker (lambda () - (setq x (1+ x))))) - @result{} (closure ((x . 0)) () - (setq x (1+ x))) - -(funcall my-ticker) - @result{} 1 - -(funcall my-ticker) - @result{} 2 - -(funcall my-ticker) - @result{} 3 - -x ; @r{Note that @code{x} has no global value.} -@error{} Symbol's value as variable is void: x -@end example - -@noindent -The @code{let} binding defines a lexical environment in which the -variable @code{x} is locally bound to 0. Within this binding -construct, we define a lambda expression which increments @code{x} by -one and returns the incremented value. This lambda expression is -automatically turned into a closure, in which the lexical environment -lives on even after the @code{let} binding construct has exited. Each -time we evaluate the closure, it increments @code{x}, using the -binding of @code{x} in that lexical environment. - - Note that unlike dynamic variables which are tied to the symbol -object itself, the relationship between lexical variables and symbols -is only present in the interpreter (or compiler). Therefore, -functions which take a symbol argument (like @code{symbol-value}, -@code{boundp}, and @code{set}) can only retrieve or modify a -variable's dynamic binding (i.e., the contents of its symbol's value -cell). - @node Using Lexical Binding @subsection Using Lexical Binding commit 48e7f5493e4ffd31cb705adf982485c3b30fbbac Author: Mattias Engdegård Date: Mon Oct 23 11:12:33 2023 +0200 Improved `eval` documentation Prompted by Michael Heerdegen. * src/eval.c (Feval): * doc/lispref/eval.texi (Eval): Be more precise about the LEXICAL argument. diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index ea35d4d38c7..8af0ee49d02 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -740,16 +740,17 @@ Eval @xref{Forms}. The argument @var{lexical} specifies the scoping rule for local -variables (@pxref{Variable Scoping}). If it is omitted or @code{nil}, -that means to evaluate @var{form} using the default dynamic scoping -rule. If it is @code{t}, that means to use the lexical scoping rule. +variables (@pxref{Variable Scoping}). If it is @code{t}, that means +to evaluate @var{form} using lexical scoping; this is the recommended +value. If it is omitted or @code{nil}, that means to use the old +dynamic-only variable scoping rule. The value of @var{lexical} can also be a non-empty list specifying a particular @dfn{lexical environment} for lexical bindings; however, this feature is only useful for specialized purposes, such as in Emacs Lisp debuggers. Each member of the list is either a cons cell which represents a lexical symbol-value pair, or a symbol representing a -dynamically bound variable. +(special) variable that would use dynamic scoping if bound. Since @code{eval} is a function, the argument expression that appears in a call to @code{eval} is evaluated twice: once as preparation before diff --git a/src/eval.c b/src/eval.c index 9268b65aa85..f5397e9fb72 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2364,9 +2364,13 @@ DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0, DEFUN ("eval", Feval, Seval, 1, 2, 0, doc: /* Evaluate FORM and return its value. -If LEXICAL is t, evaluate using lexical scoping. -LEXICAL can also be an actual lexical environment, in the form of an -alist mapping symbols to their value. */) +If LEXICAL is `t', evaluate using lexical binding by default. +This is the recommended value. + +If absent or `nil', use dynamic scoping only. + +LEXICAL can also represent an actual lexical environment; see the Info +node `(elisp)Eval' for details. */) (Lisp_Object form, Lisp_Object lexical) { specpdl_ref count = SPECPDL_INDEX (); commit d1fa9f19566e1ddfa2cb38ccb360a7b3ba540dc3 Author: Stefan Kangas Date: Mon Oct 23 14:36:46 2023 +0200 Fix failing ERC test * test/lisp/erc/erc-tests.el (erc--update-modules/unknown): Fix test failing due to grave/curve quote. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4d2f880b46f..92e364503e2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2615,7 +2615,9 @@ erc--update-modules/unknown (let* ((erc-modules '(foo)) (obarray (obarray-make)) (err (should-error (erc--update-modules erc-modules)))) - (should (equal (cadr err) "`foo' is not a known ERC module")) + (should (string-match (rx bos (any "`‘") "foo" (any "'’") + " is not a known ERC module" eos) + (cadr err))) (should (equal (funcall get-calls) `((req . ,(intern-soft "erc-foo"))))))) commit 79d8328ca4a7506e394f7f068564dd44a9acd919 Author: Stefan Kangas Date: Mon Oct 23 13:57:28 2023 +0200 Make Dired honor `insert-directory-program´ with globs Starting with commit 6f6639d6ed6c6314b2643f6c22498fc2e23d34c7 (Bug#27631), Dired stopped respecting the value of 'insert-directory-program' when using directory wildcards/globs. * lisp/dired.el (dired-insert-directory): Honor the value of 'insert-directory-program' when using directory wildcards. diff --git a/lisp/dired.el b/lisp/dired.el index e5110e76a76..f81e49a6b00 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1664,7 +1664,9 @@ dired-insert-directory (when (file-remote-p dir) (setq switches (string-replace "--dired" "" switches))) (let* ((default-directory (car dir-wildcard)) - (script (format "ls %s %s" switches (cdr dir-wildcard))) + (script (format "%s %s %s" + insert-directory-program + switches (cdr dir-wildcard))) (remotep (file-remote-p dir)) (sh (or (and remotep "/bin/sh") (executable-find shell-file-name) commit baf14aa16accc97db32723d13fb65a5e8ead4d47 Author: Po Lu Date: Mon Oct 23 11:11:30 2023 +0000 Rewrite Yank Media node in the Emacs Lisp manual * doc/lispref/frames.texi (Other Selections): Introduce a reference to Accessing Selections, then rewrite for clarity and to stop mentioning MIME types by name, for selection data types are not confined to those. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 5203e2ae7da..d840f281849 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4668,43 +4668,38 @@ Other Selections @node Yanking Media @section Yanking Media - If you choose, for instance, ``Copy Image'' in a web browser, that -image is put onto the clipboard, and Emacs can access it via -@code{gui-get-selection}. But in general, inserting image data into -an arbitrary buffer isn't very useful---you can't really do much with -it by default. - - So Emacs has a system to let modes register handlers for these -``complicated'' selections. + Data saved within window system selections is not restricted to +plain text. It is possible for selection data to encompass images or +other binary data of the like, as well as rich text content instanced +by HTML, and also PostScript. Since the selection data types incident +to this data are at variance with those for plain text, the insertion +of such data is facilitated by a set of functions dubbed +@dfn{yank-media handlers}, which are registered by each major mode +undertaking its insertion and called where warranted upon the +execution of the @code{yank-media} command. @defun yank-media-handler types handler -@var{types} can be a @acronym{MIME} media type symbol, a regexp to -match these, or a list of these symbols and regexps. For instance: +Register a yank-media handler which applies to the current buffer. + +@var{types} can be a symbol designating a selection data type +(@pxref{Accessing Selections}), a regexp against which such types are +matched, or a list of these symbols and regexps. For instance: @example (yank-media-handler 'text/html #'my-html-handler) (yank-media-handler "image/.*" #'my-image-handler) @end example -A mode can register as many handlers as required. - - The @var{handler} function is called with two parameters: The -@acronym{MIME} media type symbol and the data (as a string). The -handler should then insert the object into the buffer, or save it, or -do whatever is appropriate for the mode. +When a selection offers a data type matching @var{types}, the function +@var{handler} is called to insert its data, with the symbol +designating the matching selection data type, and the data returned by +@code{gui-get-selection}. @end defun - The @code{yank-media} command will consult the registered handlers in -the current buffer, compare that with the available media types on the -clipboard, and then pass on the matching selection to the handler (if -any). If there's more than one matching selection, the user is -queried first. - - The @code{yank-media-types} command can be used to explore the -clipboard/primary selection. It lists all the media types that are -currently available, and can be handy when creating handlers---to see -what data is actually available. Some applications put a surprising -amount of different data types on the clipboard. +The @code{yank-media-types} command presents a list of selection data +types that are currently available, which is useful when implementing +yank-media handlers; for programs generally offer an eclectic and +seldom consistent medley of data types. @node Drag and Drop @section Drag and Drop commit 7e87b145fc0babb1cf7fcd00d381d6a70bdbcf6d Author: Basil L. Contovounesios Date: Mon Oct 23 12:59:13 2023 +0200 ; * test/lisp/align-tests.el: Pacify warning. diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el index e5fcd255907..f8dd7dcfb9b 100644 --- a/test/lisp/align-tests.el +++ b/test/lisp/align-tests.el @@ -49,6 +49,8 @@ align-latex (ert-test-erts-file (ert-resource-file "latex-mode.erts") (test-align-transform-fun #'latex-mode))) +(autoload 'treesit-ready-p "treesit") + (ert-deftest align-lua () (skip-unless (treesit-ready-p 'lua)) (let ((comment-column 20) commit 1c261e0a6cae09e3ff36930442f2c9da44bccd6d Author: john muhl Date: Wed Oct 4 20:46:15 2023 -0500 Various improvements to lua-ts-mode (Bug#66159) * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): Improve movement. (lua-ts--simple-indent-rules): Improve indentation rules. (lua-ts-mode-map): Add key bindings and menus. (lua-ts-mode-hook): Make hook available in Customize. (lua-ts-inferior-history, lua-ts-inferior--write-history): Add option to read/write an input history file. (lua-ts-inferior-lua, lua-ts-send-buffer, lua-ts-send-file) (lua-ts-send-region, lua-ts-inferior-prompt) (lua-ts-inferior-prompt-continue): Support for sending buffer, file or region to the inferior process. (lua-ts-show-process-buffer, lua-ts-hide-process-buffer) (lua-ts-kill-process): New functions. (lua-ts-inferior-prompt-regexp): Remove option. * test/lisp/progmodes/lua-ts-mode-resources/indent.erts: * test/lisp/progmodes/lua-ts-mode-resources/movement.erts: Add tests. diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 69833297073..80cf119f75c 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -38,7 +38,12 @@ (require 'cl-lib) (require 'rx)) +(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-node-child-count "treesit.c") +(declare-function treesit-node-first-child-for-pos "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") (declare-function treesit-parser-create "treesit.c") (declare-function treesit-search-subtree "treesit.c") @@ -48,6 +53,15 @@ lua-ts :prefix "lua-ts-" :group 'languages) +(defcustom lua-ts-mode-hook nil + "Hook run after entering `lua-ts-mode'." + :type 'hook + :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 @@ -57,7 +71,7 @@ lua-ts-indent-offset (defcustom lua-ts-luacheck-program "luacheck" "Location of the Luacheck program." - :type '(choice (const nil) string) + :type '(choice (const :tag "None" nil) string) :group 'lua-ts :version "30.1") @@ -70,7 +84,7 @@ lua-ts-inferior-buffer (defcustom lua-ts-inferior-program "lua" "Program to run in the inferior Lua process." - :type '(choice (const nil) string) + :type '(choice (const :tag "None" nil) string) :group 'lua-ts :version "30.1") @@ -82,13 +96,28 @@ lua-ts-inferior-options (defcustom lua-ts-inferior-startfile nil "File to load into the inferior Lua process at startup." - :type '(choice (const nil) (file :must-match t)) + :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-prompt-regexp "^>>?[[:blank:]]" - "Regular expression matching the prompt of the inferior Lua process." - :type 'regexp +(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") @@ -103,6 +132,12 @@ lua-ts--builtins "close" "flush" "lines" "read" "seek" "setvbuf" "write") "Lua built-in functions for tree-sitter font-locking.") +(defvar lua-ts--keywords + '("and" "do" "else" "elseif" "end" "for" "function" + "goto" "if" "in" "local" "not" "or" "repeat" + "return" "then" "until" "while") + "Lua keywords for tree-sitter font-locking and navigation.") + (defvar lua-ts--font-lock-settings (treesit-font-lock-rules :language 'lua @@ -167,13 +202,11 @@ lua-ts--font-lock-settings :language 'lua :feature 'keyword - '((break_statement) @font-lock-keyword-face + `((break_statement) @font-lock-keyword-face (true) @font-lock-constant-face (false) @font-lock-constant-face (nil) @font-lock-constant-face - ["and" "do" "else" "elseif" "end" "for" "function" - "goto" "if" "in" "local" "not" "or" "repeat" - "return" "then" "until" "while"] + ,(vconcat lua-ts--keywords) @font-lock-keyword-face) :language 'lua @@ -235,27 +268,145 @@ lua-ts--font-lock-settings (defvar lua-ts--simple-indent-rules `((lua + ((or (node-is "comment") + (parent-is "comment_content") + (parent-is "string_content") + (node-is "]]")) + no-indent 0) + ((and (n-p-gp "field" "table_constructor" "arguments") + lua-ts--multi-arg-function-call-matcher) + parent lua-ts-indent-offset) + ((and (n-p-gp "}" "table_constructor" "arguments") + lua-ts--multi-arg-function-call-matcher) + parent 0) + ((or (node-is "do") + (node-is "then") + (node-is "elseif_statement") + (node-is "else_statement") + (node-is "until") + (node-is ")") + (node-is "}")) + standalone-parent 0) + ((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)) + standalone-parent lua-ts-indent-offset) + ((or (parent-is "arguments") + (parent-is "parameters") + (parent-is "table_constructor")) + (nth-sibling 1) 0) + ((and (n-p-gp "block" "function_definition" "parenthesized_expression") + lua-ts--nested-function-block-matcher + lua-ts--nested-function-block-include-matcher) + parent lua-ts-indent-offset) + ((and (n-p-gp "block" "function_definition" "arguments") + lua-ts--nested-function-argument-matcher) + parent lua-ts-indent-offset) + ((match "function_definition" "parenthesized_expression") + standalone-parent lua-ts-indent-offset) + ((node-is "block") standalone-parent lua-ts-indent-offset) + ((parent-is "block") parent 0) + ((and (node-is "end") lua-ts--end-line-matcher) + standalone-parent lua-ts--end-indent-offset) + ((match "end" "function_declaration") parent 0) + ((and (n-p-gp "end" "function_definition" "parenthesized_expression") + lua-ts--nested-function-end-argument-matcher) + parent 0) + ((and (n-p-gp "end" "function_definition" "parenthesized_expression") + lua-ts--nested-function-block-matcher + lua-ts--nested-function-end-matcher + lua-ts--nested-function-last-function-matcher) + parent 0) + ((n-p-gp "end" "function_definition" "arguments") parent 0) + ((or (match "end" "function_definition") + (node-is "end")) + standalone-parent 0) + ((or (parent-is "function_declaration") + (parent-is "function_definition") + (parent-is "do_statement") + (parent-is "for_statement") + (parent-is "repeat_statement") + (parent-is "while_statement") + (parent-is "if_statement") + (parent-is "else_statement") + (parent-is "elseif_statement")) + standalone-parent lua-ts-indent-offset) ((parent-is "chunk") column-0 0) - ((node-is "comment_end") column-0 0) - ((parent-is "block") parent-bol 0) - ((node-is "}") parent-bol 0) - ((node-is ")") parent-bol 0) - ((node-is "else_statement") parent-bol 0) - ((node-is "elseif_statement") parent-bol 0) - ((node-is "end") parent-bol 0) - ((node-is "until") parent-bol 0) - ((parent-is "for_statement") parent-bol lua-ts-indent-offset) - ((parent-is "function_declaration") parent-bol lua-ts-indent-offset) - ((parent-is "function_definition") parent-bol lua-ts-indent-offset) - ((parent-is "if_statement") parent-bol lua-ts-indent-offset) - ((parent-is "else_statement") parent-bol lua-ts-indent-offset) - ((parent-is "repeat_statement") parent-bol lua-ts-indent-offset) - ((parent-is "while_statement") parent-bol lua-ts-indent-offset) - ((parent-is "table_constructor") parent-bol lua-ts-indent-offset) - ((parent-is "arguments") parent-bol lua-ts-indent-offset) - ((parent-is "parameters") parent-bol lua-ts-indent-offset) ((parent-is "ERROR") no-indent 0)))) +(defun lua-ts--end-line-matcher (&rest _) + "Matches if there is more than one `end' on the current line." + (> (lua-ts--end-count) 1)) + +(defun lua-ts--end-indent-offset (&rest _) + "Calculate indent offset based on `end' count." + (- (* (1- (lua-ts--end-count)) lua-ts-indent-offset))) + +(defun lua-ts--end-count () + "Count the number of `end's on the current line." + (count-matches "end" (line-beginning-position) (line-end-position))) + +(defun lua-ts--first-child-matcher (node &rest _) + "Matches if NODE is the first among its siblings." + (= (treesit-node-index node) 1)) + +(defun lua-ts--function-definition-p (node) + "Return t if NODE is a function_definition." + (equal "function_definition" (treesit-node-type node))) + +(defun lua-ts--g-g-g-parent (node) + "Return the great-great-grand-parent of NODE." + (let* ((parent (treesit-node-parent node)) + (g-parent (treesit-node-parent parent)) + (g-g-parent (treesit-node-parent g-parent))) + (treesit-node-parent g-g-parent))) + +(defun lua-ts--multi-arg-function-call-matcher (_n parent &rest _) + "Matches if PARENT has multiple arguments." + (> (treesit-node-child-count (treesit-node-parent parent)) 3)) + +(defun lua-ts--nested-function-argument-matcher (node &rest _) + "Matches if NODE is in a nested function argument." + (save-excursion + (goto-char (treesit-node-start node)) + (treesit-beginning-of-defun) + (backward-char 2) + (not (looking-at ")(")))) + +(defun lua-ts--nested-function-block-matcher (node &rest _) + "Matches if NODE is in a nested function block." + (let* ((g-g-g-parent (lua-ts--g-g-g-parent node)) + (g-g-g-type (treesit-node-type g-g-g-parent))) + (not (equal g-g-g-type "chunk")))) + +(defun lua-ts--nested-function-block-include-matcher (node _p bol &rest _) + "Matches if NODE's child at BOL is not another block." + (let* ((child (treesit-node-first-child-for-pos node bol)) + (child-type (treesit-node-type child)) + (g-g-g-type (treesit-node-type (lua-ts--g-g-g-parent node)))) + (or (equal child-type "assignment_statement") + (and (equal child-type "return_statement") + (or (equal g-g-g-type "arguments") + (and (equal g-g-g-type "expression_list") + (not (treesit-search-subtree child "function_call")))))))) + +(defun lua-ts--nested-function-end-matcher (node &rest _) + "Matches if NODE is the `end' of a nested function." + (save-excursion + (goto-char (treesit-node-start node)) + (treesit-beginning-of-defun) + (looking-at "function[[:space:]]*"))) + +(defun lua-ts--nested-function-end-argument-matcher (node &rest _) + "Matches if great-great-grandparent of NODE is arguments." + (equal "arguments" (treesit-node-type (lua-ts--g-g-g-parent node)))) + +(defun lua-ts--nested-function-last-function-matcher (_n parent &rest _) + "Matches if PARENT is the last nested function." + (let ((sparse-tree + (treesit-induce-sparse-tree parent #'lua-ts--function-definition-p))) + (= 1 (length (cadr sparse-tree))))) + (defvar lua-ts--syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?+ "." table) @@ -352,26 +503,126 @@ lua-ts-flymake-luacheck (defun lua-ts-inferior-lua () "Run a Lua interpreter in an inferior process." (interactive) - (let* ((buffer lua-ts-inferior-buffer) - (name (string-replace "*" "" buffer)) - (program lua-ts-inferior-program) - (prompt-regexp lua-ts-inferior-prompt-regexp) - (switches lua-ts-inferior-options) - (startfile lua-ts-inferior-startfile)) - (unless (comint-check-proc buffer) - (set-buffer (apply (function make-comint) name program startfile switches)) + (unless (comint-check-proc lua-ts-inferior-buffer) + (apply #'make-comint-in-buffer + (string-replace "*" "" lua-ts-inferior-buffer) + lua-ts-inferior-buffer + lua-ts-inferior-program + lua-ts-inferior-startfile + lua-ts-inferior-options) + (when lua-ts-inferior-history + (set-process-sentinel (get-buffer-process lua-ts-inferior-buffer) + 'lua-ts-inferior--write-history)) + (with-current-buffer lua-ts-inferior-buffer (setq-local comint-input-ignoredups t + comint-input-ring-file-name lua-ts-inferior-history + comint-use-prompt-regexp t comint-prompt-read-only t - comint-prompt-regexp prompt-regexp - comint-use-prompt-regexp t)) - (select-window (display-buffer buffer '((display-buffer-reuse-window - display-buffer-pop-up-frame) - (reusable-frames . t)))))) + comint-prompt-regexp (rx-to-string `(: bol + ,lua-ts-inferior-prompt + (1+ space)))) + (comint-read-input-ring t) + (add-hook 'comint-preoutput-filter-functions + (lambda (string) + (if (or (not (equal (buffer-name) lua-ts-inferior-buffer)) + (equal string + (concat lua-ts-inferior-prompt-continue " "))) + string + (concat + ;; Filter out the extra prompt characters that + ;; accumulate in the output when sending regions + ;; to the inferior process. + (replace-regexp-in-string (rx-to-string + `(: bol + (* ,lua-ts-inferior-prompt + (? ,lua-ts-inferior-prompt) + (1+ space)) + (group (* nonl)))) + "\\1" string) + ;; Re-add the prompt for the next line. + lua-ts-inferior-prompt " ")))))) + (select-window (display-buffer lua-ts-inferior-buffer + '((display-buffer-reuse-window + display-buffer-pop-up-frame) + (reusable-frames . t)))) + (get-buffer-process (current-buffer))) + +(defun lua-ts-send-buffer () + "Send current buffer to the inferior Lua process." + (interactive) + (lua-ts-send-region (point-min) (point-max))) + +(defun lua-ts-send-file (file) + "Send contents of FILE to the inferior Lua process." + (interactive "f") + (with-temp-buffer + (insert-file-contents-literally file) + (lua-ts-send-region (point-min) (point-max)))) + +(defun lua-ts-send-region (beg end) + "Send region between BEG and END to the inferior Lua process." + (interactive "r") + (let ((string (buffer-substring-no-properties beg end)) + (proc-buffer (lua-ts-inferior-lua))) + (comint-send-string proc-buffer "print()") ; Prevent output from + (comint-send-string proc-buffer "\n") ; appearing at prompt. + (comint-send-string proc-buffer string) + (comint-send-string proc-buffer "\n"))) + +(defun lua-ts-show-process-buffer () + "Show the inferior Lua process buffer." + (interactive) + (display-buffer lua-ts-inferior-buffer)) + +(defun lua-ts-hide-process-buffer () + "Hide the inferior Lua process buffer." + (interactive) + (delete-windows-on lua-ts-inferior-buffer)) + +(defun lua-ts-kill-process () + "Kill the inferior Lua process." + (interactive) + (with-current-buffer lua-ts-inferior-buffer + (kill-buffer-and-window))) + +(defun lua-ts-inferior--write-history (process _) + "Write history file for inferior Lua PROCESS." + ;; Depending on how the process is killed the buffer may not be + ;; around anymore; e.g. `kill-buffer'. + (when-let* ((buffer (process-buffer process)) + ((buffer-live-p (process-buffer process)))) + (with-current-buffer buffer (comint-write-input-ring)))) + +(defvar lua-ts-mode-map + (let ((map (make-sparse-keymap "Lua"))) + (define-key map "\C-c\C-n" 'lua-ts-inferior-lua) + (define-key map "\C-c\C-c" 'lua-ts-send-buffer) + (define-key map "\C-c\C-l" 'lua-ts-send-file) + (define-key map "\C-c\C-r" 'lua-ts-send-region) + map) + "Keymap for `lua-ts-mode' buffers.") + +(easy-menu-define lua-ts-mode-menu lua-ts-mode-map + "Menu bar entry for `lua-ts-mode'." + `("Lua" + ["Evaluate Buffer" lua-ts-send-buffer] + ["Evaluate File" lua-ts-send-file] + ["Evaluate Region" lua-ts-send-region] + "--" + ["Start Process" lua-ts-inferior-lua] + ["Show Process Buffer" lua-ts-show-process-buffer] + ["Hide Process Buffer" lua-ts-hide-process-buffer] + ["Kill Process" lua-ts-kill-process] + "--" + ["Customize" (lambda () (interactive) (customize-group "lua-ts"))])) ;;;###autoload (define-derived-mode lua-ts-mode prog-mode "Lua" - "Major mode for editing Lua files, powered by tree-sitter." + "Major mode for editing Lua files, powered by tree-sitter. + +\\{lua-ts-mode-map}" :syntax-table lua-ts--syntax-table + (use-local-map lua-ts-mode-map) (when (treesit-ready-p 'lua) (treesit-parser-create 'lua) @@ -404,20 +655,39 @@ lua-ts-mode (rx (or "function_declaration" "function_definition"))) (setq-local treesit-thing-settings `((lua - (sentence ,(rx (or "do_statement" - "field" - "for_statement" - "function_call" - "if_statement" - "repeat_statement" - "return_statement" - "variable_declaration" - "while_statement"))) - (sexp ,(rx (or "arguments" - "block" - "parameters" - "string" - "table_constructor"))) + (function ,(rx (or "function_declaration" + "function_definition"))) + (keyword ,(regexp-opt lua-ts--keywords + 'symbols)) + (loop-statement ,(rx (or "do_statement" + "for_statement" + "repeat_statement" + "while_statement"))) + (sentence (or function + loop-statement + ,(rx (or "assignment_statement" + "comment" + "field" + "function_call" + "if_statement" + "return_statement" + "variable_declaration")))) + (sexp (or function + keyword + loop-statement + ,(rx (or "arguments" + "break_statement" + "expression_list" + "false" + "identifier" + "nil" + "number" + "parameters" + "parenthesized_expression" + "string" + "table_constructor" + "true" + "vararg_expression")))) (text "comment")))) ;; Imenu. diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts index 040225c8580..9797467bbe5 100644 --- a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts @@ -5,148 +5,675 @@ Code: (lua-ts-mode) (indent-region (point-min) (point-max))) -Name: Basic Indent +Name: Chunk Indent =-= - print( -0, - 1 -) + print(1) + print(2) +=-= +print(1) +print(2) +=-=-= -local function f(o) - if o.x > o.y then - return o.x -elseif o.y > o.z then - return o.y - else -return o.z - end +Name: Function Indent + +=-= +function f1(n) +print(n) +return n + 1 end -f({ - x = 1, - y = 2, - z = 3, -}) +local function f2(n) +print(n) +return n * 2 +end -;(function() -return false -)() +local f3 = function(n) +print(n) +return n / 3 +end + +function f4(...) +local f = function (...) +if ok +then print(1) +else print(0) +end +end +return f +end + +function f5(...) +local f = function (...) +if ok +then +print(1) +else +print(0) +end +end +return f +end + +function f6(...) +local f = function (...) +if ok then +print(1) +else +print(0) +end +end +return f +end + +;(function () + return true + end)() =-= -print( - 0, - 1 -) +function f1(n) + print(n) + return n + 1 +end -local function f(o) - if o.x > o.y then - return o.x - elseif o.y > o.z then - return o.y - else - return o.z +local function f2(n) + print(n) + return n * 2 +end + +local f3 = function(n) + print(n) + return n / 3 +end + +function f4(...) + local f = function (...) + if ok + then print(1) + else print(0) + end end + return f end -f({ - x = 1, - y = 2, - z = 3, -}) +function f5(...) + local f = function (...) + if ok + then + print(1) + else + print(0) + end + end + return f +end + +function f6(...) + local f = function (...) + if ok then + print(1) + else + print(0) + end + end + return f +end -;(function() - return false -)() +;(function () + return true +end)() =-=-= -Name: Argument Indent +Name: Conditional Indent =-= -function h( -string, -number, -options) -print(string, number, options) +if true then +print(true) +return 1 +elseif false then +print(false) +return -1 +else +print(nil) +return 0 end -local p = h( -"sring", - 1000, - { -cost = 2, -length = 8, - parallelism = 4, -}) +if true + then + print(true) + return 1 + elseif false + then + print(false) + return -1 + else + print(nil) + return 0 +end + +if true + then return 1 + elseif false + then return -1 + else return 0 +end =-= -function h( - string, - number, - options) - print(string, number, options) +if true then + print(true) + return 1 +elseif false then + print(false) + return -1 +else + print(nil) + return 0 end -local p = h( - "sring", - 1000, - { - cost = 2, - length = 8, - parallelism = 4, - }) +if true +then + print(true) + return 1 +elseif false +then + print(false) + return -1 +else + print(nil) + return 0 +end + +if true +then return 1 +elseif false +then return -1 +else return 0 +end =-=-= -Name: Continuation Indent +Name: Loop Indent =-= +for k,v in pairs({}) do + print(k) + print(v) +end + +for i=1,10 + do print(i) +end + +while n < 10 do + n = n + 1 + print(n) +end + +while n < 10 + do + n = n + 1 + print(n) +end + +for i=0,9 do +repeat n = n+1 + until n > 99 +end + +repeat +z = z * 2 +print(z) +until z > 12 + + for i,x in ipairs(t) do + while i < 9 + do + local n = t[x] + repeat n = n + 1 + until n > #t + while n < 99 + do + print(n) + end + end + print(t[i]) + end + +do +local a = b +print(a + 1) +end +=-= +for k,v in pairs({}) do + print(k) + print(v) +end + +for i=1,10 +do print(i) +end + +while n < 10 do + n = n + 1 + print(n) +end + +while n < 10 +do + n = n + 1 + print(n) +end + +for i=0,9 do + repeat n = n+1 + until n > 99 +end + +repeat + z = z * 2 + print(z) +until z > 12 + +for i,x in ipairs(t) do + while i < 9 + do + local n = t[x] + repeat n = n + 1 + until n > #t + while n < 99 + do + print(n) + end + end + print(t[i]) +end + +do + local a = b + print(a + 1) +end +=-=-= + +Name: Bracket Indent + +=-= +fn( + ) + +tb={ + } +=-= +fn( +) + +tb={ +} +=-=-= + +Name: Multi-line String Indent + +=-= +local s = [[ + Multi-line + string content + ]] + function f() local str = [[ multi-line string ]] ---[[ -multi-line -comment - ]] return true end =-= +local s = [[ + Multi-line + string content + ]] + function f() local str = [[ multi-line string ]] - --[[ + return true +end +=-=-= + +Name: Multi-line Comment Indent + +=-= +--[[ + Multi-line + comment content + ]] + +function f() +--[[ +multi-line + comment + ]] + return true +end +=-= +--[[ + Multi-line + comment content + ]] + +function f() +--[[ multi-line -comment + comment ]] return true end =-=-= -Name: Loop Indent +Name: Argument Indent + +=-= + h( + "string", + 1000 + ) + +local p = h( +"string", + 1000 +) + +fn(1, +2, + 3) + +fn( 1, 2, +3, 4 ) + +f({ +x = 1, +y = 2, +z = 3, +}) + +f({ x = 1, +y = 2, +z = 3, }) + +Test({ +a=1 +}) + +Test({ +a = 1, +b = 2, +}, +nil) +=-= +h( + "string", + 1000 +) + +local p = h( + "string", + 1000 +) + +fn(1, + 2, + 3) + +fn( 1, 2, + 3, 4 ) + +f({ + x = 1, + y = 2, + z = 3, +}) + +f({ x = 1, + y = 2, + z = 3, }) + +Test({ + a=1 +}) + +Test({ + a = 1, + b = 2, + }, + nil) +=-=-= + +Name: Parameter Indent =-= -for k, v in pairs({}) do - print(k, v) +function f1( +a, +b +) +print(a,b) end -while n < 10 do -n = n + 1 +local function f2(a, + b) +print(a,b) end -repeat -z = z * 2 - until z > 12 +local f3 = function( a, b, + c, d ) +print(a,b,c,d) +end =-= -for k, v in pairs({}) do - print(k, v) +function f1( + a, + b +) + print(a,b) end -while n < 10 do - n = n + 1 +local function f2(a, + b) + print(a,b) end -repeat - z = z * 2 -until z > 12 +local f3 = function( a, b, + c, d ) + print(a,b,c,d) +end +=-=-= + +Name: Table Indent + +=-= +local Other = { + First={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Second={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Third={up={Goto=true}, + down={Goto=true}, + left={Goto=true}, + right={Goto=true}} +} + +local Other = { +a = 1, + b = 2, + c = 3, +} +=-= +local Other = { + First={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Second={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Third={up={Goto=true}, + down={Goto=true}, + left={Goto=true}, + right={Goto=true}} +} + +local Other = { + a = 1, + b = 2, + c = 3, +} +=-=-= + +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq lua-ts-indent-offset 4) + (lua-ts-mode) + (indent-region (point-min) (point-max))) + +Name: End Indent + +=-= +function f(x) + for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end end end end + return {x,y} or {math.random(),math.random()} + end + +for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end + end end end +=-= +function f(x) + for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end end end end + return {x,y} or {math.random(),math.random()} +end + +for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end +end end end +=-=-= + +Name: Nested Function Indent + +=-= +function a(...) + return (function (x) + return x + end)(foo(...)) +end + +function b(n) + local x = 1 + return function (i) + return function (...) + return (function (n, ...) + return function (f, ...) + return (function (...) + if ... and x < 9 then + x = x + 1 + return ... + end end)(n(f, ...)) + end, ... + end)(i(...)) +end end end + +function c(f) + local f1 = function (...) + if nil ~= ... then + return f(...) + end + end + return function (i) + return function (...) + local fn = function (n, ...) + local x = function (f, ...) + return f1(n(f, ...)) + end + return x + end + return fn(i(...)) + end + end +end + +function d(f) + local f1 = function (c, f, ...) + if ... then + if f(...) then + return ... + else + return c(f, ...) + end end end + return function (i) + return function (...) + return (function (n, ...) + local function j (f, ...) + return f1(j, f, n(f, ...)) + end + return j, ... + end)(i(...)) +end end end + +function e (n, t) + return function (i) + return function (...) + return ( + function (n, ...) + local x, y, z = 0, {} + return (function (f, ...) + return (function (i, ...) return i(i, ...) end)( + function (i, ...) + return f(function (x, ...) + return i(i, ...)(x, ...) + end, ...) + end) + end)(function (j) + return function(f, ...) + return (function (c, f, ...) + if ... then + if n+1 == x then + local y1, x1 = y, x + y, x = {}, 0 + return (function (...) + z = ... + return ... + end)(t(y1-1, x1-1, ...)) + else + x = x - 1 + return c(f, + (function (...) + z = ... + return ... + end)(t(y, x, ...))) + end + elseif x ~= 0 then + x = 0 + return z, y + end end)(j, f, n(f, ...)) + end end), ... + end)(i(...)) +end end end =-=-= diff --git a/test/lisp/progmodes/lua-ts-mode-resources/movement.erts b/test/lisp/progmodes/lua-ts-mode-resources/movement.erts index 770aa23b18d..11e86f12926 100644 --- a/test/lisp/progmodes/lua-ts-mode-resources/movement.erts +++ b/test/lisp/progmodes/lua-ts-mode-resources/movement.erts @@ -147,7 +147,7 @@ end| print(1) =-=-= -Name: forward-sentence moves over for statements +Name: forward-sentence moves over do statements =-= |do @@ -417,34 +417,6 @@ Code: Point-Char: | -Name: forward-sexp moves over blocks - -=-= -local function Test() - |local t = { - a = 1, - } - - if true then - print(1) - else - print(0) - end -end -=-= -local function Test() - local t = { - a = 1, - } - - if true then - print(1) - else - print(0) - end| -end -=-=-= - Name: forward-sexp moves over arguments =-= @@ -481,41 +453,91 @@ local t = { 1, 3 }| =-=-= -Code: - (lambda () - (lua-ts-mode) - (backward-sexp 1)) +Name: forward-sexp moves over parenthesized expressions -Point-Char: | +=-= +|(function (x) return x + 1 end)(41) +=-= +(function (x) return x + 1 end)|(41) +=-=-= -Name: backward-sexp moves over blocks +Name: forward-sexp moves over function declarations =-= -local function Test() - local t = { - a = 1, - } +|function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end +=-= +function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end| +=-=-= - if true then - print(1) - else - print(0) - end| +Name: forward-sexp moves over do statements + +=-= +|do + print(a + 1) end =-= -local function Test() - |local t = { - a = 1, - } +do + print(a + 1) +end| +=-=-= - if true then - print(1) - else - print(0) - end +Name: forward-sexp moves over for statements + +=-= +|for k,v in pairs({}) do + print(k, v) +end +=-= +for k,v in pairs({}) do + print(k, v) +end| +=-=-= + +Name: forward-sexp moves over repeat statements + +=-= +|repeat + n = n + 1 +until n > 10 +=-= +repeat + n = n + 1 +until n > 10| +=-=-= + +Name: forward-sexp moves over while statements + +=-= +|while n < 99 +do + n = n+1 end +=-= +while n < 99 +do + n = n+1 +end| =-=-= +Code: + (lambda () + (lua-ts-mode) + (backward-sexp 1)) + +Point-Char: | + Name: backward-sexp moves over arguments =-= @@ -551,3 +573,31 @@ local t = |{ 1, 2, 3 } =-=-= + +Name: backward-sexp moves over parenthesized expressions + +=-= +(function (x) return x + 1 end)|(41) +=-= +|(function (x) return x + 1 end)(41) +=-=-= + +Name: backward-sexp moves over function declarations + +=-= +function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end| +=-= +|function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end +=-=-= commit 731dd5f92efc9b5ba96b3f77369910527b6d84b5 Author: Po Lu Date: Mon Oct 23 08:03:49 2023 +0000 ; * doc/lispref/frames.texi (X Selections): Fix typo. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 14f6f09ee71..5203e2ae7da 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4111,8 +4111,8 @@ X Selections Similarly, a program does not ``get'' selection data from the X server. Instead, its selection requests are sent to the client with -the window which last asserted ownership over the selection, which -which is expected to respond with the requested data. +the window which last asserted ownership over the selection, which is +expected to respond with the requested data. Each selection request incorporates three parameters: commit 2cb3dea72b7b48162a6702270dd3896a0f19cb4b Author: Po Lu Date: Mon Oct 23 05:30:14 2023 +0000 Correctly register Num Lock keys under Haiku * src/haiku_support.cc (DispatchMessage): If B_NUM_LOCK is set, invert B_SHIFT_KEY; should it be subsequently set, omit mapping from raw_char. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 3fc90385af3..33ad5889043 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1059,6 +1059,8 @@ my_team_id (void) msg->FindInt64 ("when", &rq.time); rq.modifiers = 0; + rq.keysym = 0; + uint32_t mods = modifiers (); if (mods & B_SHIFT_KEY) @@ -1073,10 +1075,39 @@ my_team_id (void) if (mods & B_OPTION_KEY) rq.modifiers |= HAIKU_MODIFIER_SUPER; - ret = keysym_from_raw_char (raw, key, &rq.keysym); + /* mods & B_SHIFT_KEY should be inverted if keycode is + situated in the numeric keypad and Num Lock is set, for + this transformation is not effected on key events + themselves. */ + + if (mods & B_NUM_LOCK) + { + switch (key) + { + case 0x37: + case 0x38: + case 0x39: + case 0x48: + case 0x49: + case 0x4a: + case 0x58: + case 0x59: + case 0x5a: + case 0x64: + case 0x65: + mods ^= B_SHIFT_KEY; + + /* If shift is set at this juncture, map these keys to + the digits they represent. Because raw is not + affected by Num Lock, keysym_from_raw_char will map + this to the keysym yielded by this key in the + absence of any modifiers. */ + if (mods & B_SHIFT_KEY) + goto map_keysym; + } + } - if (!ret) - rq.keysym = 0; + ret = keysym_from_raw_char (raw, key, &rq.keysym); if (ret < 0) return; @@ -1087,6 +1118,7 @@ my_team_id (void) { if (mods & B_SHIFT_KEY) { + map_keysym: if (mods & B_CAPS_LOCK) map_caps_shift (key, &rq.multibyte_char); else commit db96cdcc8d82d559322d6a985c834374b97cbd84 Author: Gerd Möllmann Date: Mon Oct 23 07:27:04 2023 +0200 Fix LLDB prompt in Gud when attached * lisp/progmodes/gud.el (gud-lldb-marker-filter): Fix the prompt by replacing multiple spaces with one. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 02a1597340b..d3064b6116c 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3886,7 +3886,13 @@ gud-lldb-marker-filter string) (setq gud-last-last-frame nil) (setq gud-overlay-arrow-position nil))) - string) + ;; While being attached to a process, LLDB emits control sequences, + ;; even if TERM is "dumb". This is the case in at least LLDB + ;; version 14 to 17. The control sequences are filtered out by + ;; Emacs after this process filter runs, but LLDB also prints an + ;; extra space after the prompt, which we fix here. + (replace-regexp-in-string (rx "(lldb)" (group (1+ blank)) "\e[8") + " " string nil nil 1)) ;; According to SBCommanInterpreter.cpp, the return value of ;; HandleCompletions is as follows: commit d33a72e8d745931d76dffaa3ea66bbc935ad00b9 Author: Po Lu Date: Mon Oct 23 02:32:09 2023 +0000 Further improve documentation concerning selections * doc/lispref/frames.texi (Window System Selections): Replace incomplete attempts to address selection data types in this node with references to Accessing Selections. (Accessing Selections, X Selections): Revise for clarity and pithiness. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a561c456222..14f6f09ee71 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4003,22 +4003,24 @@ Window System Selections @cindex secondary selection In window systems, such as X, data can be transferred between -different applications by means of @dfn{selections}. X defines an -arbitrary number of @dfn{selection types}, each of which can store its -own data; however, only three are commonly used: the @dfn{clipboard}, -@dfn{primary selection}, and @dfn{secondary selection}. Other window -systems support only the clipboard. @xref{Cut and Paste,, Cut and -Paste, emacs, The GNU Emacs Manual}, for Emacs commands that make use -of these selections. This section documents the low-level functions -for reading and setting window-system selections. +different applications by means of @dfn{selections}. Each window +system defines an arbitrary number of @dfn{selection types}, all +storing their own data; however, only three are commonly used: the +@dfn{clipboard}, @dfn{primary selection}, and @dfn{secondary +selection}. @xref{Cut and Paste,, Cut and Paste, emacs, The GNU Emacs +Manual}, for Emacs commands that make use of these selections. This +section documents the low-level functions for reading and setting +window-system selections; @xref{Accessing Selections} for +documentation concerning selection types and data formats under +particular window systems. @deffn Command gui-set-selection type data This function sets a window-system selection. It takes two arguments: a selection type @var{type}, and the value to assign to it, @var{data}. @var{type} should be a symbol; it is usually one of @code{PRIMARY}, -@code{SECONDARY} or @code{CLIPBOARD}. These are symbols with -upper-case names, in accord with X Window System conventions. If +@code{SECONDARY} or @code{CLIPBOARD}. These are generally symbols +with upper-case names, in accord with X Window System conventions. If @var{type} is @code{nil}, that stands for @code{PRIMARY}. If @var{data} is @code{nil}, it means to clear out the selection. @@ -4046,15 +4048,8 @@ Window System Selections The @var{data-type} argument specifies the form of data conversion to use, to convert the raw data obtained from another program into Lisp -data. Meaningful values include @code{TEXT}, @code{STRING}, -@code{UTF8_STRING}, @code{TARGETS}, @code{LENGTH}, @code{DELETE}, -@code{FILE_NAME}, @code{CHARACTER_POSITION}, @code{NAME}, -@code{LINE_NUMBER}, @code{COLUMN_NUMBER}, @code{OWNER_OS}, -@code{HOST_NAME}, @code{USER}, @code{CLASS}, @code{ATOM}, and -@code{INTEGER}. (These are symbols with upper-case names in accord -with X conventions.) The default for @var{data-type} is -@code{STRING}. Window systems other than X usually support only a -small subset of these types, in addition to @code{STRING}. +data. @xref{X Selections} for an enumeration of data types valid +under X, and @xref{Other Selections} for those elsewhere. @end defun @defopt selection-coding-system @@ -4064,13 +4059,6 @@ Window System Selections converts to the text representation that X11 normally uses. @end defopt -@cindex clipboard support (for MS-Windows) -When Emacs runs on MS-Windows, it does not implement X selections in -general, but it does support the clipboard. @code{gui-get-selection} -and @code{gui-set-selection} on MS-Windows support the text data type -only; if the clipboard holds other types of data, Emacs treats the -clipboard as empty. The supported data type is @code{STRING}. - For backward compatibility, there are obsolete aliases @code{x-get-selection} and @code{x-set-selection}, which were the names of @code{gui-get-selection} and @code{gui-set-selection} before @@ -4079,27 +4067,25 @@ Window System Selections @node Accessing Selections @section Accessing Selections - @code{gui-get-selection} is able to retrieve multiple different -kinds of selection data from any number of selections. However, the -data types and selections that Emacs understands is not precisely -specified and differs depending on the window system on which Emacs is -running. - - At the same time, @code{gui-set-selection} hides a great deal of -complexity behind its back, at least on some systems: its @var{data} -argument need not be a string, but is actually given verbatim to -system specific code. - - Emacs's implementation of selections is most complete on the X -Window System. This is both an artifact of history (X was the first -window system supported by Emacs) and one of technical reasons: -instead of using selections only to transfer text and multimedia -content between clients, X uses selections as a general inter-client -communication system, leading to a great proliferation of selection -data types. - - Even more confusingly, X also supports another inter-client -communication mechanism: the Inter-Client Exchange. However, ICE is + The data types and selections that @code{gui-get-selection} and +@code{gui-set-selection} understand are not precisely specified and +differ subject to the window system on which Emacs is running. + + At the same time, @code{gui-set-selection} abstracts over plenty of +complexity: its @var{data} argument is given verbatim to +system-specific code to be rendered suitable for transfer to the +window system or requesting clients. + + The most comprehensive implementation of selections is that under +the X Window System. This is both an artifact of history (X was the +first window system supported by Emacs) and one occasioned by +technical considerations: X selections are not merely an expedient for +the transfer of text and multimedia content between clients, but a +general inter-client communication system, a design that has yielded a +proliferation of selection and data types. + + Compounding this confusion, there is another inter-client +communication mechanism under X: the Inter-Client Exchange. ICE is only used by Emacs to communicate with session managers, and is a separate topic. @@ -4111,12 +4097,12 @@ Accessing Selections @node X Selections @subsection X Selections - X refrains from defining fixed data types for selection data, or a -fixed number of selections. Selections are instead identified by X -``atoms'', which are unique 29-bit identifiers issued by the X server -for a corresponding name. In Emacs, you can simply write a symbol -with the name of the atom, and Emacs will transparently request these -identifiers where necessary. + X refrains from defining fixed data types for selection data or a +fixed number of selections. Selections are identified by X ``atoms'', +which are unique 29-bit identifiers issued by the X server for string +names. This complexity is hidden by Emacs: when Lisp provides a +symbol whose name is that of the atom, Emacs will request these +identifiers without further intervention. When a program ``sets'' a selection under X, it actually makes itself the ``owner'' of the selection---the X server will then deliver @@ -4125,27 +4111,29 @@ X Selections Similarly, a program does not ``get'' selection data from the X server. Instead, its selection requests are sent to the client with -the window which last took ownership over the selection, which then -replies with the requested data. +the window which last asserted ownership over the selection, which +which is expected to respond with the requested data. - Each selection request contains three parameters: + Each selection request incorporates three parameters: @itemize @bullet @item -The window which requested the selection; this is used to identify the +The window which requested the selection, which identifies the @c Not a typo: X spells ``requestor'' with an o. requesting program, otherwise known as the @dfn{requestor}. @item -An atom identifying the ``target'' to which the owner should convert +An atom identifying the @dfn{target} to which the owner should convert the selection. It is easiest to think of the conversion target as the kind of data that the requestor wants: in selection requests made by -Emacs, the target is determined by the @dfn{type} argument to +Emacs, the target is determined by the @var{type} argument to @code{gui-get-selection}. @item -A 32-bit timestamp containing the X server time at which the requestor -last obtained input. +A 32-bit timestamp representing the X server time at which the +requestor last received input; this parameter is not relevant to Lisp +code, for it's only meant to abet synchronization between the X +server, owner and requestor. @end itemize The selection owner responds by tranferring to the requestor a @@ -4157,30 +4145,29 @@ X Selections returns. By default, Emacs converts selection data consisting of any series -of bytes to a unibyte string containing those bytes, selection data -consisting of a single 16-bit or 32-bit word as an unsigned number, -and selection data consisting of multiple such words as a vector of -unsigned numbers. However, Emacs applies special treatment for -several selection data types: +of bytes to a unibyte string holding those bytes, that consisting of a +single 16-bit or 32-bit word as an unsigned number, and that +consisting of multiple such words as a vector of unsigned numbers. +However, Emacs applies special treatment for data from the following +conversion targets: @table @code @item INTEGER -16-bit or 32-bit words of this type are treated as signed integers, -instead of unsigned ones. If there are multiple words in the -selection data, a vector is returned; otherwise, the integer is -returned by itself. +16-bit or 32-bit words of this type are treated as signed rather than +unsigned integers. If there are multiple words in the selection data, +a vector is returned; otherwise, the integer is returned by itself. @item ATOM 32-bit words of this type are treated as X atoms, and returned (either -alone or as vectors) as Lisp symbols containing the names they -identify. Invalid atoms are returned as @code{nil}. +alone or as vectors) as Lisp symbols by the names they identify. +Invalid atoms are replaced by @code{nil}. @item COMPOUND_TEXT @item UTF8_STRING @item STRING -Unibyte strings returned for these data types will have a single -@code{foreign-selection} text property set to a symbol with the type -of the selection data. +A single @code{foreign-selection} text property set to the type of the +selection data will be placed in unibyte strings derived from a +request for these data types. @end table Each selection owner must return at least two selection targets: @@ -4191,21 +4178,21 @@ X Selections Consortium's @url{http://x.org/releases/X11R7.6/doc/xorg-docs/specs/ICCCM/icccm.html, Inter-Client Communication Conventions Manual}, while others, such as -@code{UTF8_STRING}, were supposed to be standardized by the XFree86 -Project, which unfortunately did not happen. +@code{UTF8_STRING}, were meant to be standardized by the XFree86 +Project, but their standardization was never completed. Requests for a given selection target may, by convention, return data in a specific type, or it may return data in one of several types, whichever is most convenient for the selection owner; the latter type of selection target is dubbed a @dfn{polymorphic target}. -A selection target may also return no data at all: by convention, the -selection owner performs some action a side effect upon responding to -a selection request with that target, and as such these targets are -referred to as @dfn{side-effect targets}. +In response to a request, a selection target may also return no data +at all, whereafter the selection owner executes some action as a side +effect. Targets that are thus replied to are termed @dfn{side-effect +targets}. - Here are some selection targets which behave in a reasonably -standard manner when used with the @code{CLIPBOARD}, @code{PRIMARY}, -or @code{SECONDARY} selections. + Here are some selection targets whose behavior is generally +consistent with a standard when requested from the @code{CLIPBOARD}, +@code{PRIMARY}, or @code{SECONDARY} selections. @table @code @item ADOBE_PORTABLE_DOCUMENT_FORMAT @@ -4271,7 +4258,7 @@ X Selections @item MODULE This target returns the name of any function containing the selection -data. It is mainly used by text editors. +data. It is principally requested by text editors. @item STRING This target returns the selection data as a string of type @@ -4303,17 +4290,18 @@ X Selections When a request for the targets @code{STRING}, @code{COMPOUND_TEXT}, or @code{UTF8_STRING} is made using the function @code{gui-get-selection}, and neither @code{selection-coding-system} -nor @code{next-selection-coding-system} are set, the returned strings -are additionally decoded using the appropriate coding system for those -data types: @code{iso-8859-1}, @code{compound-text-with-extensions} -and @code{utf-8} respectively. +nor @code{next-selection-coding-system} is set, the resultant strings +are decoded by the proper coding systems for those targets: +@code{iso-8859-1}, @code{compound-text-with-extensions} and +@code{utf-8} respectively. In addition to the targets specified above (and the many targets used by various programs for their own purposes), several popular -programs and toolkits have decided to define selection data types of -their own, without consulting the appropriate X standards bodies. -These targets are usually named after MIME types, such as -@code{text/html} or @code{image/jpeg}, and have been known to contain: +programs and toolkits have defined selection data types of their own, +without consulting the appropriate X standards bodies. These targets +are generally named after such MIME types as @code{text/html} or +@code{image/jpeg}; they have been witnessed returning the following +forms of data: @itemize @bullet @item @@ -4324,54 +4312,56 @@ X Selections Image or text data in the appropriate format. @item -@code{file://} URIs (or possibly newline or NUL terminated lists of -URIs) leading to files in the appropriate format. +@code{file://} URIs (or conceivably newline or NUL terminated lists of +URIs) identifying files in the appropriate format. @end itemize These selection targets were first used by Netscape, but are now -found in all kinds of programs, especially those based on recent +proffered by all kinds of programs, especially those based on recent versions of the GTK+ or Qt toolkits. - Emacs is also capable of acting as a selection owner. When -@code{gui-set-selection} is called, the selection data specified is -not transferred to the X server; instead, Emacs records it internally -and obtains ownership of the selection. + Emacs is also capable of serving as a selection owner. When +@code{gui-set-selection} is called, the selection data provided is +recorded internally and Emacs obtains ownership of the selection being +set. @defvar selection-converter-alist - Alist of selection targets to ``selection converter'' functions. -When a selection request is received, Emacs looks up the selection -converter associated with the requested selection target. +Alist of selection targets to ``selection converter'' functions. When +a selection request is received, Emacs looks up the selection +converter pertaining to the requested selection target. - The selection converter is called with three arguments: the symbol +Selection converters are called with three arguments: the symbol corresponding to the atom identifying the selection being requested, the selection target that is being requested, and the value set with -@code{gui-set-selection}. The value which it returns is either a cons -of a symbol specifying the data type and a number, symbol, or a vector -of numbers or symbols, or its cdr by itself. +@code{gui-set-selection}. The values which they must return are +either conses of symbols designating the data type and numbers, +symbols, vectors of numbers or symbols, or the cdrs of such conses by +themselves. - If the value is the special symbol @code{NULL}, the data type is set -to @code{NULL}, and no data is returned to the requestor. +If a selection converter's value is the special symbol @code{NULL}, +the data type returned to its requestor is set to @code{NULL}, and no +data is sent in response. - If the value is a string, it must be a unibyte string; should no -data type be explicitly specified, the data is transferred to the +If such a value is a string, it must be a unibyte string; should no +data type be explicitly specified, the data is transferred to its requestor with the type @code{STRING}. - If the value is a symbol, its ``atom'' is retrieved, and it is -transferred to the requestor as a 32-bit value---if no data type was -specified, its type is @code{ATOM}. +If it is a symbol, its ``atom'' is retrieved, and it is transferred to +its requestor as a 32-bit value---if no data type is specified, its +type is @code{ATOM}. - If the value is a number between @code{-32769} and @code{32768}, it -is transferred to the requestor as a 16 bit value---if no data type -was specified, its type is @code{INTEGER}. +If it is a number between @code{-32769} and @code{32768}, it is +transferred to its requestor as a 16 bit value---if no data type is +specified, its type is @code{INTEGER}. - If the value is any other number, it is returned as a 32 bit value. -Even if the number returned is unsigned, the requestor will treat -words of type @code{INTEGER} as signed. To return an unsigned value, -specify the type @code{CARDINAL} instead. +If it is any other number, it is accounted a 32 bit value. Even if +the number returned is unsigned, its requestor will treat words of +type @code{INTEGER} as signed. To return an unsigned value, specify +the type @code{CARDINAL} in its place. - If the value is a vector of symbols or numbers, it is returned as a -list of multiple atoms or numbers. The data type returned by default -is determined by that of its first element. +If it is a vector of symbols or numbers, the response to its requestor +will be a list of multiple atoms or numbers. The data type returned +when not expressly set is that of the list's first element. @end defvar By default, Emacs is configured with selection converters for the @@ -4481,7 +4471,7 @@ X Selections @end table With the exception of @code{INTEGER}, all selection converters -expect the value given to @code{gui-set-selection} to be one of the +expect the data provided to @code{gui-set-selection} to be one of the following: @itemize @bullet commit cfc796f6f24efd7cbc0dcac07f8eccd5200236bd Author: Antero Mejr Date: Sun Oct 15 00:32:57 2023 +0000 Add completion for 'doas' to pcomplete * lisp/pcmpl-unix.el (pcomplete/doas): New function. * etc/NEWS: Announce. (Bug#66551) Co-authored-by: Visuwesh diff --git a/etc/NEWS b/etc/NEWS index a3639620ebb..d0880669752 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -491,6 +491,10 @@ When this option is non-nil, remote file names are not completed by Pcomplete. Packages, like 'shell-mode', could set this in order to suppress remote file name completion at all. +--- +*** Completion for the 'doas' command has been added. +Command completion for 'doas' in Eshell and Shell mode will now work. + ** Shell Mode +++ diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index e6b67256a4c..7af5f2bce74 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -685,6 +685,14 @@ pcomplete/sudo (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) pcomplete-default-completion-function))) +;;;###autoload +(defun pcomplete/doas () + "Completion for the `doas' command." + (pcomplete-opt "C(pcomplete-entries)Lnsu(pcmpl-unix-user-names)") + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + (provide 'pcmpl-unix) ;;; pcmpl-unix.el ends here commit 43127294e13af293369d710301b3a028ad4d53c3 Author: Morgan J. Smith Date: Sun Oct 22 21:43:46 2023 +0200 Fix typo in url-privacy-level :type * lisp/url/url-vars.el (url-privacy-level): Fix typo in :type. (Bug#66613) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index ef4b8b2841b..630de7f4e43 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -146,7 +146,7 @@ url-privacy-level (const :tag "Emacs version" :value emacs) (const :tag "Last location" :value lastloc) (const :tag "Browser identification" :value agent) - (const :tag "No cookies" :value cookie))) + (const :tag "No cookies" :value cookies))) :group 'url) (defcustom url-lastloc-privacy-level 'domain-match commit 380f8574ef58722d5b89dccd149c348131694271 Author: Juri Linkov Date: Sun Oct 22 20:59:52 2023 +0300 * lisp/vc/log-view.el (log-view-mode-menu): Quote derived modes (bug#66686). diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index e6eb6a5b973..af24fcfd398 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -163,14 +163,14 @@ log-view-mode-menu :help "Go to the previous count'th log message"] ["Next File" log-view-file-next :help "Go to the next count'th file" - :active (derived-mode-p vc-cvs-log-view-mode - vc-rcs-log-view-mode - vc-sccs-log-view-mode)] + :active (derived-mode-p 'vc-cvs-log-view-mode + 'vc-rcs-log-view-mode + 'vc-sccs-log-view-mode)] ["Previous File" log-view-file-prev :help "Go to the previous count'th file" - :active (derived-mode-p vc-cvs-log-view-mode - vc-rcs-log-view-mode - vc-sccs-log-view-mode)])) + :active (derived-mode-p 'vc-cvs-log-view-mode + 'vc-rcs-log-view-mode + 'vc-sccs-log-view-mode)])) (defvar log-view-mode-hook nil "Hook run at the end of `log-view-mode'.") commit 9be8011217b8824659c8c69679b33756e240b013 Author: Mauro Aranda Date: Sat Oct 21 11:02:36 2023 -0300 Allow specifying the dir locals file to edit (Bug#66663) * lisp/files-x.el (modify-dir-local-variable): Take a 5th optional argument, the filename of the dir locals file to modify. (read-dir-locals-file): New function. (add-dir-local-variable, delete-dir-local-variable) (copy-file-locals-to-dir-locals): Optionally read the filename to modify, and pass it to modify-dir-local-variable. * etc/NEWS: Announce the change. * doc/emacs/custom.texi (Directory Variables): Document the new functionality. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 8c30f26bbf7..adecc873163 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1507,7 +1507,13 @@ Directory Variables entry defining the directory-local variable. @kbd{M-x delete-dir-local-variable} deletes an entry. @kbd{M-x copy-file-locals-to-dir-locals} copies the file-local variables in the -current file into @file{.dir-locals.el}. +current file into @file{.dir-locals.el}, or @file{.dir-locals-2.el} if +that file is also present. + +With a prefix argument, all three commands prompt for the file you +want to modify. Although it doesn't have to exist, you must enter a +valid filename, either @file{.dir-locals.el} or +@file{.dir-locals-2.el}. @findex dir-locals-set-class-variables @findex dir-locals-set-directory-class diff --git a/etc/NEWS b/etc/NEWS index 5d42d88fb60..a3639620ebb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -187,6 +187,11 @@ right-aligned to is controlled by the new user option It can be used to add, remove and reorder functions that change the appearance of every tab on the tab bar. ++++ +** New optional argument for modifying directory local variables +The commands 'add-dir-local-variable', 'delete-dir-local-variable' and +'copy-file-locals-to-dir-locals' now take an optional prefix argument, +to enter the file you want to modify. ** Miscellaneous --- @@ -1358,6 +1363,11 @@ Their 'noerror' arguments have no effect and are therefore obsolete. When supplied with ':default-language LANGUAGE', rules after it will default to use 'LANGUAGE'. +--- +** New optional argument to 'modify-dir-local-variable' +A 5th argument, optional, has been added to +'modify-dir-local-variable'. It can be used to specify which +dir-locals file to modify. * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/files-x.el b/lisp/files-x.el index 3ba7632d253..f6fbd44ce21 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -31,6 +31,8 @@ ;;; Code: (eval-when-compile (require 'subr-x)) ; for string-trim-right +(declare-function dosified-file-name "dos-fns" (file-name)) +(declare-function project-root "project" (project)) ;;; Commands to add/delete file-local/directory-local variables. @@ -410,7 +412,7 @@ delete-file-local-variable-prop-line (defvar auto-insert) ; from autoinsert.el -(defun modify-dir-local-variable (mode variable value op) +(defun modify-dir-local-variable (mode variable value op &optional file) "Modify directory-local VARIABLE in .dir-locals.el depending on operation OP. If OP is `add-or-replace' then delete all existing settings of @@ -422,28 +424,37 @@ modify-dir-local-variable this file in the current directory. If OP is `delete' then delete all existing settings of VARIABLE -from the MODE alist ignoring the input argument VALUE." +from the MODE alist ignoring the input argument VALUE. + +Optional argument FILE, when non-nil, specifies what file to modify. It +should be an expanded filename." (catch 'exit (unless enable-local-variables (throw 'exit (message "Directory-local variables are disabled"))) - (let* ((dir-or-cache (and (buffer-file-name) - (not (file-remote-p (buffer-file-name))) - (dir-locals-find-file (buffer-file-name)))) - (variables-file - ;; If there are several .dir-locals, the user probably - ;; wants to edit the last one (the highest priority). - (cond ((stringp dir-or-cache) - (car (last (dir-locals--all-files dir-or-cache)))) - ((consp dir-or-cache) ; result from cache - ;; If cache element has an mtime, assume it came - ;; from a file. Otherwise, assume it was set - ;; directly. - (if (nth 2 dir-or-cache) - (car (last (dir-locals--all-files (car dir-or-cache)))) - (cadr dir-or-cache))) - ;; Try to make a proper file-name. - (t (expand-file-name dir-locals-file)))) - variables) + (let ((variables-file + (if (stringp file) + file + (let ((dir-or-cache + (and (buffer-file-name) + (not (file-remote-p (buffer-file-name))) + (dir-locals-find-file (buffer-file-name))))) + ;; If there are several .dir-locals, the user probably + ;; wants to edit the last one (the highest priority). + (cond + ((stringp dir-or-cache) + (car (last (dir-locals--all-files dir-or-cache)))) + ((consp dir-or-cache) ; result from cache + ;; If cache element has an mtime, assume it came + ;; from a file. Otherwise, assume it was set + ;; directly. + (if (nth 2 dir-or-cache) + (car (last (dir-locals--all-files (car dir-or-cache)))) + (cadr dir-or-cache))) + ;; Try to make a proper file-name. + (t (expand-file-name (if (eq system-type 'ms-dos) + (dosified-file-name dir-locals-file) + dir-locals-file))))))) + variables) ;; I can't be bothered to handle this case right now. ;; Dir locals were set directly from a class. You need to ;; directly modify the class in dir-locals-class-alist. @@ -527,33 +538,75 @@ dir-locals-to-string (cdr mode-variables) "\n")))) variables "\n"))) +(defun read-dir-locals-file () + "Read a dir-locals filename using completion. +Intended to be used in the `interactive' spec of `add-dir-local-variable', +`delete-dir-local-variable' and `copy-file-locals-to-dir-locals'. + +Returns the filename, expanded." + (let* ((pri dir-locals-file) + (sec (replace-regexp-in-string ".el$" "-2.el" dir-locals-file)) + (dir (or (locate-dominating-file default-directory pri) + (locate-dominating-file default-directory sec)))) + (expand-file-name + (read-file-name + "File: " + (cond (dir) + ((when-let ((proj (and (featurep 'project) (project-current)))) + (project-root proj)))) + nil + (lambda (fname) + (member (file-name-nondirectory fname) (list pri sec))) + dir-locals-file)))) + ;;;###autoload -(defun add-dir-local-variable (mode variable value) - "Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el." +(defun add-dir-local-variable (mode variable value &optional file) + "Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el. + +With a prefix argument, prompt for the file to modify. + +When called from Lisp, FILE may be the expanded name of the dir-locals file +where to add VARIABLE." (interactive (let (variable) (list (read-file-local-variable-mode) (setq variable (read-file-local-variable "Add directory-local variable")) - (read-file-local-variable-value variable)))) - (modify-dir-local-variable mode variable value 'add-or-replace)) + (read-file-local-variable-value variable) + (when current-prefix-arg + (read-dir-locals-file))))) + (modify-dir-local-variable mode variable value 'add-or-replace file)) ;;;###autoload -(defun delete-dir-local-variable (mode variable) - "Delete all MODE settings of file-local VARIABLE from .dir-locals.el." +(defun delete-dir-local-variable (mode variable &optional file) + "Delete all MODE settings of dir-local VARIABLE from .dir-locals.el. + +With a prefix argument, prompt for the file to modify. + +When called from Lisp, FILE may be the expanded name of the dir-locals file +from where to delete VARIABLE." (interactive (list (read-file-local-variable-mode) - (read-file-local-variable "Delete directory-local variable"))) - (modify-dir-local-variable mode variable nil 'delete)) + (read-file-local-variable "Delete directory-local variable") + (when current-prefix-arg + (read-dir-locals-file)))) + (modify-dir-local-variable mode variable nil 'delete file)) ;;;###autoload -(defun copy-file-locals-to-dir-locals () - "Copy file-local variables to .dir-locals.el." - (interactive) +(defun copy-file-locals-to-dir-locals (&optional file) + "Copy file-local variables to .dir-locals.el. + +With a prefix argument, prompt for the file to modify. + +When called from Lisp, FILE may be the expanded name of the dir-locals file +where to copy the file-local variables." + (interactive + (list (when current-prefix-arg + (read-dir-locals-file)))) (dolist (elt file-local-variables-alist) (unless (assq (car elt) dir-local-variables-alist) - (add-dir-local-variable major-mode (car elt) (cdr elt))))) + (add-dir-local-variable major-mode (car elt) (cdr elt) file)))) ;;;###autoload (defun copy-dir-locals-to-file-locals () commit f39cd59ed477628be20353bf921b0afb423165b9 Author: Petteri Hintsanen Date: Sun Oct 22 20:40:35 2023 +0300 * lisp/tab-bar.el: Fix the close button with auto-width (bug#66678). (tab-bar-auto-width): Take into account the length of tab-bar-close-button more than one character: " x". diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index d2815c03ebf..e21367255a0 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1227,7 +1227,9 @@ tab-bar-auto-width ((< prev-width width) (let* ((space (apply #'propertize " " (text-properties-at 0 name))) - (ins-pos (- len (if close-p 1 0))) + (ins-pos (- len (if close-p + (length tab-bar-close-button) + 0))) (prev-name name)) (while continue (setq name (concat (substring name 0 ins-pos) commit 5d1e6f759f29f3404c5a8f48cca66a08400b9d67 Author: Petteri Hintsanen Date: Sun Oct 22 20:39:16 2023 +0300 * lisp/tab-bar.el: Fix the close button with auto-width (bug#66678). (tab-bar-auto-width): Take into account the length of tab-bar-close-button more than one character: " x". Don't merge to master. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 17fc4b346cb..7a493ddde0d 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1091,7 +1091,9 @@ tab-bar-auto-width ((< prev-width width) (let* ((space (apply 'propertize " " (text-properties-at 0 name))) - (ins-pos (- len (if close-p 1 0))) + (ins-pos (- len (if close-p + (length tab-bar-close-button) + 0))) (prev-name name)) (while continue (setf (substring name ins-pos ins-pos) space) commit 5f60913208f3fb2df9a2d3bda1655e01075bf446 Author: Mauro Aranda Date: Thu Oct 19 08:46:35 2023 -0300 Fix State button for customize-icon (Bug#66635) * lisp/cus-edit.el (custom-icon-action): New function. (custom-icon): Use it as the :action. Otherwise, clicking the State button is a noop. Remove irrelevant stuff from the docstring and comment out some copy-pasta. (custom-icon-extended-menu): New variable, the menu to show upon :action. (custom-icon-set): Really redraw the widget with the new settings. Comment out strange call to custom-variable-backup-value. (custom-icon-save): New function. * lisp/emacs-lisp/icons.el (icons--merge-spec): Fix call to plist-get and avoid infloop. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 9ec10e63221..75d7d3ffaad 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -5332,11 +5332,6 @@ 'custom-icon :hidden-states should be a list of widget states for which the widget's initial contents are to be hidden. -:custom-form should be a symbol describing how to display and - edit the variable---either `edit' (using edit widgets), - `lisp' (as a Lisp sexp), or `mismatch' (should not happen); - if nil, use the return value of `custom-variable-default-form'. - :shown-value, if non-nil, should be a list whose `car' is the variable value to display in place of the current value. @@ -5349,11 +5344,34 @@ 'custom-icon :custom-category 'option :custom-state nil :custom-form nil - :value-create 'custom-icon-value-create + :value-create #'custom-icon-value-create :hidden-states '(standard) - :custom-set 'custom-icon-set - :custom-reset-current 'custom-redraw - :custom-reset-saved 'custom-variable-reset-saved) + :action #'custom-icon-action + :custom-set #'custom-icon-set + :custom-reset-current #'custom-redraw) + ;; Not implemented yet. + ;; :custom-reset-saved 'custom-icon-reset-saved) + +(defvar custom-icon-extended-menu + (let ((map (make-sparse-keymap))) + (define-key-after map [custom-icon-set] + '(menu-item "Set for Current Session" custom-icon-set + :enable (eq (widget-get custom-actioned-widget :custom-state) + 'modified))) + (when (or custom-file init-file-user) + (define-key-after map [custom-icon-save] + '(menu-item "Save for Future Sessions" custom-icon-save + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed))))) + (define-key-after map [custom-redraw] + '(menu-item "Undo Edits" custom-redraw + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified changed)))) + map) + "A menu for `custom-icon' widgets. +Used in `custom-icon-action' to show a menu to the user.") (defun custom-icon-value-create (widget) "Here is where you edit the icon's specification." @@ -5483,6 +5501,24 @@ custom-icon-value-create (custom-add-parent-links widget)) (custom-add-see-also widget))))) +(defun custom-icon-action (widget &optional event) + "Show the menu for `custom-icon' WIDGET. +Optional EVENT is the location for the menu." + (if (eq (widget-get widget :custom-state) 'hidden) + (custom-toggle-hide widget) + (unless (eq (widget-get widget :custom-state) 'modified) + (custom-icon-state-set widget)) + (custom-redraw-magic widget) + (let* ((completion-ignore-case t) + (custom-actioned-widget widget) + (answer (widget-choose (concat "Operation on " + (custom-unlispify-tag-name + (widget-get widget :value))) + custom-icon-extended-menu + event))) + (when answer + (funcall answer widget))))) + (defun custom-toggle-hide-icon (visibility-widget &rest _ignore) "Toggle the visibility of a `custom-icon' parent widget. By default, this signals an error if the parent has unsaved @@ -5519,10 +5555,21 @@ custom-icon-set (user-error "Cannot update hidden icon")) (setq val (custom--icons-widget-value child)) - (unless (equal val (icon-complete-spec symbol)) - (custom-variable-backup-value widget)) + ;; FIXME: What was the intention here? + ;; (unless (equal val (icon-complete-spec symbol)) + ;; (custom-variable-backup-value widget)) (custom-push-theme 'theme-icon symbol 'user 'set val) - (custom-redraw-magic widget))) + (custom-redraw widget))) + +(defun custom-icon-save (widget) + "Save value of icon edited by widget WIDGET." + (custom-set-icons (cons (widget-value widget) + (list + (custom--icons-widget-value + (car (widget-get widget :children)))))) + (custom-save-all) + (custom-icon-state-set widget) + (custom-redraw-magic widget)) ;;;###autoload (defun customize-icon (icon) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index cb08c1a6b81..9a6d26243c7 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -181,9 +181,9 @@ icons--merge-spec (let ((parent-keywords (icon-spec-keywords elem)) (current-keywords (icon-spec-keywords current))) (while parent-keywords - (unless (plist-get (car parent-keywords) current-keywords) - (nconc current (take 2 parent-keywords)) - (setq parent-keywords (cddr parent-keywords)))))))) + (unless (plist-get current-keywords (car parent-keywords)) + (nconc current (take 2 parent-keywords))) + (setq parent-keywords (cddr parent-keywords))))))) merged) (cl-defmethod icons--create ((_type (eql 'image)) icon keywords) commit 4ff0c738d050942932e73c627a7d6e31ca5c6244 Author: Po Lu Date: Sun Oct 22 19:43:27 2023 +0800 Further improve selection-related documentation * doc/lispref/frames.texi (Other Selections): Expand documentation regarding Haiku selections, and some non-substantive copy edits elsewhere. Introduce more indexing. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 3589bc35f4f..a561c456222 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4506,10 +4506,11 @@ Other Selections selection that records drag-and-drop data also available under Nextstep and Haiku. - GTK itself seeks to emulate the X selection system, but its -emulations are not altogether dependable, with their overall quality -subject to the GDK backend being used. While Emacs built with PGTK -will supply the same selection interface as Emacs built with X, many +@cindex PGTK selections + GTK seeks to emulate the X selection system, but its emulations are +not altogether dependable, with the overall quality of each subject to +the GDK backend being used. Therefore, Emacs built with PGTK will +supply the same selection interface as Emacs built with X, but many selection targets will not be useful. @cindex MS-Windows selection emulation @@ -4528,14 +4529,14 @@ Other Selections value, which is not subject to further examination (such as type checks and the like). Under such circumstances, @var{data-type} argument is generally disregarded. (But see below for the -qualification concerning @code{TARGETS}.) +qualification regarding @code{TARGETS}.) @cindex MS-Windows clipboard Where the clipboard selection is concerned (whenever @var{type} is @code{CLIPBOARD}), @code{gui-set-selection} verifies that the value provided is a string and saves it within the system clipboard once it is encoded by the coding system configured in -@var{selection-coding-system}. Callers of @code{gui-get-selection} +@code{selection-coding-system}. Callers of @code{gui-get-selection} are required to set @var{data-type} to either @code{STRING} or @code{TARGETS}. @@ -4577,33 +4578,31 @@ Other Selections The @code{XdndSelection} selection is also present under Nextstep, in the form of a repository that records values supplied to @code{gui-set-selection}. Its sole purpose is to save such values for -the benefit of the fundamental drag-and-drop function -@code{x-begin-drag} (@pxref{Drag and Drop}); no guarantees exist -concerning its value when read by anything else. - - On Haiku, Emacs supports the same selection values as on X@. In -addition, Emacs fully implements the primary and secondary selections. -However, instead of taking ownership over the selection data, Emacs -transfers the selection data to the window server when -@code{gui-set-selection} is called. The Haiku window server expects -selection data to be provided in the form of a ``message'', containing -associations between data types and selection data. +the fundamental drag-and-drop function @code{x-begin-drag} +(@pxref{Drag and Drop}); no guarantees exist concerning its value when +read by anything else. -@defvar haiku-normal-selection-encoders -List of functions which act as selection encoders. When -@code{gui-set-selection} is called, each function in this list is -successively called with its @var{selection} and @var{value} -arguments. If the function returns non-@code{nil}, it should return a -list of the form @w{@code{(@var{key} @var{type} @var{value})}}, where -@var{key} is the name of the data type being transferred, @var{type} -is either a number identifying a data type (in which case @var{value} -should be a unibyte string that is directly transferred to the window -server), or a symbol identifying both a data type and how @var{value} -should be interpreted. -@end defvar +@cindex Haiku selections + Selections on Haiku systems comprise all three selections customary +under X and the @code{XdndSelection} that records drag-and-drop data. - Here are the meaningful values of @var{type}, and what they will -cause Emacs to interpret @var{value} as: + When @code{gui-set-selection} is called for the former three +selections, the data supplied is converted into a window server +``message'' by a list of @dfn{selection encoder} functions, which is +sent to the window server. + +@defvar haiku-normal-selection-encoders +List of selection encoder functions. When @code{gui-set-selection} is +called, each function in this list is successively called with its +@var{selection} and @var{value} arguments. If such a function returns +non-@code{nil}, its return value must be a list of the form +@w{@code{(@var{key} @var{type} @var{value})}}. In this list, +@var{key} must be the name of the data being transferred, generally +that of a MIME type, for example @samp{"text/plain"}, and @var{type} +is a symbol or a number designating the type of the data, thus also +governing the interpretation of @var{value}; following is a list of +valid data types and how each of them will cause @var{value} to be +interpreted. @table @code @item string @@ -4611,8 +4610,8 @@ Other Selections the message. @item ref -A file name. The file is looked up and file system information -identifying the file is placed in the message. +A file name. The file is located and the inode identifying the file +is placed in the message. @item short A 16-bit integer value. @@ -4645,16 +4644,33 @@ Other Selections @item (haiku-numeric-enum MIME) A unibyte string containing data in a certain MIME type. @end table +@end defvar + + A call to @code{gui-get-selection} generally returns the the data +named @var{data-type} within the selection message, albeit with +@var{data-type} replaced by an alternative name should it be one of +the following X selection targets: + +@table @code +@item STRING +This represents Latin-1 text under X: ``text/plain;charset=iso-8859-1'' + +@item UTF8_STRING +This represents UTF-8 text: ``text/plain'' +@end table + + If @var{data-type} is a text type such as @code{STRING} or a MIME +type matching the pattern @samp{`text/*}, the string data is decoded +with the coding system apposite for it before being returned. - Under Haiku, @code{gui-get-selection} accepts either the targets -@code{TARGETS} and @code{TIMESTAMP}, where the former returns a vector -containing supported data types (much like on X), and the latter -returns the number of times the selection has been set, the targets -@code{STRING} and @code{UTF8_STRING}, which return text in ISO-Latin-1 -and UTF-8 format, or a MIME type, in which the data is returned -undecoded as a unibyte string. + Furthermore, the two data types @var{TIMESTAMP} and @code{TARGETS} +are afforded special treatment; the value returned for the first is +the number of times the selection has been modified since system +startup (@emph{not} a timestamp), and that for the other is a vector +of available selection data types, as elsewhere. - Under Android, @code{gui-get-selection} is restricted to returning +@cindex Android selections + Under Android, @code{gui-get-selection} is capable of returning UTF-8 string data of the type @code{STRING}, or image and application data associated with a MIME type. @code{gui-set-selection} will only set string data, as on MS-Windows. commit 27c71979ff11c4a6c433f4cd6f7a390124c5fc3d Author: Eli Zaretskii Date: Sun Oct 22 14:05:53 2023 +0300 ; Another Texinfo fix * doc/lispintro/emacs-lisp-intro.texi (Counting function definitions): Fix Texinfo 7.1 warning. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index fce7583fe91..c5b33ac5eaa 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -15793,6 +15793,7 @@ Counting function definitions @c colon in printed section title causes problem in Info cross reference This way, we avoid an error. + @iftex @noindent (For information about @code{and}, see commit 889a550ca0847679bc96547c14622e239eb93f91 Author: Eli Zaretskii Date: Sun Oct 22 12:21:08 2023 +0300 ; Fix Texinfo warnings * doc/misc/wisent.texi (Grammar format): * doc/misc/efaq.texi (Not writing files to the current directory): * doc/misc/ede.texi: * doc/lispref/errors.texi (Standard Errors): Fix warnings emitted by makeinfo 7.1. diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index db46a6aaf59..4eafe608302 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -246,7 +246,8 @@ Standard Errors interaction function (like @code{read-from-minibuffer}) is called. @end table -@ignore The following seem to be unused now. +@c The following seem to be unused now. +@ignore The following kinds of error, which are classified as special cases of @code{arith-error}, can occur on certain systems for invalid use of mathematical functions. @xref{Math Functions}. diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index d49d2296aa7..b4f08b7c4b9 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -1515,7 +1515,8 @@ ede-project @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-project-placeholder}. +@item ede-project-placeholder +@xref{ede-project-placeholder}. @table @code @item ede-project @table @asis @@ -1801,9 +1802,11 @@ ede-cpp-root-project @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-project-placeholder}. +@item ede-project-placeholder +@xref{ede-project-placeholder}. @table @code -@item @xref{ede-project}. +@item ede-project +@xref{ede-project}. @table @code @item ede-cpp-root-project No children @@ -1923,9 +1926,11 @@ ede-simple-project @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-project-placeholder}. +@item ede-project-placeholder +@xref{ede-project-placeholder}. @table @code -@item @xref{ede-project}. +@item ede-project +@xref{ede-project}. @table @code @item ede-simple-project No children @@ -1953,9 +1958,11 @@ ede-simple-base-project @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-project-placeholder}. +@item ede-project-placeholder +@xref{ede-project-placeholder}. @table @code -@item @xref{ede-project}. +@item ede-project +@xref{ede-project}. @table @code @item ede-simple-base-project No children @@ -1983,9 +1990,11 @@ ede-proj-project @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-project-placeholder}. +@item ede-project-placeholder +@xref{ede-project-placeholder}. @table @code -@item @xref{ede-project}. +@item ede-project +@xref{ede-project}. @table @code @item ede-proj-project No children @@ -2173,9 +2182,11 @@ project-am-makefile @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-project-placeholder}. +@item ede-project-placeholder +@xref{ede-project-placeholder}. @table @code -@item @xref{ede-project}. +@item ede-project +@xref{ede-project}. @table @code @item project-am-makefile No children @@ -2215,9 +2226,11 @@ ede-step-project @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-project-placeholder}. +@item ede-project-placeholder +@xref{ede-project-placeholder}. @table @code -@item @xref{ede-project}. +@item ede-project +@xref{ede-project}. @table @code @item ede-step-project No children @@ -2577,7 +2590,8 @@ ede-proj-target @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code @item ede-proj-target @table @asis @@ -2766,9 +2780,11 @@ ede-proj-target-makefile @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code @item ede-proj-target-makefile @table @asis @@ -2864,11 +2880,14 @@ semantic-ede-proj-target-grammar @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code @item semantic-ede-proj-target-grammar No children @@ -2918,11 +2937,14 @@ ede-proj-target-makefile-objectcode @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code @item ede-proj-target-makefile-objectcode @table @asis @@ -2980,13 +3002,17 @@ ede-proj-target-makefile-archive @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code -@item @xref{ede-proj-target-makefile-objectcode}. +@item ede-proj-target-makefile-objectcode +@xref{ede-proj-target-makefile-objectcode}. @table @code @item ede-proj-target-makefile-archive No children @@ -3023,13 +3049,17 @@ ede-proj-target-makefile-program @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code -@item @xref{ede-proj-target-makefile-objectcode}. +@item ede-proj-target-makefile-objectcode +@xref{ede-proj-target-makefile-objectcode}. @table @code @item ede-proj-target-makefile-program @table @asis @@ -3102,15 +3132,20 @@ ede-proj-target-makefile-shared-object @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code -@item @xref{ede-proj-target-makefile-objectcode}. +@item ede-proj-target-makefile-objectcode +@xref{ede-proj-target-makefile-objectcode}. @table @code -@item @xref{ede-proj-target-makefile-program}. +@item ede-proj-target-makefile-program +@xref{ede-proj-target-makefile-program}. @table @code @item ede-proj-target-makefile-shared-object No children @@ -3162,11 +3197,14 @@ ede-proj-target-elisp @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code @item ede-proj-target-elisp @table @asis @@ -3238,13 +3276,17 @@ ede-proj-target-elisp-autoloads @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code -@item @xref{ede-proj-target-elisp}. +@item ede-proj-target-elisp +@xref{ede-proj-target-elisp}. @table @code @item ede-proj-target-elisp-autoloads No children @@ -3353,11 +3395,14 @@ ede-proj-target-makefile-miscelaneous @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code @item ede-proj-target-makefile-miscelaneous No children @@ -3409,11 +3454,14 @@ ede-proj-target-makefile-info @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code -@item @xref{ede-proj-target-makefile}. +@item ede-proj-target-makefile +@xref{ede-proj-target-makefile}. @table @code @item ede-proj-target-makefile-info No children @@ -3495,9 +3543,11 @@ ede-proj-target-scheme @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{ede-proj-target}. +@item ede-proj-target +@xref{ede-proj-target}. @table @code @item ede-proj-target-scheme No children @@ -3539,7 +3589,8 @@ project-am-target @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code @item project-am-target @table @asis @@ -3577,9 +3628,11 @@ project-am-objectcode @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{project-am-target}. +@item project-am-target +@xref{project-am-target}. @table @code @item project-am-objectcode @table @asis @@ -3622,11 +3675,14 @@ project-am-program @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{project-am-target}. +@item project-am-target +@xref{project-am-target}. @table @code -@item @xref{project-am-objectcode}. +@item project-am-objectcode +@xref{project-am-objectcode}. @table @code @item project-am-program No children @@ -3660,9 +3716,11 @@ project-am-header-noinst @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{project-am-target}. +@item project-am-target +@xref{project-am-target}. @table @code @item @w{project-am-header.} @table @code @@ -3693,9 +3751,11 @@ project-am-header-inst @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{project-am-target}. +@item project-am-target +@xref{project-am-target}. @table @code @item @w{project-am-header.} @table @code @@ -3726,9 +3786,11 @@ project-am-lisp @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{project-am-target}. +@item project-am-target +@xref{project-am-target}. @table @code @item project-am-lisp No children @@ -3756,9 +3818,11 @@ project-am-texinfo @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{project-am-target}. +@item project-am-target +@xref{project-am-target}. @table @code @item project-am-texinfo No children @@ -3808,9 +3872,11 @@ project-am-man @table @code @item eieio-speedbar-directory-button @table @code -@item @xref{ede-target}. +@item ede-target +@xref{ede-target}. @table @code -@item @xref{project-am-target}. +@item project-am-target +@xref{project-am-target}. @table @code @item project-am-man No children @@ -4071,7 +4137,8 @@ ede-compiler @table @code @item eieio-instance-inheritor @table @code -@item @xref{ede-compilation-program}. +@item ede-compilation-program +@xref{ede-compilation-program}. @table @code @item ede-compiler @table @asis @@ -4179,9 +4246,11 @@ ede-object-compiler @table @code @item eieio-instance-inheritor @table @code -@item @xref{ede-compilation-program}. +@item ede-compilation-program +@xref{ede-compilation-program}. @table @code -@item @xref{ede-compiler}. +@item ede-compiler +@xref{ede-compiler}. @table @code @item ede-object-compiler No children @@ -4222,7 +4291,8 @@ ede-linker @table @code @item eieio-instance-inheritor @table @code -@item @xref{ede-compilation-program}. +@item ede-compilation-program +@xref{ede-compilation-program}. @table @code @item ede-linker No children diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index db754a6dd0d..3dfa337c9a9 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2832,9 +2832,12 @@ Not writing files to the current directory changing the locations of all these files. @table @code -@item auto-save-file-name-transforms (@pxref{Auto-Saving,,,elisp, GNU Emacs Lisp Reference Manual}). -@item lock-file-name-transforms (@pxref{File Locks,,,elisp, GNU Emacs Lisp Reference Manual}). -@item backup-directory-alist (@pxref{Making Backups,,,elisp, GNU Emacs Lisp Reference Manual}). +@item auto-save-file-name-transforms +(@pxref{Auto-Saving,,,elisp, GNU Emacs Lisp Reference Manual}). +@item lock-file-name-transforms +(@pxref{File Locks,,,elisp, GNU Emacs Lisp Reference Manual}). +@item backup-directory-alist +(@pxref{Making Backups,,,elisp, GNU Emacs Lisp Reference Manual}). @end table For instance, to write all these things to diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi index 9f82af45203..c0cb1c99c58 100644 --- a/doc/misc/octave-mode.texi +++ b/doc/misc/octave-mode.texi @@ -146,9 +146,7 @@ Using Octave Mode @findex octave-insert-defun Insert a function skeleton, prompting for the function's name, arguments and return values which have to be entered without parentheses -(@code{octave-insert-defun}). -@noindent -in one of your Emacs startup files. +(@code{octave-insert-defun}) in one of your Emacs startup files. @end table The following variables can be used to customize Octave mode. diff --git a/doc/misc/wisent.texi b/doc/misc/wisent.texi index 2d9fedadcc5..e1fee10d954 100644 --- a/doc/misc/wisent.texi +++ b/doc/misc/wisent.texi @@ -383,7 +383,8 @@ Grammar format level of the given terminal to a rule. @cindex semantic actions -@item @anchor{action}action +@anchor{action} +@item action An action is an optional Emacs Lisp function call, like this: @code{(identity $1)} commit ae337884107c4d5f66aaceef0e8b548565317412 Author: Po Lu Date: Sun Oct 22 07:54:50 2023 +0000 Revise documentation concerning selections outside X * doc/lispref/frames.texi (Accessing Selections, X Selections): Correct markup, averting the recognition of X followed by a sentence stop as an acronym. (Other Selections): Relate the nature of the MS-Windows selection emulation, how it functions, and its deficiencies. Clarify paragraphs concerning PGTK and Nextstep. * doc/misc/efaq.texi (Emacs in a Linux console): * doc/misc/use-package.texi (Conditional loading): Correct markup, averting the recognition of X followed by a sentence stop as an acronym. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 75bc4de4f61..3589bc35f4f 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4104,7 +4104,7 @@ Accessing Selections separate topic. @menu -* X Selections:: Selection data types (and more) on X. +* X Selections:: Selection data types (and more) on X@. * Other Selections:: How they work on other window systems. @end menu @@ -4497,28 +4497,68 @@ X Selections @node Other Selections @subsection Other Selections - Window systems such as MS-Windows, Nextstep, Haiku and Android do -not provide selections corresponding to the X semantics. Each window -system provides its own ad-hoc emulation of selections, none of which -make use of the ``selection converter'' mechanism described above. In -addition, only the @code{PRIMARY}, @code{CLIPBOARD}, and -@code{SECONDARY} selections are typically supported, alongside the -@code{XdndSelection} used for drag-and-drop operations. - - GTK itself exposes emulations of X selections to applications, but -those emulations are of varying completeness. While Emacs built with -PGTK will use the same selection interface as Emacs built with X, many + Selections under such window systems as MS-Windows, Nextstep, Haiku +and Android are not aligned with those under X@. Each of these window +system improvises its own selection mechanism without employing the +``selection converter'' mechanism illustrated in the preceeding node. +Only the @code{PRIMARY}, @code{CLIPBOARD}, and @code{SECONDARY} +selections are generally supported, with the @code{XdndSelection} +selection that records drag-and-drop data also available under +Nextstep and Haiku. + + GTK itself seeks to emulate the X selection system, but its +emulations are not altogether dependable, with their overall quality +subject to the GDK backend being used. While Emacs built with PGTK +will supply the same selection interface as Emacs built with X, many selection targets will not be useful. - On MS-Windows, @code{gui-get-selection} accepts a single target, -@code{STRING}. The value returned is the selection data decoded -using @code{selection-coding-system}. - - @code{gui-set-selection} also only accepts strings, encodes them -in the selection coding system, and saves them to the clipboard. - - On Nextstep, Emacs only supports saving strings to selections. -However, requests for the following targets are accepted: +@cindex MS-Windows selection emulation +@cindex MS-Windows primary and secondary selection + Although a clipboard exists, there is no concept of primary or +secondary selections within the MS-Windows operating system. On this +system, Emacs simulates the presence of a primary and secondary +selection, while saving to and retrieving from the clipboard when so +requested. + + The simulation of the primary and secondary selections is conducted +by saving values supplied to @code{gui-set-selection} within the +@code{x-selections} property of the symbol designating the pertinent +selection, namely the @var{type} argument to @code{gui-get-selection}. +Each subsequent call to @code{gui-get-selection} in turn returns its +value, which is not subject to further examination (such as type +checks and the like). Under such circumstances, @var{data-type} +argument is generally disregarded. (But see below for the +qualification concerning @code{TARGETS}.) + +@cindex MS-Windows clipboard + Where the clipboard selection is concerned (whenever @var{type} is +@code{CLIPBOARD}), @code{gui-set-selection} verifies that the value +provided is a string and saves it within the system clipboard once it +is encoded by the coding system configured in +@var{selection-coding-system}. Callers of @code{gui-get-selection} +are required to set @var{data-type} to either @code{STRING} or +@code{TARGETS}. + + When @var{data-type} is set to @code{TARGETS} in a call to +@code{gui-get-selection}, a vector of symbols is returned when +selection data exists, much as it is under X@. It is impossible to +request clipboard data in any format besides @code{STRING}, for the +prerequisite data conversion routines are absent. Just as strings +saved into the clipboard are encoded by the +@code{selection-coding-system}, so those read from the clipboard are +decoded by that same coding system; this variable and its cousin +@code{next-selection-coding-system} merit particular scrutiny when +difficulties are encountered with saving selection text into the +clipboard. + +@cindex Nextstep selections + All three selections standard in X exist in Nextstep as well, but +Emacs is only capable of saving strings to such selections. +Restrictions imposed upon calls to @code{gui-set-selection} there are +much the same as those on MS-Windows, though text is uniformly encoded +as @code{utf-8-unix} without regard to the value of +@code{selection-coding-system}. @code{gui-get-selection} is more +charitable, and accepts requests for the following selection targets: @c FIXME: how is the text coding system determined, and do image/* or @c application/* return image data or file names? @@ -4534,7 +4574,14 @@ Other Selections @item image/tiff @end itemize - On Haiku, Emacs supports the same selection values as on X. In + The @code{XdndSelection} selection is also present under Nextstep, +in the form of a repository that records values supplied to +@code{gui-set-selection}. Its sole purpose is to save such values for +the benefit of the fundamental drag-and-drop function +@code{x-begin-drag} (@pxref{Drag and Drop}); no guarantees exist +concerning its value when read by anything else. + + On Haiku, Emacs supports the same selection values as on X@. In addition, Emacs fully implements the primary and secondary selections. However, instead of taking ownership over the selection data, Emacs transfers the selection data to the window server when diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 2fc8e60d400..d8097a8d21e 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3156,9 +3156,9 @@ Emacs in a Linux console If possible, we recommend running Emacs inside @command{fbterm}, when in a Linux console. This brings the Linux console on par with most -terminal emulators under X. To do this, install @command{fbterm}, for -example with the package manager of your GNU/Linux distribution, and -execute the command +terminal emulators under X@. To do this, install @command{fbterm}, +for example with the package manager of your GNU/Linux distribution, +and execute the command @example $ fbterm diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi index 55e56f7ce4e..4046c3a62ce 100644 --- a/doc/misc/use-package.texi +++ b/doc/misc/use-package.texi @@ -451,7 +451,7 @@ Conditional loading @item Window system -The example below loads a package only on macOS and X. See the +The example below loads a package only on macOS and X@. See the docstring of @code{window-system} for valid values. @lisp commit b446294faadef8f5d472aa13cb1c4f7faaf3e3cf Author: Eli Zaretskii Date: Sun Oct 22 08:20:38 2023 +0300 ; * src/keyboard.c (save_line_number_display_width): Fix last change. diff --git a/src/keyboard.c b/src/keyboard.c index 811ec252ef9..dc2f78a7c26 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5942,7 +5942,7 @@ save_line_number_display_width (struct input_event *event) else if (FRAMEP (event->frame_or_window)) w = XWINDOW (XFRAME (event->frame_or_window)->selected_window); else - emacs_abort (); + w = XWINDOW (selected_window); line_number_display_width (w, &down_mouse_line_number_width, &pixel_width); } commit 893c344b4e4787949f65c842536e0a5597e537c8 Author: Yuan Fu Date: Sat Oct 21 21:08:44 2023 -0700 Fix the use of adaptive-fill-regexp in treesit indent preset * lisp/treesit.el (treesit-simple-indent-presets): adaptive-fill-regexp don't have a capture group (the group in the default value is supposed to be a non-capture group), so don't use the group. Also, in the second diff hunk, replace looking-at with looking-at-p so it doesn't override match data that we use later. diff --git a/lisp/treesit.el b/lisp/treesit.el index 18a6131b71d..c37e7b6b5b7 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1217,8 +1217,10 @@ treesit-simple-indent-presets (goto-char bol) (setq this-line-has-prefix - (and (looking-at adaptive-fill-regexp) - (match-string 1))) + (and (looking-at-p adaptive-fill-regexp) + (not (string-match-p + (rx bos (* whitespace) eos) + (match-string 0))))) (forward-line -1) (and (>= (point) comment-start-bol) @@ -1226,7 +1228,7 @@ treesit-simple-indent-presets (looking-at adaptive-fill-regexp) ;; If previous line is an empty line, don't ;; indent. - (not (looking-at (rx (* whitespace) eol))) + (not (looking-at-p (rx (* whitespace) eol))) ;; Return the anchor. If the indenting line ;; has a prefix and the previous line also ;; has a prefix, indent to the beginning of commit 1098c114b74a3a4289550412795ff1c8533b45f7 Author: nverno Date: Sat Oct 21 19:54:10 2023 -0700 Fix treesit-install-language-grammar (bug#66673) * lisp/treesit.el (treesit-install-language-grammar): Take out the language symbol when storing the recipe. diff --git a/lisp/treesit.el b/lisp/treesit.el index fa375282d7c..18a6131b71d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2955,7 +2955,7 @@ treesit-install-language-grammar " "))) ;; If success, Save the recipe for the current session. (setf (alist-get lang treesit-language-source-alist) - recipe)))) + (cdr recipe))))) (error (display-warning 'treesit commit 491ee428c083038a8949f998fb4dd0c9ebb36895 Author: Yuan Fu Date: Sat Oct 21 20:34:07 2023 -0700 Fix treesit-explore-mode (bug#66431) * lisp/treesit.el (treesit-explore-mode): Reset treesit--explorer-last-node before calling treesit--explorer-refresh, so that in the rare case described in the bug report, the explorer buffer don't show the outdated node. diff --git a/lisp/treesit.el b/lisp/treesit.el index c4aba4c3e8d..fa375282d7c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2835,13 +2835,13 @@ treesit-explore-mode (treesit--explorer-tree-mode))) (display-buffer treesit--explorer-buffer (cons nil '((inhibit-same-window . t)))) + (setq-local treesit--explorer-last-node nil) (treesit--explorer-refresh) ;; Set up variables and hooks. (add-hook 'post-command-hook #'treesit--explorer-post-command 0 t) (add-hook 'kill-buffer-hook #'treesit--explorer-kill-explorer-buffer 0 t) - (setq-local treesit--explorer-last-node nil) ;; Tell `desktop-save' to not save explorer buffers. (when (boundp 'desktop-modes-not-to-save) (unless (memq 'treesit--explorer-tree-mode commit 6f87ee0e3a0727e16079778a4264e6e35cd7f3a8 Author: Po Lu Date: Sun Oct 22 09:06:28 2023 +0800 Enumerate default UVS glyphs * src/sfnt.c (sfnt_compare_unicode_value_range) (sfnt_is_character_default): New functions. (sfnt_test_uvs): Print and verify the default UVS table. * src/sfnt.h: Update prototypes. * src/sfntfont.c (sfntfont_get_variation_glyphs): Index the cmap with the default glyph, and insert it within VARIATIONS if character is present within a selector record's default UVS table. diff --git a/src/sfnt.c b/src/sfnt.c index 348cff604af..01d061be79c 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -12717,6 +12717,26 @@ sfnt_compare_uvs_mapping (const void *k, const void *v) return 1; } +/* Compare *(sfnt_char *) K to the Unicode value range V. */ + +static int +sfnt_compare_unicode_value_range (const void *k, const void *v) +{ + const sfnt_char *key; + const struct sfnt_unicode_value_range *value; + + key = k; + value = v; + + if (*key < value->start_unicode_value) + return -1; + else if ((*key - value->start_unicode_value + <= value->additional_count)) + return 0; + + return 1; +} + /* Return the ID of a variation glyph for the character C in the nondefault UVS mapping table UVS. @@ -12736,6 +12756,21 @@ sfnt_variation_glyph_for_char (struct sfnt_nondefault_uvs_table *uvs, return mapping ? mapping->base_character_value : 0; } +/* Return whether the character C is present in the default UVS + mapping table UVS. */ + +TEST_STATIC bool +sfnt_is_character_default (struct sfnt_default_uvs_table *uvs, + sfnt_char c) +{ + /* UVS->ranges comprises ranges of characters sorted in increasing + order; these ranges cannot overlap. */ + + return (bsearch (&c, uvs->ranges, uvs->num_unicode_value_ranges, + sizeof *uvs->ranges, + sfnt_compare_unicode_value_range) != NULL); +} + #if defined HAVE_MMAP && !defined TEST @@ -19191,10 +19226,11 @@ sfnt_pop_hook (struct sfnt_interpreter *interpreter, sfnt_test_uvs (int fd, struct sfnt_cmap_format_14 *format14) { struct sfnt_uvs_context *context; - size_t i, j; + size_t i, j, k; sfnt_glyph glyph; sfnt_char c; struct sfnt_nondefault_uvs_table *uvs; + struct sfnt_default_uvs_table *default_uvs; context = sfnt_create_uvs_context (format14, fd); @@ -19209,6 +19245,27 @@ sfnt_test_uvs (int fd, struct sfnt_cmap_format_14 *format14) for (i = 0; i < context->num_records; ++i) { + if (context->records[i].default_uvs) + { + default_uvs = context->records[i].default_uvs; + + for (j = 0; j < default_uvs->num_unicode_value_ranges; ++j) + { + fprintf (stderr, " Default UVS: %u, %u\n", + default_uvs->ranges[j].start_unicode_value, + default_uvs->ranges[j].additional_count); + + c = default_uvs->ranges[j].start_unicode_value; + k = 0; + + for (; k <= default_uvs->ranges[j].additional_count; ++k) + { + if (!sfnt_is_character_default (default_uvs, c + k)) + abort (); + } + } + } + if (!context->records[i].nondefault_uvs) continue; diff --git a/src/sfnt.h b/src/sfnt.h index 6602d240051..41c1f6f74e8 100644 --- a/src/sfnt.h +++ b/src/sfnt.h @@ -1526,6 +1526,12 @@ #define PROTOTYPE struct sfnt_nondefault_uvs_table *, sfnt_char #undef PROTOTYPE +#define PROTOTYPE struct sfnt_default_uvs_table *, sfnt_char + +extern bool sfnt_is_character_default (PROTOTYPE); + +#undef PROTOTYPE + #ifdef HAVE_MMAP diff --git a/src/sfntfont.c b/src/sfntfont.c index 2c58de31a16..35b37396ccd 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -3720,9 +3720,10 @@ sfntfont_get_variation_glyphs (struct font *font, int c, unsigned variations[256]) { struct sfnt_font_info *info; - size_t i; + size_t i, index; int n; struct sfnt_mapped_variation_selector_record *record; + sfnt_glyph default_glyph; info = (struct sfnt_font_info *) font; n = 0; @@ -3743,12 +3744,37 @@ sfntfont_get_variation_glyphs (struct font *font, int c, && info->uvs->records[i].selector < 0xfe00) ++i; + /* Get the glyph represented by C, used when C is present within a + default value table. */ + + default_glyph = sfntfont_lookup_glyph (info, c); + /* Fill in selectors 0 to 15. */ while (i < info->uvs->num_records && info->uvs->records[i].selector <= 0xfe0f) { record = &info->uvs->records[i]; + index = info->uvs->records[i].selector - 0xfe00 + 16; + + /* Handle invalid unsorted tables. */ + + if (record->selector < 0xfe00) + return 0; + + /* If there are default mappings in this record, ascertain if + this glyph matches one of them. */ + + if (record->default_uvs + && sfnt_is_character_default (record->default_uvs, c)) + { + variations[index] = default_glyph; + + if (default_glyph) + ++n; + + goto next_selector; + } /* If record has no non-default mappings, continue on to the next selector. */ @@ -3756,18 +3782,13 @@ sfntfont_get_variation_glyphs (struct font *font, int c, if (!record->nondefault_uvs) goto next_selector; - /* Handle invalid unsorted tables. */ - - if (record->selector < 0xfe00) - return 0; - /* Find the glyph ID associated with C and put it in VARIATIONS. */ - variations[info->uvs->records[i].selector - 0xfe00] + variations[index] = sfnt_variation_glyph_for_char (record->nondefault_uvs, c); - if (variations[info->uvs->records[i].selector - 0xfe00]) + if (variations[index]) ++n; next_selector: @@ -3787,6 +3808,26 @@ sfntfont_get_variation_glyphs (struct font *font, int c, && info->uvs->records[i].selector <= 0xe01ef) { record = &info->uvs->records[i]; + index = info->uvs->records[i].selector - 0xe0100 + 16; + + /* Handle invalid unsorted tables. */ + + if (record->selector < 0xe0100) + return 0; + + /* If there are default mappings in this record, ascertain if + this glyph matches one of them. */ + + if (record->default_uvs + && sfnt_is_character_default (record->default_uvs, c)) + { + variations[index] = default_glyph; + + if (default_glyph) + ++n; + + goto next_selector_1; + } /* If record has no non-default mappings, continue on to the next selector. */ @@ -3794,18 +3835,13 @@ sfntfont_get_variation_glyphs (struct font *font, int c, if (!record->nondefault_uvs) goto next_selector_1; - /* Handle invalid unsorted tables. */ - - if (record->selector < 0xe0100) - return 0; - /* Find the glyph ID associated with C and put it in VARIATIONS. */ - variations[info->uvs->records[i].selector - 0xe0100 + 16] + variations[index] = sfnt_variation_glyph_for_char (record->nondefault_uvs, c); - if (variations[info->uvs->records[i].selector - 0xe0100 + 16]) + if (variations[index]) ++n; next_selector_1: @@ -3841,7 +3877,7 @@ sfntfont_detect_sigbus (void *addr) return false; } -#endif +#endif /* HAVE_MMAP */ commit 8c15515b62cacae06dd3ced6492142ce185e5adb Author: Yuan Fu Date: Sat Oct 21 11:08:58 2023 -0700 ; * lisp/progmodes/js.el (js--treesit-sexp-nodes): Fix docstring. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 9ca6bee8454..6fd714940b6 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3854,7 +3854,7 @@ js--treesit-sexp-nodes "pair" "jsx") "Nodes that designate sexps in JavaScript. -See `treesit-sexp-type-regexp' for more information.") +See `treesit-thing-settings' for more information.") ;;;###autoload (define-derived-mode js-ts-mode js-base-mode "JavaScript" commit aa6cb4166174d2b7d601bb3dc6c2f03b5296a442 Author: Yuan Fu Date: Sat Oct 21 11:05:47 2023 -0700 Documentation for treesit-font-lock-rules change * doc/lispref/modes.texi (Parser-based Font Lock): Update manual. * lisp/treesit.el (treesit-font-lock-rules): Update docstring. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 00148420893..f365d88fade 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -4149,7 +4149,7 @@ Parser-based Font Lock name of @var{query}. Users can control which features are enabled with @code{treesit-font-lock-level} and @code{treesit-font-lock-feature-list} (described below). These two -keywords are mandatory. +keywords are mandatory (with exceptions). Other keywords are optional: @@ -4161,6 +4161,9 @@ Parser-based Font Lock @item @tab @code{append} @tab Append the new face to existing ones @item @tab @code{prepend} @tab Prepend the new face to existing ones @item @tab @code{keep} @tab Fill-in regions without an existing face +@item @code{:default-language} @tab @var{language} +@tab Every @var{query} after this keyword will use @var{language} +by default. @end multitable Lisp programs mark patterns in @var{query} with capture names (names diff --git a/etc/NEWS b/etc/NEWS index 3810305e9f4..5d42d88fb60 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1353,6 +1353,11 @@ Since circular alias chains now cannot occur, 'function-alias-p', 'indirect-function' and 'indirect-variable' will never signal an error. Their 'noerror' arguments have no effect and are therefore obsolete. ++++ +** 'treesit-font-lock-rules' now accepts additional global keywords. +When supplied with ':default-language LANGUAGE', rules after it will +default to use 'LANGUAGE'. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/treesit.el b/lisp/treesit.el index 669f41d8015..80bdf164b07 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -892,6 +892,8 @@ treesit-font-lock-rules `append' Append the new face to existing ones. `prepend' Prepend the new face to existing ones. `keep' Fill-in regions without an existing face. + :default-language LANGUAGE Every QUERY after this keyword + will use LANGUAGE by default. Capture names in QUERY should be face names like `font-lock-keyword-face'. The captured node will be fontified commit 5e546abf7a27688150f0bc5c486e860f4ad85198 Author: Gerd Möllmann Date: Sat Oct 21 19:55:25 2023 +0200 ; Fix a compilation warning diff --git a/src/keyboard.c b/src/keyboard.c index 7e164237d66..811ec252ef9 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5941,6 +5941,8 @@ save_line_number_display_width (struct input_event *event) w = XWINDOW (event->frame_or_window); else if (FRAMEP (event->frame_or_window)) w = XWINDOW (XFRAME (event->frame_or_window)->selected_window); + else + emacs_abort (); line_number_display_width (w, &down_mouse_line_number_width, &pixel_width); } commit c5f4d0fea55940bd1962d656b65e6c1de560c326 Author: Stefan Monnier Date: Sat Oct 21 13:48:30 2023 -0400 * lisp/cedet/semantic/imenu.el: Don't load `advice` We don't use it any more here. Also move the `;;; Code:` where it belongs. diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index a28f050f3a0..7f27561c3d2 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -32,6 +32,8 @@ ;; (setq imenu-create-index-function 'semantic-create-imenu-index) ;; )) +;;; Code: + (require 'semantic) (require 'semantic/format) (require 'semantic/db) @@ -134,7 +136,6 @@ semantic-imenu-expandable-tag-classes By default, a `type' has interesting children. In Texinfo, however, a `section' has interesting children.") -;;; Code: (defun semantic-imenu-tag-overlay (tag) "Return the overlay belonging to tag. If TAG doesn't have an overlay, and instead as a vector of positions, @@ -469,9 +470,8 @@ semantic-imenu-toggle-bucketize-type-parts ;; buffer, there is a much more efficient way of doing this. ;; Advise `which-function' so that we optionally use semantic tags ;; instead, and get better stuff. -(require 'advice) -(defvar semantic-which-function 'semantic-default-which-function +(defvar semantic-which-function #'semantic-default-which-function "Function to convert semantic tags into `which-function' text.") (defcustom semantic-which-function-use-color nil commit 0ad355e9c6213b83e6f3cf364ea83b131e6a636a Author: Stefan Monnier Date: Sat Oct 21 13:40:12 2023 -0400 * lisp/treesit.el: Don't require `cl-seq` directly diff --git a/lisp/treesit.el b/lisp/treesit.el index 879afb4c73c..669f41d8015 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -32,9 +32,8 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) ; For `string-join'. -(require 'cl-seq) +(require 'cl-lib) (require 'font-lock) (require 'seq) @@ -2143,7 +2142,7 @@ treesit-thing-definition (copy-tree (cdr entry))) treesit-thing-settings))))) -(defalias 'treesit-thing-defined-p 'treesit-thing-definition +(defalias 'treesit-thing-defined-p #'treesit-thing-definition "Return non-nil if THING is defined.") (defun treesit-beginning-of-thing (thing &optional arg tactic) commit c221db0402031c23b983eea3a6bc129e5abb98f6 Author: Stefan Monnier Date: Sat Oct 21 13:05:58 2023 -0400 so-long.el: Don't load `advice` during compilation * lisp/so-long.el: Prefer #' to quote function names. (global-so-long-mode): Remove redundant `:group` arg. (): Don't load needlessly the obsolete `advice` library during compilation. diff --git a/lisp/so-long.el b/lisp/so-long.el index b93b047ce55..b7cfce31173 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -310,7 +310,7 @@ ;; possibly also `so-long-max-lines' and `so-long-skip-leading-comments' (these ;; latter two are not used by default starting from Emacs 28.1). E.g.: ;; -;; (add-hook 'js-mode-hook 'my-js-mode-hook) +;; (add-hook 'js-mode-hook #'my-js-mode-hook) ;; ;; (defun my-js-mode-hook () ;; "Custom `js-mode' behaviors." @@ -324,7 +324,7 @@ ;; set `bidi-inhibit-bpa' in XML files, on the basis that XML files with long ;; lines are less likely to trigger BPA-related performance problems: ;; -;; (add-hook 'nxml-mode-hook 'my-nxml-mode-hook) +;; (add-hook 'nxml-mode-hook #'my-nxml-mode-hook) ;; ;; (defun my-nxml-mode-hook () ;; "Custom `nxml-mode' behaviors." @@ -366,7 +366,7 @@ ;; variable. Refer to M-: (info "(emacs) Specifying File Variables") RET ;; ;; `so-long-minor-mode' can also be called directly if desired. e.g.: -;; (add-hook 'FOO-mode-hook 'so-long-minor-mode) +;; (add-hook 'FOO-mode-hook #'so-long-minor-mode) ;; ;; In Emacs 26.1 or later (see "Caveats" below) you also have the option of ;; using file-local and directory-local variables to determine how `so-long' @@ -1320,8 +1320,8 @@ so-long-minor-mode (so-long--ensure-enabled) (setq so-long--active t so-long-detected-p t - so-long-function 'turn-on-so-long-minor-mode - so-long-revert-function 'turn-off-so-long-minor-mode) + so-long-function #'turn-on-so-long-minor-mode + so-long-revert-function #'turn-off-so-long-minor-mode) (so-long-remember-all :reset) (unless (derived-mode-p 'so-long-mode) (setq so-long-mode-line-info (so-long-mode-line-info)))) @@ -1345,7 +1345,7 @@ so-long-minor-mode (defvar so-long-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") 'so-long-revert) + (define-key map (kbd "C-c C-c") #'so-long-revert) ;; Define the major mode menu. We have an awkward issue whereby ;; [menu-bar so-long] is already defined in the global map and is ;; :visible so-long-detected-p, but we also want this to be @@ -1396,12 +1396,12 @@ so-long-mode (so-long--ensure-enabled) (setq so-long--active t so-long-detected-p t - so-long-function 'so-long-mode - so-long-revert-function 'so-long-mode-revert)) + so-long-function #'so-long-mode + so-long-revert-function #'so-long-mode-revert)) ;; Use `after-change-major-mode-hook' to disable minor modes and override ;; variables. Append, to act after any globalized modes have acted. (add-hook 'after-change-major-mode-hook - 'so-long-after-change-major-mode :append :local) + #'so-long-after-change-major-mode :append :local) ;; Override variables. This is the first of two instances where we do this ;; (the other being `so-long-after-change-major-mode'). It is desirable to ;; set variables here in order to cover cases where the setting of a variable @@ -1591,8 +1591,8 @@ so-long-mode-downgrade (when (and (symbolp (so-long-function)) (provided-mode-derived-p (so-long-function) 'so-long-mode)) ;; Downgrade from `so-long-mode' to the `so-long-minor-mode' behavior. - (setq so-long-function 'turn-on-so-long-minor-mode - so-long-revert-function 'turn-off-so-long-minor-mode)))) + (setq so-long-function #'turn-on-so-long-minor-mode + so-long-revert-function #'turn-off-so-long-minor-mode)))) (defun so-long-inhibit (&optional _mode) "Prevent `global-so-long-mode' from having any effect. @@ -1897,7 +1897,6 @@ global-so-long-mode Use \\[so-long-customize] to open the customization group `so-long' to configure the behavior." :global t - :group 'so-long (if global-so-long-mode ;; Enable (progn @@ -2030,7 +2029,7 @@ so-long-version ;; Update to version 1.0 from earlier versions: (when (version< so-long-version "1.0") (remove-hook 'change-major-mode-hook 'so-long-change-major-mode) - (eval-and-compile (require 'advice)) ;; Both macros and functions. + (require 'advice) ;; It should already be loaded, but just in case. (declare-function ad-find-advice "advice") (declare-function ad-remove-advice "advice") (declare-function ad-activate "advice") commit 1e25f1d997848375ca301bea8192c806bcd5fa4b Author: Eli Zaretskii Date: Sat Oct 21 18:18:11 2023 +0300 ; * etc/NEWS: Fix wording of a recently-added entry. diff --git a/etc/NEWS b/etc/NEWS index 609c3fa1596..3810305e9f4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1183,12 +1183,12 @@ It is needed to inform the compiler about which dialect of ELisp your code is using: the modern dialect with lexical binding or the old dialect with only dynamic binding. -Lexical binding avoids some name conflicts and allows the compiler -to detect more mistakes and generate more efficient code. To adapt -your code to lexical binding, see the "(elisp) Converting to Lexical -Binding" section in the manual. +Lexical binding avoids some name conflicts and allows the compiler to +detect more mistakes and generate more efficient code, so it is +recommended. For how to adapt your code to lexical binding, see the +manual section "(elisp) Converting to Lexical Binding". -If you are unable to convert the code to lexical binding, you can insert +If your code cannot be converted to lexical binding, you can insert the line ;;; -*- lexical-binding: nil -*- commit a3db503351e9a8720cdea2f1ca42d55d2de684e2 Author: Mattias Engdegård Date: Sun Oct 15 22:01:06 2023 +0200 Move lexical-binding warning from checkdoc to byte-compiler This warning is much more appropriate for the compiler, since lexical binding affects what it can reason and warn about, than for checkdoc as the warning has no bearing to documentation at all. The move also improves the reach of the warning. * etc/NEWS: Update. * lisp/emacs-lisp/checkdoc.el (checkdoc-lexical-binding-flag) (checkdoc-file-comments-engine): Move warning from here.... * lisp/emacs-lisp/bytecomp.el (byte-compile-file): ...to here. * test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el: * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--unescaped-char-literals) (bytecomp-tests-function-put, bytecomp-tests--not-writable-directory) (bytecomp-tests--target-file-no-directory): Update tests. (bytecomp-tests--log-from-compilation) (bytecomp-tests--lexical-binding-cookie): New test. diff --git a/etc/NEWS b/etc/NEWS index 3d4cdd876b3..609c3fa1596 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -854,14 +854,6 @@ This can help avoid some awkward skip conditions. For example '(skip-unless (not noninteractive))' can be changed to the easier to read '(skip-when noninteractive)'. -** Checkdoc - ---- -*** New checkdock warning if not using lexical-binding. -Checkdoc now warns if the first line of an Emacs Lisp file does not -end with a "-*- lexical-binding: t -*-" cookie. Customize the user -option 'checkdoc-lexical-binding-flag' to nil to disable this warning. - ** URL +++ @@ -1179,6 +1171,30 @@ sexp-related motion commands. ** New or changed byte-compilation warnings +--- +*** Warn about missing 'lexical-binding' directive. +The compiler now warns if an Elisp file lacks the standard +'-*- lexical-binding: ... -*-' cookie on the first line. +This line typically looks something like + + ;;; My little pony mode -*- lexical-binding: t -*- + +It is needed to inform the compiler about which dialect of ELisp +your code is using: the modern dialect with lexical binding or +the old dialect with only dynamic binding. + +Lexical binding avoids some name conflicts and allows the compiler +to detect more mistakes and generate more efficient code. To adapt +your code to lexical binding, see the "(elisp) Converting to Lexical +Binding" section in the manual. + +If you are unable to convert the code to lexical binding, you can insert +the line + + ;;; -*- lexical-binding: nil -*- + +first in the file to declare that it uses the old dialect. + --- *** Warn about empty bodies for more special forms and macros. The compiler now warns about an empty body argument to 'when', diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 92abe6b4624..cc68db73c9f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2201,6 +2201,10 @@ byte-compile-file filename buffer-file-name)) ;; Don't inherit lexical-binding from caller (bug#12938). (unless (local-variable-p 'lexical-binding) + (let ((byte-compile-current-buffer (current-buffer))) + (byte-compile-warn-x + (position-symbol 'a (point-min)) + "file has no `lexical-binding' directive on its first line")) (setq-local lexical-binding nil)) ;; Set the default directory, in case an eval-when-compile uses it. (setq default-directory (file-name-directory filename))) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 440e133f44b..471a2fbdf48 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -128,14 +128,6 @@ ;; simple style rules to follow which checkdoc will auto-fix for you. ;; `y-or-n-p' and `yes-or-no-p' should also end in "?". ;; -;; Lexical binding: -;; -;; We recommend always using lexical binding in new code, and -;; converting old code to use it. Checkdoc warns if you don't have -;; the recommended string "-*- lexical-binding: t -*-" at the top of -;; the file. You can disable this check with the user option -;; `checkdoc-lexical-binding-flag'. -;; ;; Adding your own checks: ;; ;; You can experiment with adding your own checks by setting the @@ -347,12 +339,6 @@ checkdoc-column-zero-backslash-before-paren :type 'boolean :version "28.1") -(defcustom checkdoc-lexical-binding-flag t - "Non-nil means generate warnings if file is not using lexical binding. -See Info node `(elisp) Converting to Lexical Binding' for more." - :type 'boolean - :version "30.1") - ;; This is how you can use checkdoc to make mass fixes on the Emacs ;; source tree: ;; @@ -2391,31 +2377,6 @@ checkdoc-file-comments-engine (point-min) (save-excursion (goto-char (point-min)) (line-end-position)))) nil)) - (when checkdoc-lexical-binding-flag - (setq - err - ;; Lexical binding cookie. - (if (not (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point) (pos-eol)) - (re-search-forward - (rx "-*-" (* (* nonl) ";") - (* space) "lexical-binding:" (* space) "t" (* space) - (* ";" (* nonl)) - "-*-") - nil t)))) - (let ((pos (save-excursion (goto-char (point-min)) - (goto-char (pos-eol)) - (point)))) - (if (checkdoc-y-or-n-p "There is no lexical-binding cookie! Add one?") - (progn - (goto-char pos) - (insert " -*- lexical-binding: t -*-")) - (checkdoc-create-error - "The first line should end with \"-*- lexical-binding: t -*-\"" - pos (1+ pos) t))) - nil))) (setq err (or diff --git a/test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el b/test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el index 00ad1947507..1de5cf66b66 100644 --- a/test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el +++ b/test/lisp/emacs-lisp/bytecomp-resources/no-byte-compile.el @@ -1 +1 @@ -;; -*- no-byte-compile: t; -*- +;; -*- no-byte-compile: t; lexical-binding: t; -*- diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e644417c3d4..4aa555f1e92 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1302,6 +1302,30 @@ bytecomp-tests--with-temp-file (let ((elc (concat ,file-name-var ".elc"))) (if (file-exists-p elc) (delete-file elc)))))) +(defun bytecomp-tests--log-from-compilation (source) + "Compile the string SOURCE and return the compilation log output." + (let ((text-quoting-style 'grave) + (byte-compile-log-buffer (generate-new-buffer " *Compile-Log*"))) + (with-current-buffer byte-compile-log-buffer + (let ((inhibit-read-only t)) (erase-buffer))) + (bytecomp-tests--with-temp-file el-file + (write-region source nil el-file) + (byte-compile-file el-file)) + (with-current-buffer byte-compile-log-buffer + (buffer-string)))) + +(ert-deftest bytecomp-tests--lexical-binding-cookie () + (cl-flet ((cookie-warning (source) + (string-search + "file has no `lexical-binding' directive on its first line" + (bytecomp-tests--log-from-compilation source)))) + (let ((some-code "(defun my-fun () 12)\n")) + (should-not (cookie-warning + (concat ";;; -*-lexical-binding:t-*-\n" some-code))) + (should-not (cookie-warning + (concat ";;; -*-lexical-binding:nil-*-\n" some-code))) + (should (cookie-warning some-code))))) + (ert-deftest bytecomp-tests--unescaped-char-literals () "Check that byte compiling warns about unescaped character literals (Bug#20852)." @@ -1310,7 +1334,9 @@ bytecomp-tests--unescaped-char-literals (byte-compile-debug t) (text-quoting-style 'grave)) (bytecomp-tests--with-temp-file source - (write-region "(list ?) ?( ?; ?\" ?[ ?])" nil source) + (write-region (concat ";;; -*-lexical-binding:t-*-\n" + "(list ?) ?( ?; ?\" ?[ ?])") + nil source) (bytecomp-tests--with-temp-file destination (let* ((byte-compile-dest-file-function (lambda (_) destination)) (err (should-error (byte-compile-file source)))) @@ -1322,7 +1348,9 @@ bytecomp-tests--unescaped-char-literals "`?\\]' expected!"))))))) ;; But don't warn in subsequent compilations (Bug#36068). (bytecomp-tests--with-temp-file source - (write-region "(list 1 2 3)" nil source) + (write-region (concat ";;; -*-lexical-binding:t-*-\n" + "(list 1 2 3)") + nil source) (bytecomp-tests--with-temp-file destination (let ((byte-compile-dest-file-function (lambda (_) destination))) (should (byte-compile-file source))))))) @@ -1330,6 +1358,7 @@ bytecomp-tests--unescaped-char-literals (ert-deftest bytecomp-tests-function-put () "Check `function-put' operates during compilation." (bytecomp-tests--with-temp-file source + (insert ";;; -*-lexical-binding:t-*-\n") (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1) (function-put 'bytecomp-tests--foo 'bar 2) (defmacro bytecomp-tests--foobar () @@ -1636,7 +1665,8 @@ bytecomp-tests--not-writable-directory (byte-compile-error-on-warn t)) (unwind-protect (progn - (write-region "" nil input-file nil nil nil 'excl) + (write-region ";;; -*-lexical-binding:t-*-\n" + nil input-file nil nil nil 'excl) (write-region "" nil output-file nil nil nil 'excl) (set-file-modes input-file #o400) (set-file-modes output-file #o200) @@ -1700,7 +1730,8 @@ bytecomp-tests--target-file-no-directory (let* ((default-directory directory) (byte-compile-dest-file-function (lambda (_) "test.elc")) (byte-compile-error-on-warn t)) - (write-region "" nil "test.el" nil nil nil 'excl) + (write-region ";;; -*-lexical-binding:t-*-\n" + nil "test.el" nil nil nil 'excl) (should (byte-compile-file "test.el")) (should (file-regular-p "test.elc")) (should (cl-plusp (file-attribute-size commit 12c8cdb60cc41fb17a85c7e3f75f91cca2d60483 Merge: 5c652414452 b99d12c30c3 Author: Eli Zaretskii Date: Sat Oct 21 08:06:09 2023 -0400 Merge from origin/emacs-29 b99d12c30c3 ; Fix argument name for function `copy-file' commit 5c652414452fb60e9bd4ed63ef0b5eca84cc0a42 Merge: 52f25b791e6 62920dcb0de Author: Eli Zaretskii Date: Sat Oct 21 08:06:08 2023 -0400 ; Merge from origin/emacs-29 The following commits were skipped: 62920dcb0de Update Tramp version (don't merge with master) d963bc6c6b6 ; * lisp/ldefs-boot.el: Regenerated for Emacs 29.1.90. 0cbc91f29ae Bump Emacs version commit 52f25b791e686de4c8bf09aea63fba5b54137ae2 Merge: 1b2083c2f33 ab9d6482e3b Author: Eli Zaretskii Date: Sat Oct 21 08:06:07 2023 -0400 Merge from origin/emacs-29 ab9d6482e3b ; Update ChangeLog.4 and etc/AUTHORS. d9e1605122b Correctly register focus events concomitant with alpha ch... 194e219825c * doc/man/emacsclient.1: Add missing options. commit ee043a2703d3175a7745c111146aa19a13f8e0ba Author: Dmitry Gutov Date: Sat Oct 21 15:05:45 2023 +0300 tsx-ts-mode--font-lock-compatibility-bb1f97b: Re-fix the previous fix * lisp/progmodes/typescript-ts-mode.el (tsx-ts-mode--font-lock-compatibility-bb1f97b): Make sure the tested query is actually valid in the new grammar (bug#66646). diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 709d3718a0a..ec220ab8d03 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -166,7 +166,7 @@ tsx-ts-mode--font-lock-compatibility-bb1f97b ;; but then raises an error if the wrong node type is used. So it is ;; important to check with the new node type (member_expression) (condition-case nil - (progn (treesit-query-capture language '(jsx_opening_element (member_expression) @capture)) + (progn (treesit-query-capture language '((jsx_opening_element (member_expression) @capture))) '((jsx_opening_element [(member_expression (identifier)) (identifier)] @typescript-ts-jsx-tag-face) commit 1b2083c2f3380400768a35fa3e665dcab209d0f1 Author: Eli Zaretskii Date: Sat Oct 21 15:03:22 2023 +0300 ; * src/keyboard.c (line_number_mode_hscroll): Fix last change. diff --git a/src/keyboard.c b/src/keyboard.c index 07af12d8d44..7e164237d66 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5961,7 +5961,8 @@ line_number_mode_hscroll (Lisp_Object start_pos, Lisp_Object end_pos) Lisp_Object start_col_row = Fnth (make_fixnum (6), start_pos); Lisp_Object end_col_row = Fnth (make_fixnum (6), end_pos); Lisp_Object window = Fcar (end_pos); - int col_width, pixel_width, start_col, end_col; + int col_width, pixel_width; + Lisp_Object start_col, end_col; struct window *w; if (!WINDOW_VALID_P (window)) { @@ -5974,7 +5975,7 @@ line_number_mode_hscroll (Lisp_Object start_pos, Lisp_Object end_pos) line_number_display_width (w, &col_width, &pixel_width); start_col = Fcar (start_col_row); end_col = Fcar (end_col_row); - return start_col == end_col + return EQ (start_col, end_col) && down_mouse_line_number_width >= 0 && col_width != down_mouse_line_number_width; } commit 2fb4108ab7f00084b2dc4c3e527f24ba344bb0fa Merge: e57b19b4007 9c82f480590 Author: Eli Zaretskii Date: Sat Oct 21 14:34:28 2023 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 9c82f4805901a3670398370e5f7bf312d105b768 Author: Mattias Engdegård Date: Fri Oct 20 16:58:18 2023 +0200 Move and edit text about lexical environment representation It's only relevant for the second argument to `eval`; the actual internal representation is an implementation matter and usually different from what was described here. * doc/lispref/variables.texi (Lexical Binding): Move the relevant part of the description of the internal representation of lexical environments from here... * doc/lispref/eval.texi (Eval): ...to here, where it belongs. diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index a45517287b7..ea35d4d38c7 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -743,10 +743,13 @@ Eval variables (@pxref{Variable Scoping}). If it is omitted or @code{nil}, that means to evaluate @var{form} using the default dynamic scoping rule. If it is @code{t}, that means to use the lexical scoping rule. -The value of @var{lexical} can also be a non-empty alist specifying a + +The value of @var{lexical} can also be a non-empty list specifying a particular @dfn{lexical environment} for lexical bindings; however, this feature is only useful for specialized purposes, such as in Emacs -Lisp debuggers. @xref{Lexical Binding}. +Lisp debuggers. Each member of the list is either a cons cell which +represents a lexical symbol-value pair, or a symbol representing a +dynamically bound variable. Since @code{eval} is a function, the argument expression that appears in a call to @code{eval} is evaluated twice: once as preparation before diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index dea35a04d4f..779f6233735 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1186,17 +1186,6 @@ Lexical Binding environment; if the variable is not specified in there, it looks in the symbol's value cell, where the dynamic value is stored. - (Internally, the lexical environment is a list whose members are -usually cons cells that are symbol-value pairs, but some of its -members can be symbols rather than cons cells. A symbol in the list -means the lexical environment declared that symbol's variable as -locally considered to be dynamically bound. This list can be passed -as the second argument to the @code{eval} function, in order to -specify a lexical environment in which to evaluate a form. -@xref{Eval}. Most Emacs Lisp programs, however, should not interact -directly with lexical environments in this way; only specialized -programs like debuggers.) - @cindex closures, example of using Lexical bindings have indefinite extent. Even after a binding construct has finished executing, its lexical environment can be commit e367d1862db1ac9a2fed9ae2902c54e0ad88d4d1 Author: Po Lu Date: Sat Oct 21 18:55:49 2023 +0800 ; * src/sfnt.c: Refine doc of variation selectors and GX fonts. diff --git a/src/sfnt.c b/src/sfnt.c index 0648e12150c..348cff604af 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -12297,18 +12297,47 @@ sfnt_interpret_compound_glyph (struct sfnt_glyph *glyph, /* Unicode Variation Sequence (UVS) support. - Unicode defines a mechanism by which a two-codepoint sequence - consisting of a ``base character'' and ``variation selector'' is - able to produce a glyph that is a variant of the glyph that would - conventionally have been mapped to the ``base character''. - - TrueType describes variation selector sequences through a type of - character mapping table that is given the format 14. The character - mapping table consists of an array of variation selectors, each of - which have a corresponding ``default UVS table'', which describes - ranges of ``base characters'' having no special variant glyphs, and - a ``non-default UVS table'', which is a map of ``base characters'' - to their corresponding variant glyphs. */ + Unicode defines a mechanism by which two-codepoint sequences + comprising a ``base character'' and ``variation selector'' combine + to produce a glyph besides that which is mapped to the ``base + character'' itself. + + TrueType stores variation selector sequences inside a special type + of character mapping table that is given the format 14. The + character mapping table consists of an array of variation + selectors, each of which is assigned a ``default UVS table'' + recording ranges of ``base characters'' absent special variant + glyphs, and a ``non-default UVS table'', linking ``base + characters'' to their respective variant glyphs. + + Unicode variation selectors occupy the range formed between 0xfe00 + and 0xfe0f, along with that from 0xe0100 to 0xe01ef, within the + Unicode codespace. When a variation selector is encountered as + text is being examined for display with a particular font, that + font's character mapping table is indexed by it, yielding a default + and non-default UVS table. If the base character (which is + directly behind the variation selector) is subsequently located + within the default UVS table, then the glyph represented by this + union of base character and variation selector is that designated + by the base character within any UCS-4 or BMP character mapping + table in the font. Since this glyph is at variance with that + derived from the base character only when the character set of the + character mapping table otherwise consulted is not UCS-4 or BMP, + the distinction between those two glyphs is largely notional. + Should the nondefault UVS table hold the base character, then the + glyph is conversely that enumerated in said table, whose indexing + is facilitated by sfnt_variation_glyph_for_char. And if the base + character isn't present within either table or the tables for the + variation selector are absent in the first place, then the two + codepoints constituting the sequence are immiscible and therefore + the sequence cannot apply to the font. + + The approach taken by Emacs character composition routines is + diametric to the approach illustrated above: in place of searching + for variation glyphs each time a variation selector character is + encountered, these routines ascertain which glyphs are linked to + each base character that they have adjudged subject to variation in + advance. See sfntfont_get_variation_glyphs. */ /* Read a default UVS table from the font file FD, at the specified OFFSET. Value is the default UVS table upon success, else @@ -12843,9 +12872,13 @@ sfnt_read_table (int fd, struct sfnt_offset_subtable *subtable, /* Glyph variations. Instead of defining separate fonts for each combination of weight, width and slant (bold, condensed, italic, - etc), some fonts specify a list of ``variation axes'', each of - which determines one delta to apply to each point in every - glyph. + etc), some fonts specify a list of ``variation axes'', which are + options that accept values consisting of numbers on scales + governing deltas applied to select points in their glyphs. + + Particular styles within the font are then supplied as sets of + values on these scales to which their respective axes are set, + termed ``instances''. This optional information is specified in the `fvar' (font variation), `gvar' (glyph variation) and `cvar' (CVT variation) commit e57b19b4007336c8f85f0dae0d4125d096d3d1f4 Author: Eli Zaretskii Date: Sat Oct 21 13:53:21 2023 +0300 Fix mouse clicks on links under 'global-display-line-numbers-mode' * src/indent.c (line_number_display_width): No longer static. * src/lisp.h (line_number_display_width): Add prototype. * src/keyboard.c (save_line_number_display_width) (line_number_mode_hscroll): New functions. (make_lispy_event): Call 'save_line_number_display_width' and 'line_number_mode_hscroll' to avoid interpreting up-event as drag event when redisplay scrolls the text horizontally between the down- and up-event to account for the changed width of the line-number display. (Bug#66655) diff --git a/src/indent.c b/src/indent.c index eda85f2e94d..7d34d3638d9 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2031,7 +2031,7 @@ vmotion (ptrdiff_t from, ptrdiff_t from_byte, } /* Return the width taken by line-number display in window W. */ -static void +void line_number_display_width (struct window *w, int *width, int *pixel_width) { if (NILP (Vdisplay_line_numbers)) @@ -2101,7 +2101,7 @@ DEFUN ("line-number-display-width", Fline_number_display_width, { int width, pixel_width; struct window *w = XWINDOW (selected_window); - line_number_display_width (XWINDOW (selected_window), &width, &pixel_width); + line_number_display_width (w, &width, &pixel_width); if (EQ (pixelwise, Qcolumns)) { struct frame *f = XFRAME (w->frame); diff --git a/src/keyboard.c b/src/keyboard.c index 76dec637cb1..07af12d8d44 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5531,6 +5531,10 @@ #define ISO_FUNCTION_KEY_OFFSET 0xfe00 the down mouse event. */ static Lisp_Object frame_relative_event_pos; +/* The line-number display width, in columns, at the time of most + recent down mouse event. */ +static int down_mouse_line_number_width; + /* Information about the most recent up-going button event: Which button, what location, and what time. */ @@ -5927,6 +5931,54 @@ coords_in_tab_bar_window (struct frame *f, int x, int y) #endif /* HAVE_WINDOW_SYSTEM */ +static void +save_line_number_display_width (struct input_event *event) +{ + struct window *w; + int pixel_width; + + if (WINDOWP (event->frame_or_window)) + w = XWINDOW (event->frame_or_window); + else if (FRAMEP (event->frame_or_window)) + w = XWINDOW (XFRAME (event->frame_or_window)->selected_window); + line_number_display_width (w, &down_mouse_line_number_width, &pixel_width); +} + +/* Return non-zero if the change of position from START_POS to END_POS + is likely to be the effect of horizontal scrolling due to a change + in line-number width produced by redisplay between two mouse + events, like mouse-down followed by mouse-up, at those positions. + This is used to decide whether to converts mouse-down followed by + mouse-up event into a mouse-drag event. */ +static bool +line_number_mode_hscroll (Lisp_Object start_pos, Lisp_Object end_pos) +{ + if (!EQ (Fcar (start_pos), Fcar (end_pos)) /* different window */ + || list_length (start_pos) < 7 /* no COL/ROW info */ + || list_length (end_pos) < 7) + return false; + + Lisp_Object start_col_row = Fnth (make_fixnum (6), start_pos); + Lisp_Object end_col_row = Fnth (make_fixnum (6), end_pos); + Lisp_Object window = Fcar (end_pos); + int col_width, pixel_width, start_col, end_col; + struct window *w; + if (!WINDOW_VALID_P (window)) + { + if (WINDOW_LIVE_P (window)) + window = XFRAME (window)->selected_window; + else + window = selected_window; + } + w = XWINDOW (window); + line_number_display_width (w, &col_width, &pixel_width); + start_col = Fcar (start_col_row); + end_col = Fcar (end_col_row); + return start_col == end_col + && down_mouse_line_number_width >= 0 + && col_width != down_mouse_line_number_width; +} + /* Given a struct input_event, build the lisp event which represents it. If EVENT is 0, build a mouse movement event from the mouse movement buffer, which should have a movement event in it. @@ -6329,6 +6381,8 @@ make_lispy_event (struct input_event *event) *start_pos_ptr = Fcopy_alist (position); frame_relative_event_pos = Fcons (event->x, event->y); ignore_mouse_drag_p = false; + /* Squirrel away the line-number width, if any. */ + save_line_number_display_width (event); } /* Now we're releasing a button - check the coordinates to @@ -6374,12 +6428,18 @@ make_lispy_event (struct input_event *event) it's probably OK to ignore it as well. */ && (EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))) /* Same buffer pos */ + /* Redisplay hscrolled text between down- and + up-events due to display-line-numbers-mode. */ + || line_number_mode_hscroll (start_pos, position) || !EQ (Fcar (start_pos), Fcar (position))))) /* Different window */ + { /* Mouse has moved enough. */ button_down_time = 0; click_or_drag_modifier = drag_modifier; + /* Reset the value for future clicks. */ + down_mouse_line_number_width = -1; } else if (((!EQ (Fcar (start_pos), Fcar (position))) || (!EQ (Fcar (Fcdr (start_pos)), diff --git a/src/lisp.h b/src/lisp.h index 39aa51531fe..df6cf1df544 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4883,6 +4883,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, /* Defined in indent.c. */ extern ptrdiff_t current_column (void); +extern void line_number_display_width (struct window *, int *, int *); extern void invalidate_current_column (void); extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT); extern void syms_of_indent (void); commit e6f05e189db73a0f0b29f987381ffef61a409232 Author: Lassi Kortela Date: Sat Oct 21 13:10:50 2023 +0300 Recognize backslash in `dns-mode` quoted values * lisp/textmodes/dns-mode.el (dns-mode-syntax-table): Recognize backslash as an escape character. (Bug#66660) diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 1b5f0c1d94b..bc3fa8d8e3a 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -132,6 +132,7 @@ dns-mode-syntax-table (modify-syntax-entry ?\; "< " table) (modify-syntax-entry ?\n "> " table) (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\\ "\\" table) table) "Syntax table in use in DNS master file buffers.") commit 2e19e11638339d0ae97958547bd87b4b15c2ee52 Author: Stefan Kangas Date: Sat Oct 21 12:26:00 2023 +0200 Don't use obsolete `sleep-for` argument * lisp/net/sieve-manage.el (sieve-manage-wait-for-answer): * lisp/org/ob-lua.el (org-babel-lua-evaluate-session): * lisp/org/ob-python.el (org-babel-python-initiate-session-by-key): (org-babel-python-evaluate-session): Don't use obsolete 'sleep-for' argument. diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index 5bee4f4c4ad..81f50e74987 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -511,7 +511,7 @@ sieve-manage-wait-for-answer (while (not pos) (setq pos (search-forward-regexp pattern nil t)) (goto-char (point-min)) - (sleep-for 0 50)) + (sleep-for 0.05)) pos)) (defun sieve-manage-drop-next-answer () diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index 81521d9e0a5..7eaf5e00b13 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -326,7 +326,7 @@ org-babel-lua-evaluate-session If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." - (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) + (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0.005))) (dump-last-value (lambda (tmp-file pp) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 6c05d1c8b2a..48a906a1934 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -235,7 +235,7 @@ org-babel-python-initiate-session-by-key ;; multiple prompts during initialization. (with-current-buffer py-buffer (while (not org-babel-python--initialized) - (sleep-for 0 10))) + (sleep-for 0.01))) (org-babel-comint-wait-for-output py-buffer)) (setq org-babel-python-buffers (cons (cons session py-buffer) @@ -403,7 +403,7 @@ org-babel-python-evaluate-session (body (org-babel-python-format-session-value tmp-src-file tmp-results-file result-params))) (org-babel-python--send-string session body) - (sleep-for 0 10) + (sleep-for 0.01) (org-babel-eval-read-file tmp-results-file))))))) (org-babel-result-cond result-params results commit a838bcb23c60fe5bd29a1013a8c75796420ee461 Author: john muhl Date: Tue Oct 10 09:18:10 2023 -0500 Support lua-ts-mode in align.el * lisp/align.el (align-rules-list): Add lua-ts-mode. (Bug#66466) * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): Indent region before aligning. * test/lisp/align-tests.el (align-lua): * test/lisp/align-resources/lua-ts-mode.erts: Add tests. diff --git a/lisp/align.el b/lisp/align.el index a286addb51f..9fa78525ecb 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -577,7 +577,18 @@ align-rules-list "=" (group (zero-or-more (syntax whitespace))))) (group . (1 2)) - (modes . '(conf-toml-mode toml-ts-mode)))) + (modes . '(conf-toml-mode toml-ts-mode lua-mode lua-ts-mode))) + + (double-dash-comment + (regexp . ,(rx (group (zero-or-more (syntax whitespace))) + "--" + (zero-or-more nonl))) + (modes . '(lua-mode lua-ts-mode)) + (column . comment-column) + (valid . ,(lambda () + (save-excursion + (goto-char (match-beginning 1)) + (not (bolp))))))) "A list describing all of the available alignment rules. The format is: diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 030a3585158..69833297073 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -443,6 +443,9 @@ lua-ts-mode "function")) symbol-end))))) + ;; Align. + (setq-local align-indent-before-aligning t) + (treesit-major-mode-setup)) (add-hook 'flymake-diagnostic-functions #'lua-ts-flymake-luacheck nil 'local)) diff --git a/test/lisp/align-resources/lua-ts-mode.erts b/test/lisp/align-resources/lua-ts-mode.erts new file mode 100644 index 00000000000..b0473ad6cdf --- /dev/null +++ b/test/lisp/align-resources/lua-ts-mode.erts @@ -0,0 +1,67 @@ +Name: align assignments + +=-= +local first=1 +local s =2 +local last=3 +=-= +local first = 1 +local s = 2 +local last = 3 +=-=-= + +Name: align fields + +=-= +local Table={ +first=1, +second=2, +last=3, +} +=-= +local Table = { + first = 1, + second = 2, + last = 3, +} +=-=-= + +Name: align comments + +=-= +local first-- 1 +local second -- 2 +local last -- 3 +=-= +local first -- 1 +local second -- 2 +local last -- 3 +=-=-= + +Name: align assignments and comments + +=-= +local first=1-- one +local second=2 -- two +local last=3 -- three +=-= +local first = 1 -- one +local second = 2 -- two +local last = 3 -- three +=-=-= + +Name: align fields and comments + +=-= +local T={ +first=1,--one +second=2, --two +last=3, --three +} +=-= +local T = { + first = 1, --one + second = 2, --two + last = 3, --three +} +=-=-= diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el index a4d9303827f..e5fcd255907 100644 --- a/test/lisp/align-tests.el +++ b/test/lisp/align-tests.el @@ -49,6 +49,13 @@ align-latex (ert-test-erts-file (ert-resource-file "latex-mode.erts") (test-align-transform-fun #'latex-mode))) +(ert-deftest align-lua () + (skip-unless (treesit-ready-p 'lua)) + (let ((comment-column 20) + (indent-tabs-mode nil)) + (ert-test-erts-file (ert-resource-file "lua-ts-mode.erts") + (test-align-transform-fun #'lua-ts-mode)))) + (ert-deftest align-python () (ert-test-erts-file (ert-resource-file "python-mode.erts") (test-align-transform-fun #'python-mode))) commit cb89cbc406efeeadbb46eb6f4d81827c7c2caf94 Author: Mauro Aranda Date: Sun Oct 15 10:43:50 2023 -0300 Fix eglot-report-progress :type * lisp/progmodes/eglot.el (eglot-report-progress): Change :type to choice, to allow 'messages' as a value. (Bug#66556) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 7d83bcdd7ac..eba66503bf7 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -467,7 +467,9 @@ eglot-report-progress "If non-nil, show progress of long running LSP server work. If set to `messages', use *Messages* buffer, else use Eglot's mode line indicator." - :type 'boolean + :type '(choice (const :tag "Don't show progress" nil) + (const :tag "Show progress in *Messages*" messages) + (const :tag "Show progress in Eglot's mode line indicator" t)) :version "1.10") (defcustom eglot-ignored-server-capabilities (list) commit 78b998f9aadcf4a690419c5e2aa520d8be16f51c Author: Ulrich Müller Date: Sat Oct 21 11:17:03 2023 +0200 ; * lisp/progmodes/gud.el (gud-gud-lldb-command-name): Fix a typo. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index aad052012cf..02a1597340b 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3862,7 +3862,7 @@ gud-tooltip-tips (defvar gud-lldb-history nil) (defcustom gud-gud-lldb-command-name "lldb" - "Default command to invoke LLDB in order to debug a progra with it." + "Default command to invoke LLDB in order to debug a program with it." :type 'string :version "30.1") commit 9ad22b3a01826539a832da54f2a55b68186dc7cc Author: Po Lu Date: Sat Oct 21 14:24:25 2023 +0800 Facilitate opening multiple files through DND under Android * java/org/gnu/emacs/EmacsWindow.java (onDragEvent): Agglomerate each provided content URI into a text/uri list. diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 386eaca8c41..7662186a0eb 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -1605,6 +1605,7 @@ else if (EmacsWindow.this.isMapped) String type; Uri uri; EmacsActivity activity; + StringBuilder builder; x = (int) event.getX (); y = (int) event.getY (); @@ -1659,38 +1660,54 @@ else if (type.equals (ClipDescription.MIMETYPE_TEXT_URILIST)) EmacsNative.sendDndUri (handle, x, y, type); return true; } - else - { - /* If the item dropped is a URI, send it to the main - thread. */ - - uri = data.getItemAt (0).getUri (); + } - /* Attempt to acquire permissions for this URI; - failing which, insert it as text instead. */ + /* There's no plain text data within this clipboard item, so + each item within should be treated as a content URI + designating a file. */ - if (uri != null - && uri.getScheme () != null - && uri.getScheme ().equals ("content") - && (activity = EmacsActivity.lastFocusedActivity) != null) - { - if (activity.requestDragAndDropPermissions (event) == null) - uri = null; - } + /* Collect the URIs into a string with each suffixed + by newlines, much as in a text/uri-list. */ + builder = new StringBuilder (); - if (uri != null) - EmacsNative.sendDndUri (handle, x, y, uri.toString ()); - else - { - type = (data.getItemAt (0) - .coerceToText (EmacsService.SERVICE) - .toString ()); - EmacsNative.sendDndText (handle, x, y, type); - } + for (i = 0; i < itemCount; ++i) + { + /* If the item dropped is a URI, send it to the + main thread. */ + + uri = data.getItemAt (i).getUri (); + + /* Attempt to acquire permissions for this URI; + failing which, insert it as text instead. */ + + if (uri != null + && uri.getScheme () != null + && uri.getScheme ().equals ("content") + && (activity = EmacsActivity.lastFocusedActivity) != null) + { + if ((activity.requestDragAndDropPermissions (event) == null)) + uri = null; + } - return true; + if (uri != null) + builder.append (uri.toString ()).append ("\n"); + else + { + /* Treat each URI that Emacs cannot secure + permissions for as plain text. */ + type = (data.getItemAt (i) + .coerceToText (EmacsService.SERVICE) + .toString ()); + EmacsNative.sendDndText (handle, x, y, type); } } + + /* Now send each URI to Emacs. */ + + if (builder.length () > 0) + EmacsNative.sendDndUri (handle, x, y, builder.toString ()); + + return true; } return true; commit 8faffc26a623cee5cd46565ad519fef8ceb1eacb Author: Huan Nguyen Date: Sat Oct 7 12:03:55 2023 +0200 New keyword :default-language in treesit-font-lock-rules function. * lisp/treesit.el (treesit-font-lock-rules): Keyword :default-language LANGUAGE will be chosen for every :feature. Using :language will override the :default-language for the next :feature. diff --git a/lisp/treesit.el b/lisp/treesit.el index c73ac9912d6..879afb4c73c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -922,12 +922,22 @@ treesit-font-lock-rules ;; that following queries will apply to. current-language current-override current-feature + ;; DEFAULT-LANGUAGE will be chosen when current-language is + ;; not set. + default-language ;; The list this function returns. (result nil)) (while query-specs (let ((token (pop query-specs))) (pcase token ;; (1) Process keywords. + (:default-language + (let ((lang (pop query-specs))) + (when (or (not (symbolp lang)) (null lang)) + (signal 'treesit-font-lock-error + `("Value of :default-language should be a symbol" + ,lang))) + (setq default-language lang))) (:language (let ((lang (pop query-specs))) (when (or (not (symbolp lang)) (null lang)) @@ -955,23 +965,24 @@ treesit-font-lock-rules (setq current-feature var))) ;; (2) Process query. ((pred treesit-query-p) - (when (null current-language) - (signal 'treesit-font-lock-error - `("Language unspecified, use :language keyword to specify a language for this query" ,token))) - (when (null current-feature) - (signal 'treesit-font-lock-error - `("Feature unspecified, use :feature keyword to specify the feature name for this query" ,token))) - (if (treesit-compiled-query-p token) - (push `(,current-language token) result) - (push `(,(treesit-query-compile current-language token) - t - ,current-feature - ,current-override) - result)) - ;; Clears any configurations set for this query. - (setq current-language nil - current-override nil - current-feature nil)) + (let ((lang (or default-language current-language))) + (when (null lang) + (signal 'treesit-font-lock-error + `("Language unspecified, use :language keyword or :default-language to specify a language for this query" ,token))) + (when (null current-feature) + (signal 'treesit-font-lock-error + `("Feature unspecified, use :feature keyword to specify the feature name for this query" ,token))) + (if (treesit-compiled-query-p token) + (push `(,lang token) result) + (push `(,(treesit-query-compile lang token) + t + ,current-feature + ,current-override) + result)) + ;; Clears any configurations set for this query. + (setq current-language nil + current-override nil + current-feature nil))) (_ (signal 'treesit-font-lock-error `("Unexpected value" ,token)))))) (nreverse result)))) commit c94b6397bd95836250b1a2338aedb13d7872345a Author: Stefan Monnier Date: Fri Oct 20 20:42:04 2023 -0400 (buffer-match-p): Replace `&optional` with `&rest` (bug#65797) * lisp/subr.el (buffer-match-p--past-warnings): New var. (buffer-match-p): Use it. Replace `&optional arg` with `&rest args`. (match-buffers): Replace `&optional arg` with `&rest args`. * lisp/window.el (display-buffer-alist): Fix out of date docstring. * doc/lispref/buffers.texi (Buffer List): Document new calling convention. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 86c47ae7310..a2d0f5687ba 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -957,10 +957,10 @@ Buffer List infinite recursion. @end defvar -@defun buffer-match-p condition buffer-or-name &optional arg +@defun buffer-match-p condition buffer-or-name &rest args This function checks if a buffer designated by @code{buffer-or-name} -satisfies the specified @code{condition}. Optional third argument -@var{arg} is passed to the predicate function in @var{condition}. A +satisfies the specified @code{condition}. Optional arguments +@var{args} are passed to the predicate function in @var{condition}. A valid @var{condition} can be one of the following: @itemize @bullet{} @item @@ -969,23 +969,21 @@ Buffer List name. @item A predicate function, which should return non-@code{nil} if the buffer -matches. If the function expects one argument, it is called with -@var{buffer-or-name} as the argument; if it expects 2 arguments, the -first argument is @var{buffer-or-name} and the second is @var{arg} -(or @code{nil} if @var{arg} is omitted). +matches. It is called with +@var{buffer-or-name} as the first argument followed by @var{args}. @item A cons-cell @code{(@var{oper} . @var{expr})} where @var{oper} is one of @table @code @item (not @var{cond}) Satisfied if @var{cond} doesn't satisfy @code{buffer-match-p} with -the same buffer and @code{arg}. +the same buffer and @code{args}. @item (or @var{conds}@dots{}) Satisfied if @emph{any} condition in @var{conds} satisfies -@code{buffer-match-p}, with the same buffer and @code{arg}. +@code{buffer-match-p}, with the same buffer and @code{args}. @item (and @var{conds}@dots{}) Satisfied if @emph{all} the conditions in @var{conds} satisfy -@code{buffer-match-p}, with the same buffer and @code{arg}. +@code{buffer-match-p}, with the same buffer and @code{args}. @item derived-mode Satisfied if the buffer's major mode derives from @var{expr}. @item major-mode @@ -998,14 +996,14 @@ Buffer List @end itemize @end defun -@defun match-buffers condition &optional buffer-list arg +@defun match-buffers condition &optional buffer-list &rest args This function returns a list of all buffers that satisfy the @code{condition}. If no buffers match, the function returns @code{nil}. The argument @var{condition} is as defined in @code{buffer-match-p} above. By default, all the buffers are considered, but this can be restricted via the optional argument @code{buffer-list}, which should be a list of buffers to consider. -Optional third argument @var{arg} will be passed to @var{condition} in +Remaining arguments @var{args} will be passed to @var{condition} in the same way as @code{buffer-match-p} does. @end defun diff --git a/etc/NEWS b/etc/NEWS index 6898aa99bbc..3d4cdd876b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -961,6 +961,13 @@ the file listing's performance is still optimized. * Incompatible Lisp Changes in Emacs 30.1 +** `buffer-match-p and `match-buffers` take `&rest args` +They used to take a single `&optional arg` and were documented to use +an unreliable hack to try and support condition predicates that +don't accept this optional arg. +The new semantics makes no such accommodation, but the code still +supports it (with a warning) for backward compatibility. + ** 'post-gc-hook' runs after updating 'gcs-done' and 'gcs-elapsed'. --- diff --git a/lisp/subr.el b/lisp/subr.el index d9baecd600a..12e33380260 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7278,13 +7278,15 @@ string-lines (setq start (length string))))) (nreverse lines)))) -(defun buffer-match-p (condition buffer-or-name &optional arg) +(defvar buffer-match-p--past-warnings nil) + +(defun buffer-match-p (condition buffer-or-name &rest args) "Return non-nil if BUFFER-OR-NAME matches CONDITION. CONDITION is either: - the symbol t, to always match, - the symbol nil, which never matches, - a regular expression, to match a buffer name, -- a predicate function that takes BUFFER-OR-NAME and ARG as +- a predicate function that takes BUFFER-OR-NAME plus ARGS as arguments, and returns non-nil if the buffer matches, - a cons-cell, where the car describes how to interpret the cdr. The car can be one of the following: @@ -7309,9 +7311,18 @@ buffer-match-p ((pred stringp) (string-match-p condition (buffer-name buffer))) ((pred functionp) - (if (eq 1 (cdr (func-arity condition))) - (funcall condition buffer-or-name) - (funcall condition buffer-or-name arg))) + (if (cdr args) + ;; New in Emacs>29.1. no need for compatibility hack. + (apply condition buffer-or-name args) + (condition-case-unless-debug err + (apply condition buffer-or-name args) + (wrong-number-of-arguments + (unless (member condition + buffer-match-p--past-warnings) + (message "%s" (error-message-string err)) + (push condition buffer-match-p--past-warnings)) + (apply condition buffer-or-name + (if args nil '(nil))))))) (`(major-mode . ,mode) (eq (buffer-local-value 'major-mode buffer) @@ -7333,17 +7344,17 @@ buffer-match-p (throw 'match t))))))) (funcall match (list condition)))) -(defun match-buffers (condition &optional buffers arg) +(defun match-buffers (condition &optional buffers &rest args) "Return a list of buffers that match CONDITION, or nil if none match. See `buffer-match-p' for various supported CONDITIONs. By default all buffers are checked, but the optional argument BUFFERS can restrict that: its value should be an explicit list of buffers to check. -Optional argument ARG is passed to `buffer-match-p', for +Optional arguments ARGS are passed to `buffer-match-p', for predicate conditions in CONDITION." (let (bufs) (dolist (buf (or buffers (buffer-list))) - (when (buffer-match-p condition (get-buffer buf) arg) + (when (apply #'buffer-match-p condition (get-buffer buf) args) (push buf bufs))) bufs)) diff --git a/lisp/window.el b/lisp/window.el index 2f9b46ebb0a..12d3fb1dfe7 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7535,10 +7535,8 @@ display-buffer-alist arguments: a buffer to display and an alist of the same form as ALIST. See `display-buffer' for details. -`display-buffer' scans this alist until it either finds a -matching regular expression or the function specified by a -condition returns non-nil. In any of these cases, it adds the -associated action to the list of actions it will try." +`display-buffer' scans this alist until the CONDITION is satisfied +and adds the associated ACTION to the list of actions it will try." :type `(alist :key-type (choice :tag "Condition" regexp commit 696411ab8af4ca3e47b8e29482646f69034151eb Author: Stefan Monnier Date: Fri Oct 20 18:59:51 2023 -0400 (sleep-for): Make the `millisec` argument obsolete * lisp/subr.el (sleep-for): Set new advertized calling convention. * src/dispnew.c (Fsleep_for): Adjust docstring. * doc/lispref/commands.texi (Waiting): Adjust doc. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index fdf5ec1d7fe..41c30437dce 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -3969,20 +3969,17 @@ Waiting thus equivalent to @code{sleep-for}, which is described below. @end defun -@defun sleep-for seconds &optional millisec +@defun sleep-for seconds This function simply pauses for @var{seconds} seconds without updating the display. It pays no attention to available input. It returns @code{nil}. The argument @var{seconds} need not be an integer. If it is floating point, @code{sleep-for} waits for a fractional number of seconds. -Some systems support only a whole number of seconds; on these systems, -@var{seconds} is rounded down. -The optional argument @var{millisec} specifies an additional waiting -period measured in milliseconds. This adds to the period specified by -@var{seconds}. If the system doesn't support waiting fractions of a -second, you get an error if you specify nonzero @var{millisec}. +It is also possible to call @code{sleep-for} with two arguments, +as @code{(sleep-for @var{seconds} @var{millisec})}, +but that is considered obsolete and will be removed in the future. Use @code{sleep-for} when you wish to guarantee a delay. @end defun diff --git a/etc/NEWS b/etc/NEWS index 129017f7dbe..6898aa99bbc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1041,6 +1041,9 @@ Use 'define-minor-mode' and 'define-globalized-minor-mode' instead. ** The obsolete calling convention of 'sit-for' has been removed. That convention was: (sit-for SECONDS MILLISEC &optional NODISP) +** The 'millisec' argument of 'sleep-for' has been declared obsolete. +Use a float value for the first argument instead. + ** 'eshell-process-wait-{seconds,milliseconds}' options are now obsolete. Instead, use 'eshell-process-wait-time', which supports floating-point values. diff --git a/lisp/subr.el b/lisp/subr.el index 58274987d71..d9baecd600a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1959,6 +1959,7 @@ log10 (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") (set-advertised-calling-convention 'libxml-parse-xml-region '(&optional start end base-url) "27.1") (set-advertised-calling-convention 'libxml-parse-html-region '(&optional start end base-url) "27.1") +(set-advertised-calling-convention 'sleep-for '(seconds) "30.1") (set-advertised-calling-convention 'time-convert '(time form) "29.1") ;;;; Obsolescence declarations for variables, and aliases. diff --git a/src/dispnew.c b/src/dispnew.c index d6a27ac29ec..e4037494775 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6206,9 +6206,9 @@ bitch_at_user (void) DEFUN ("sleep-for", Fsleep_for, Ssleep_for, 1, 2, 0, doc: /* Pause, without updating display, for SECONDS seconds. SECONDS may be a floating-point value, meaning that you can wait for a -fraction of a second. Optional second arg MILLISECONDS specifies an -additional wait period, in milliseconds; this is for backwards compatibility. -\(Not all operating systems support waiting for a fraction of a second.) */) +fraction of a second. +An optional second arg MILLISECONDS can be provided but is deprecated: +it specifies an additional wait period, in milliseconds. */) (Lisp_Object seconds, Lisp_Object milliseconds) { double duration = extract_float (seconds); commit f109396fe362d3bc556efe2a7315169c74724d63 Author: F. Jason Park Date: Sun Oct 15 13:20:07 2023 -0700 Prefer erc-target to erc-default-target * etc/ERC-NEWS: Mention `erc-target' and new `erc-server-buffer-p' alias. * lisp/erc/erc-backend.el (erc-process-sentinel): Set `joined-p' slot of `erc--target-channel' object to nil when applicable. (erc-server-JOIN): Mark `erc--target-channel' object as being joined. * lisp/erc/erc-common.el (erc--target-channel): Add `joined-p' slot. Use hyphenated name so accessor function's name ends in "joined-p" rather than "joinedp". Note that this will always be nil when disconnected. (erc--target): Relocate here from erc.el. (erc-target): New public API function to return the current buffer's target as a string, even in channels that have been unjoined. * lisp/erc/erc-networks.el (erc--default-target): Remove forward declaration. (erc-networks--id-reload): Use `erc-target' instead of `erc--default-target' as predicate for visiting target buffers. * lisp/erc/erc.el (erc-remove-channel-users): Set channel "joinedness" to nil in `erc--target-channel' object, when applicable. (erc--target): Move to erc-common. (erc--default-target): Remove, replaced by new function `erc-target'. (erc-query-buffer-p): Use `erc-target'. (erc-after-connect): Revise doc string. (erc-connection-established): Revise doc string and move `erc-unhide-query-prompt' business before hook. (erc--current-buffer-joined-p): Remove comment and use new `joined-p' slot of `erc--target-channel' for determining "joinedness" of channel. (erc-kill-buffer-function): Use `erc--target-channel-p' for detecting whether the buffer is a channel buffer. * test/lisp/erc/erc-networks-tests.el (erc-networks--shrink-ids-and-buffer-names--hook-collapse-target): Remove comment. * test/lisp/erc/erc-scenarios-base-reuse-buffers.el (erc-scenarios-common--base-reuse-buffers-channel-buffers): Clarify assertion. * test/lisp/erc/erc-tests.el (erc-with-all-buffers-of-server): Replace `erc-default-recipients' with `erc--target'. (erc--target-from-string): Update expected shape of `erc--target-channel' struct with new `joined-p' slot. (erc-message): Set `erc--target' in buffer "#chan". (Bug#66578) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index e47c42a51a6..41ab9cc4c5e 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -425,6 +425,24 @@ use of 'insert-before-markers' instead of 'insert'. As always, users feeling unduly inconvenienced by these changes are encouraged to voice their concerns on the bug list. +*** Introducing new ways to detect ERC buffer types. +The old standby 'erc-default-target' has served ERC well for over two +decades. But a lesser known gotcha affecting its use has always +haunted an unlucky few, that is, the function has always returned +non-nil in "unjoined" channel buffers (those that the client has +parted with or been kicked from). While perhaps not itself a major +footgun, recessive pitfalls rooted in this subtlety continue to affect +dependent functions, like 'erc-get-buffer'. + +To discourage misuse of 'erc-default-target', ERC 5.6 offers an +alternative in the function 'erc-target', which is identical to the +former except for its disregard for "joinedness." As a related bonus, +the dependent function 'erc-server-buffer-p' is being rebranded as +'erc-server-or-unjoined-channel-buffer-p'. Unfortunately, this +release lacks a similar solution for detecting "joinedness" directly, +but users can turn to 'xor'-ing 'erc-default-target' and 'erc-target' +as a makeshift kludge. + *** 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'. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index d3094b0b955..4b5edaa77d2 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1103,7 +1103,7 @@ erc-process-sentinel (erc--register-connection) ;; assume event is 'failed (erc-with-all-buffers-of-server cproc nil - (setq erc-server-connected nil)) + (setq erc-server-connected nil)) (when erc-server-ping-handler (progn (cancel-timer erc-server-ping-handler) (setq erc-server-ping-handler nil))) @@ -1111,6 +1111,8 @@ erc-process-sentinel (erc-current-nick) (system-name) "") (dolist (buf (erc-buffer-filter (lambda () (boundp 'erc-channel-users)) cproc)) (with-current-buffer buf + (when (erc--target-channel-p erc--target) + (setf (erc--target-channel-joined-p erc--target) nil)) (setq erc-channel-users (make-hash-table :test 'equal)))) ;; Hide the prompt (erc--hide-prompt cproc) @@ -1731,6 +1733,7 @@ erc--server-determine-join-display-context (with-suppressed-warnings ((obsolete erc-add-default-channel)) (erc-add-default-channel chnl)) + (setf (erc--target-channel-joined-p erc--target) t) (erc-server-send (format "MODE %s" chnl))) (erc-with-buffer (chnl proc) (erc-channel-begin-receiving-names)) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 8d896e663b5..930e8032f6d 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -81,16 +81,13 @@ erc--target (string "" :type string :documentation "Received name of target.") (symbol nil :type symbol :documentation "Case-mapped name as symbol.")) -;; At some point, it may make sense to add a query type with an -;; account field, which may help support reassociation across -;; reconnects and nick changes (likely requires v3 extensions). -;; -;; These channel variants should probably take on a `joined' field to -;; track "joinedness", which `erc-server-JOIN', `erc-server-PART', -;; etc. should toggle. Functions like `erc--current-buffer-joined-p' -;; may find it useful. +;; At some point, it may make sense to add a separate query type, +;; possibly with an account field to help reassociation across +;; reconnects and nick changes. + +(cl-defstruct (erc--target-channel (:include erc--target)) + (joined-p nil :type boolean :documentation "Whether channel is joined.")) -(cl-defstruct (erc--target-channel (:include erc--target))) (cl-defstruct (erc--target-channel-local (:include erc--target-channel))) ;; Beginning in 5.5/29.1, the `tags' field may take on one of two @@ -427,6 +424,13 @@ erc-with-all-buffers-of-server ,@forms)) ,process))) +(defvar-local erc--target nil + "A permanent `erc--target' struct instance in channel and query buffers.") + +(define-inline erc-target () + "Return target of current buffer, if any, as a string." + (inline-quote (and erc--target (erc--target-string erc--target)))) + (defun erc-log-aux (string) "Do the debug logging of STRING." (let ((cb (current-buffer)) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index d73d715db2c..dd047243a3c 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -53,7 +53,6 @@ erc-server-parameters (defvar erc-server-process) (defvar erc-session-server) -(declare-function erc--default-target "erc" nil) (declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) (declare-function erc-buffer-filter "erc" (predicate &optional proc)) (declare-function erc-current-nick "erc" nil) @@ -991,12 +990,11 @@ erc-networks--id-reload (erc-networks--id-qualifying-len nid)) (erc-networks--rename-server-buffer (or proc erc-server-process) parsed) (erc-networks--shrink-ids-and-buffer-names-any) - (erc-with-all-buffers-of-server - erc-server-process #'erc--default-target - (when-let* ((new-name (erc-networks--reconcile-buffer-names erc--target - nid)) - ((not (equal (buffer-name) new-name)))) - (rename-buffer new-name 'unique)))) + (erc-with-all-buffers-of-server erc-server-process #'erc-target + (when-let + ((new-name (erc-networks--reconcile-buffer-names erc--target nid)) + ((not (equal (buffer-name) new-name)))) + (rename-buffer new-name 'unique)))) (cl-defgeneric erc-networks--id-ensure-comparable (self other) "Take measures to ensure two net identities are in comparable states.") diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 877478690af..7d75ec49ccd 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -534,6 +534,8 @@ erc-remove-channel-users Removes all users in the current channel. This is called by `erc-server-PART' and `erc-server-QUIT'." + (when (erc--target-channel-p erc--target) + (setf (erc--target-channel-joined-p erc--target) nil)) (when (and erc-server-connected (erc-server-process-alive) (hash-table-p erc-channel-users)) @@ -1391,16 +1393,6 @@ erc--target-from-string #'make-erc--target) :string string :symbol (intern (erc-downcase string)))) -(defvar-local erc--target nil - "Info about a buffer's target, if any.") - -;; Temporary internal getter to ease transition to `erc--target' -;; everywhere. Will be replaced by updated `erc-default-target'. -(defun erc--default-target () - "Return target string or nil." - (when erc--target - (erc--target-string erc--target))) - (defun erc-once-with-server-event (event f) "Run function F the next time EVENT occurs in the `current-buffer'. @@ -1504,7 +1496,7 @@ erc-query-buffer-p "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-default-target))) + (let ((target (erc-target))) (and (eq major-mode 'erc-mode) target (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) @@ -2492,10 +2484,13 @@ erc-before-connect :type '(repeat function)) (defcustom erc-after-connect nil - "Functions called after connecting to a server. -This functions in this variable gets executed when an end of MOTD -has been received. All functions in here get called with the -parameters SERVER and NICK." + "Abnormal hook run upon establishing a logical IRC connection. +Runs on MOTD's end when `erc-server-connected' becomes non-nil. +ERC calls members with `erc-server-announced-name', falling back +to the 376/422 message's \"sender\", as well as the current nick, +as given by the 376/422 message's \"target\" parameter, which is +typically the same as that reported by `erc-current-nick'." + :package-version '(ERC . "5.6") ; FIXME sync on release :group 'erc-hooks :type '(repeat function)) @@ -5749,9 +5744,7 @@ erc-handle-login (erc-load-script f))))) (defun erc-connection-established (proc parsed) - "Run just after connection. - -Set user modes and run `erc-after-connect' hook." + "Set user mode and run `erc-after-connect' hook in server buffer." (with-current-buffer (process-buffer proc) (unless erc-server-connected ; only once per session (let ((server (or erc-server-announced-name @@ -5770,14 +5763,11 @@ erc-connection-established (erc-update-mode-line) (erc-set-initial-user-mode nick buffer) (erc-server-setup-periodical-ping buffer) - (run-hook-with-args 'erc-after-connect server nick)))) - - (when erc-unhide-query-prompt - (erc-with-all-buffers-of-server proc - nil ; FIXME use `erc--target' after bug#48598 - (when (and (erc-default-target) - (not (erc-channel-p (car erc-default-recipients)))) - (erc--unhide-prompt))))) + (when erc-unhide-query-prompt + (erc-with-all-buffers-of-server erc-server-process nil + (when (and erc--target (not (erc--target-channel-p erc--target))) + (erc--unhide-prompt)))) + (run-hook-with-args 'erc-after-connect server nick))))) (defun erc-set-initial-user-mode (nick buffer) "If `erc-user-mode' is non-nil for NICK, set the user modes. @@ -7065,25 +7055,11 @@ erc-nick-equal-p ;; default target handling (defun erc--current-buffer-joined-p () - "Return whether the current target buffer is joined." - ;; This may be a reliable means of detecting subscription status, - ;; but it's also roundabout and awkward. Perhaps it's worth - ;; discussing adding a joined slot to `erc--target' for this. + "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-get-channel-user (erc-current-nick)) t)) - -;; While `erc-default-target' happens to return nil in channel buffers -;; you've parted or from which you've been kicked, using it to detect -;; whether a channel is currently joined may become unreliable in the -;; future. For now, third-party code can use -;; -;; (erc-get-channel-user (erc-current-nick)) -;; -;; A predicate may be provided eventually. For retrieving a target's -;; name regardless of subscription or connection status, new library -;; code should use `erc--default-target'. Third-party code should -;; continue to use `erc-default-target'. + (erc--target-channel-joined-p erc--target) + t)) (defun erc-default-target () "Return the current channel or query target, if any. @@ -8315,6 +8291,7 @@ erc-kill-buffer-hook :group 'erc-hooks :type 'hook) +;; FIXME alias and deprecate current *-function suffixed name. (defun erc-kill-buffer-function () "Function to call when an ERC buffer is killed. This function should be on `kill-buffer-hook'. @@ -8328,7 +8305,7 @@ erc-kill-buffer-function (cond ((eq (erc-server-buffer) (current-buffer)) (run-hooks 'erc-kill-server-hook)) - ((erc-channel-p (or (erc-default-target) (buffer-name))) + ((erc--target-channel-p erc--target) (run-hooks 'erc-kill-channel-hook)) (t (run-hooks 'erc-kill-buffer-hook))))) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 45ef0d10a6e..d0f1dddf6b3 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -623,11 +623,6 @@ erc-networks--shrink-ids-and-buffer-names--hook-collapse-target :symbol 'foonet/dummy :parts [foonet "dummy"] :len 2) - ;; `erc-kill-buffer-function' uses legacy target detection - ;; but falls back on buffer name, so no need for: - ;; - ;; erc-default-recipients '("#a") - ;; erc--target (erc--target-from-string "#a") erc-server-process (with-temp-buffer (erc-networks-tests--create-dead-proc))) diff --git a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el index 71027a0c138..af483bb1a52 100644 --- a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el +++ b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el @@ -124,6 +124,7 @@ erc-scenarios-common--base-reuse-buffers-channel-buffers (erc-d-t-search-for 1 "shake my sword") (erc-cmd-PART "#chan") (funcall expect 3 "You have left channel #chan") + (should-not (erc-get-channel-user (erc-current-nick))) (erc-cmd-JOIN "#chan"))) (ert-info ("Part #chan@barnet") @@ -139,6 +140,7 @@ erc-scenarios-common--base-reuse-buffers-channel-buffers (get-buffer "#chan/127.0.0.1<3>")) (ert-info ("Activity continues in new, -suffixed #chan@foonet buffer") + ;; The first /JOIN did not cause the same buffer to be reused. (with-current-buffer "#chan/127.0.0.1" (should-not (erc-get-channel-user (erc-current-nick)))) (with-current-buffer "#chan/127.0.0.1<3>" diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 02dfc55b6d5..4d2f880b46f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -69,26 +69,25 @@ erc-with-all-buffers-of-server (with-current-buffer (get-buffer-create "#foo") (erc-mode) (setq erc-server-process proc-exnet) - (setq erc-default-recipients '("#foo"))) + (setq erc--target (erc--target-from-string "#foo"))) (with-current-buffer (get-buffer-create "#spam") (erc-mode) (setq erc-server-process proc-onet) - (setq erc-default-recipients '("#spam"))) + (setq erc--target (erc--target-from-string "#spam"))) (with-current-buffer (get-buffer-create "#bar") (erc-mode) (setq erc-server-process proc-onet) - (setq erc-default-recipients '("#bar"))) + (setq erc--target (erc--target-from-string "#bar"))) (with-current-buffer (get-buffer-create "#baz") (erc-mode) (setq erc-server-process proc-exnet) - (setq erc-default-recipients '("#baz"))) + (setq erc--target (erc--target-from-string "#baz"))) (should (eq (get-buffer-process "ExampleNet") proc-exnet)) - (erc-with-all-buffers-of-server (get-buffer-process "ExampleNet") - nil + (erc-with-all-buffers-of-server (get-buffer-process "ExampleNet") nil (kill-buffer)) (should-not (get-buffer "ExampleNet")) @@ -102,8 +101,7 @@ erc-with-all-buffers-of-server (calls 0) (get-test (lambda () (cl-incf calls) test))) - (erc-with-all-buffers-of-server proc-onet - (funcall get-test) + (erc-with-all-buffers-of-server proc-onet (funcall get-test) (kill-buffer)) (should (= calls 1))) @@ -812,7 +810,7 @@ erc--restore-initialize-priors (ert-deftest erc--target-from-string () (should (equal (erc--target-from-string "#chan") - #s(erc--target-channel "#chan" \#chan))) + #s(erc--target-channel "#chan" \#chan nil))) (should (equal (erc--target-from-string "Bob") #s(erc--target "Bob" bob))) @@ -820,7 +818,7 @@ erc--target-from-string (let ((erc--isupport-params (make-hash-table))) (puthash 'CHANTYPES '("&#") erc--isupport-params) (should (equal (erc--target-from-string "&Bitlbee") - #s(erc--target-channel-local "&Bitlbee" &bitlbee))))) + #s(erc--target-channel-local "&Bitlbee" &bitlbee nil))))) (ert-deftest erc--modify-local-map () (when (and (bound-and-true-p erc-irccontrols-mode) @@ -1846,6 +1844,7 @@ erc-message (erc-mode) (setq erc-server-process (buffer-local-value 'erc-server-process (get-buffer "ExampleNet")) + erc--target (erc--target-from-string "#chan") erc-default-recipients '("#chan") erc-channel-users (make-hash-table :test 'equal) erc-network 'ExampleNet) commit 8cf66ab1e5ff253d72368901490f073634e1ae4b Author: F. Jason Park Date: Sun Oct 15 07:22:31 2023 -0700 Rename erc-server-buffer-p * lisp/erc/erc-log.el (erc-log-all-but-server-buffers): Use `erc--server-buffer-p' instead of `erc-server-buffer-p'. This replacement is presumed to be relatively "safe" because this function is unused in the code base and only appears in the doc string for the option `erc-enable-logging'. * lisp/erc/erc-match.el (erc-match-message): Leave comment proposing that `erc--server-buffer-p' should be preferred to `erc-server-buffer-p'. Use preferred alias for `erc-server-buffer-p'. * lisp/erc/erc-notify.el (erc-cmd-NOTIFY): Use preferred alias for `erc-server-buffer-p', and leave FIXME comment. * lisp/erc/erc-speedbar.el (erc-speedbar-buttons): Use `erc--server-buffer-p' instead of `erc-server-buffer-p'. The logic here seems simple enough to justify a change, however the absence of related bug reports is perhaps an argument against this. * lisp/erc/erc-track.el (erc-track-modified-channels): Use preferred alias for `erc-server-buffer-p' and leave comment noting possible bug. * lisp/erc/erc.el (erc-once-with-server-event): Use `erc--server-buffer-p' instead of `erc-server-buffer-p'. This change seems justified because the function sets local hooks that would otherwise be ignored outside of a server buffer. (erc-server-buffer-p, erc-server-or-unjoined-channel-buffer-p): Make the former an obsolete alias for the latter. (erc--server-buffer-p): New function to replace `erc-server-buffer-p' internally in new code. Unlike its predecessor, it returns nil in parted and kicked channels. (erc-open-server-buffer-p): Use `erc--server-buffer-p' instead of `erc-server-buffer-p'. Given the name and the doc string, breaking the odd misuse of this function in parted buffers seems justified because this is clearly a bug fix. Also, all uses in-tree conform to the intended behavior as documented. And a cursory grep of all "erc-" prefixed packages on MELPA reveals zero instances of this function. Nor is it used in erbot. (erc-get-buffer): Mention behavior in doc string regarding parted and kicked-from channels. (erc-cmd-GQUIT): Fix wrong-number-of-arguments bug in timer function. (erc-default-target): Mention behavior regarding unjoined channels. (erc-kill-query-buffers): Don't use `erc-server-buffer-p'. This replacement may break third-party code expecting to leave parted channels behind, but it seems sane when considering only the lone internal use in `erc-cmd-QUIT'. ; * test/lisp/erc/resources/join/network-id/foonet.eld: Timeouts. (Bug#66578) diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 472cc1388a4..79fece5779e 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -276,11 +276,11 @@ erc-log-disable-logging (defun erc-log-all-but-server-buffers (buffer) "Return t if logging should be enabled in BUFFER. -Returns nil if `erc-server-buffer-p' returns t." +Return nil if BUFFER is a server buffer." (save-excursion (save-window-excursion (set-buffer buffer) - (not (erc-server-buffer-p))))) + (not (erc--server-buffer-p))))) (defun erc-save-query-buffers (process) "Save all buffers of the given PROCESS." diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 186717579d7..8644e61106f 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -491,7 +491,9 @@ erc-match-message (message (buffer-substring message-beg (point-max)))) (when (and vector (not (and erc-match-exclude-server-buffer - (erc-server-buffer-p)))) + ;; FIXME replace with `erc--server-buffer-p' + ;; or explain why that's unwise. + (erc-server-or-unjoined-channel-buffer-p)))) (mapc (lambda (match-type) (goto-char (point-min)) diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 55be8976ada..cf7ffbb40d7 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -218,7 +218,9 @@ erc-cmd-NOTIFY ;; from your notify list. (dolist (buf (erc-buffer-list)) (with-current-buffer buf - (if (erc-server-buffer-p) + ;; FIXME replace with `erc--server-buffer-p' or + ;; explain why that's unwise. + (if (erc-server-or-unjoined-channel-buffer-p) (setq erc-last-ison (delete (car args) erc-last-ison)))))) (setq erc-notify-list (cons (erc-string-no-properties (car args)) erc-notify-list))) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 625d59530b0..bb5fad6f52f 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -135,7 +135,7 @@ erc-speedbar-buttons (erase-buffer) (let (serverp chanp queryp) (with-current-buffer buffer - (setq serverp (erc-server-buffer-p)) + (setq serverp (erc--server-buffer-p)) (setq chanp (erc-channel-p (erc-default-target))) (setq queryp (erc-query-buffer-p))) (cond (serverp diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 64e59a90047..c8f2e04c3eb 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -795,7 +795,9 @@ erc-track-modified-channels (if (and (not (erc-buffer-visible (current-buffer))) (not (member this-channel erc-track-exclude)) (not (and erc-track-exclude-server-buffer - (erc-server-buffer-p))) + ;; FIXME either use `erc--server-buffer-p' or + ;; explain why that's unwise. + (erc-server-or-unjoined-channel-buffer-p))) (not (erc-message-type-member (or (erc-find-parsed-property) (point-min)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f2c93d29d5c..877478690af 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1417,7 +1417,7 @@ erc-once-with-server-event channel-buffers it may not work at all, as it uses the LOCAL argument of `add-hook' and `remove-hook' to ensure multiserver capabilities." - (unless (erc-server-buffer-p) + (unless (erc--server-buffer-p) (error "You should only run `erc-once-with-server-event' in a server buffer")) (let ((fun (make-symbol "fun")) @@ -1474,19 +1474,30 @@ erc-server-buffer-live-p (and (processp erc-server-process) (buffer-live-p (process-buffer erc-server-process)))) -(defun erc-server-buffer-p (&optional buffer) +(define-obsolete-function-alias + 'erc-server-buffer-p 'erc-server-or-unjoined-channel-buffer-p "30.1") +(defun erc-server-or-unjoined-channel-buffer-p (&optional buffer) "Return non-nil if argument BUFFER is an ERC server buffer. - -If BUFFER is nil, the current buffer is used." +If BUFFER is nil, use the current buffer. For historical +reasons, also return non-nil for channel buffers the client has +parted or from which it's been kicked." (with-current-buffer (or buffer (current-buffer)) (and (eq major-mode 'erc-mode) (null (erc-default-target))))) +(defun erc--server-buffer-p (&optional buffer) + "Return non-nil if BUFFER is an ERC server buffer. +Without BUFFER, use the current buffer." + (if buffer + (with-current-buffer buffer + (and (eq major-mode 'erc-mode) (null erc--target))) + (and (eq major-mode 'erc-mode) (null erc--target)))) + (defun erc-open-server-buffer-p (&optional buffer) "Return non-nil if BUFFER is an ERC server buffer with an open IRC process. If BUFFER is nil, the current buffer is used." - (and (erc-server-buffer-p buffer) + (and (erc--server-buffer-p buffer) (erc-server-process-alive buffer))) (defun erc-query-buffer-p (&optional buffer) @@ -1858,7 +1869,10 @@ erc-member-ignore-case (defun erc-get-buffer (target &optional proc) "Return the buffer matching TARGET in the process PROC. -If PROC is not supplied, all processes are searched." +Without PROC, search all ERC buffers. For historical reasons, +skip buffers for channels the client has \"PART\"ed or from which +it's been \"KICK\"ed. Expect users to use a different function +for finding targets independent of \"JOIN\"edness." (let ((downcased-target (erc-downcase target))) (catch 'buffer (erc-buffer-filter @@ -4632,10 +4646,7 @@ erc-cmd-GQUIT ;; kill them (run-at-time 4 nil - (lambda () - (dolist (buffer (erc-buffer-list (lambda (buf) - (not (erc-server-buffer-p buf))))) - (kill-buffer buffer))))) + #'erc-buffer-do (lambda () (when erc--target (kill-buffer))))) t) (defalias 'erc-cmd-GQ #'erc-cmd-GQUIT) @@ -7075,7 +7086,9 @@ erc--current-buffer-joined-p ;; continue to use `erc-default-target'. (defun erc-default-target () - "Return the current default target (as a character string) or nil if none." + "Return the current channel or query target, if any. +For historical reasons, return nil in channel buffers if not +currently joined." (let ((tgt (car erc-default-recipients))) (cond ((not tgt) nil) @@ -7637,15 +7650,14 @@ erc-directory-writable-p (unless (file-attributes dir) (make-directory dir)) (or (file-accessible-directory-p dir) (error "Cannot access %s" dir))) +;; FIXME make function obsolete or alias to something less confusing. (defun erc-kill-query-buffers (process) - "Kill all buffers of PROCESS. -Does nothing if PROCESS is not a process object." + "Kill all target buffers of PROCESS, including channel buffers. +Do nothing if PROCESS is not a process object." ;; here, we only want to match the channel buffers, to avoid ;; "selecting killed buffers" b0rkage. (when (processp process) - (erc-with-all-buffers-of-server process - (lambda () - (not (erc-server-buffer-p))) + (erc-with-all-buffers-of-server process (lambda () erc--target) (kill-buffer (current-buffer))))) (defun erc-nick-at-point () diff --git a/test/lisp/erc/resources/join/network-id/foonet.eld b/test/lisp/erc/resources/join/network-id/foonet.eld index 7d63f5f0c6c..74a107f8144 100644 --- a/test/lisp/erc/resources/join/network-id/foonet.eld +++ b/test/lisp/erc/resources/join/network-id/foonet.eld @@ -1,8 +1,8 @@ ;; -*- mode: lisp-data; -*- ((pass 10 "PASS :foonet:changeme")) -((nick 1 "NICK tester")) +((nick 10 "NICK tester")) -((user 1 "USER user 0 * :tester") +((user 10 "USER user 0 * :tester") (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 Mon, 10 May 2021 00:58:22 UTC") commit bcebda5eec2166e475579c2aa2ee425aeabbb505 Author: F. Jason Park Date: Wed Oct 18 23:20:07 2023 -0700 Respect user markers in erc-insert-timestamp-left * lisp/erc/erc-stamp.el (erc-insert-timestamp-left): Convert to normal function, a mere wrapper that defers to existing generic variants, in order to dissuade users from adding their own methods, which could complicate troubleshooting, etc. (erc--insert-timestamp-left): Rename both methods using internal double-hyphen convention. In `erc-stamp--display-margin-mode' implementation, don't displace third-party markers. * test/lisp/erc/erc-scenarios-stamp.el: New file. (Bug#60936) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index c8fd7c35392..b515513dcb7 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -492,8 +492,11 @@ erc--conceal-prompt (put-text-property erc-insert-marker (1- erc-input-marker) 'display `((margin left-margin) ,prompt)))) -(cl-defmethod erc-insert-timestamp-left (string) +(defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." + (erc--insert-timestamp-left string)) + +(cl-defmethod erc--insert-timestamp-left (string) (goto-char (point-min)) (let* ((ignore-p (and erc-timestamp-only-if-changed-flag (string-equal string erc-timestamp-last-inserted))) @@ -504,13 +507,12 @@ erc-insert-timestamp-left (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) (insert s))) -(cl-defmethod erc-insert-timestamp-left +(cl-defmethod erc--insert-timestamp-left (string &context (erc-stamp--display-margin-mode (eql t))) (unless (and erc-timestamp-only-if-changed-flag (string-equal string erc-timestamp-last-inserted)) (goto-char (point-min)) - (insert-before-markers-and-inherit - (setq erc-timestamp-last-inserted string)) + (insert-and-inherit (setq erc-timestamp-last-inserted string)) (dolist (p erc-stamp--inherited-props) (when-let ((v (get-text-property (point) p))) (put-text-property (point-min) (point) p v))) diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el new file mode 100644 index 00000000000..d6b5d868ce5 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -0,0 +1,90 @@ +;;; erc-scenarios-stamp.el --- Misc `erc-stamp' scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 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-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-stamp) + +(defvar erc-scenarios-stamp--user-marker nil) + +(defun erc-scenarios-stamp--on-post-modify () + (when-let (((erc--check-msg-prop 'erc-cmd 4))) + (set-marker erc-scenarios-stamp--user-marker (point-max)) + (ert-info ("User marker correctly placed at `erc-insert-marker'") + (should (= ?\n (char-before erc-scenarios-stamp--user-marker))) + (should (= erc-scenarios-stamp--user-marker erc-insert-marker)) + (save-excursion + (goto-char erc-scenarios-stamp--user-marker) + ;; The raw message ends in " Iabefhkloqv". However, + ;; `erc-server-004' only prints up to the 5th parameter. + (should (looking-back "CEIMRUabefhiklmnoqstuv\n")))))) + +(ert-deftest erc-scenarios-stamp--left/display-margin-mode () + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect)) + (port (process-contact dumb-server :service)) + (erc-scenarios-stamp--user-marker (make-marker)) + (erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-server-flood-penalty 0.1) + (erc-timestamp-only-if-changed-flag nil) + (erc-insert-timestamp-function #'erc-insert-timestamp-left) + (erc-modules (cons 'fill-wrap erc-modules)) + (erc-timestamp-only-if-changed-flag nil) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + + (add-hook 'erc-insert-post-hook #'erc-scenarios-stamp--on-post-modify + nil t) + (funcall expect 5 "This server is in debug mode") + + (ert-info ("Stamps appear in left margin and are invisible") + (should (eq 'erc-timestamp (field-at-pos (pos-bol)))) + (should (= (pos-bol) (field-beginning (pos-bol)))) + (should (eq 'msg (get-text-property (pos-bol) 'erc-msg))) + (should (eq 'NOTICE (get-text-property (pos-bol) 'erc-cmd))) + (should (= ?- (char-after (field-end (pos-bol))))) + (should (equal (get-text-property (1+ (field-end (pos-bol))) + 'erc-speaker) + "irc.foonet.org")) + (should (pcase (get-text-property (pos-bol) 'display) + (`((margin left-margin) ,s) + (eq 'timestamp (get-text-property 0 'invisible s)))))) + + ;; We set a third-party marker at the end of 004's message (on + ;; then "\n"), post-insertion. + (ert-info ("User markers untouched by subsequent message left stamp") + (save-excursion + (goto-char erc-scenarios-stamp--user-marker) + (should (looking-back "CEIMRUabefhiklmnoqstuv\n")) + (should (looking-at (rx "["))))))))) + +;;; erc-scenarios-stamp.el ends here commit 47612514a9e04d6f41568c3f0cdeae837c2eae19 Author: F. Jason Park Date: Wed Oct 18 23:20:07 2023 -0700 Fix right-sided stamps commingling with erc-prompt * lisp/erc/erc-stamp.el (erc-insert-timestamp-left-and-right): Fix bug that saw the prompt being inserted after messages but just inside the narrowed operating portion of the buffer, which meant remaining modification hooks would see it upon visiting. Thanks to Corwin Brust for catching this. * test/lisp/erc/erc-fill-tests.el (erc-fill-wrap--monospace): Use custom `erc-prompt' function to guarantee invariants asserted by `erc--assert-input-bounds' are preserved throughout. (Bug#60936) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 57fd7f39e50..c8fd7c35392 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -704,10 +704,12 @@ erc-insert-timestamp-left-and-right (unless erc-stamp--date-format-end (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t) (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t) - (let ((erc--insert-marker (point-min-marker))) + (let ((erc--insert-marker (point-min-marker)) + (end-marker (point-max-marker))) (set-marker-insertion-type erc--insert-marker t) (erc-stamp--lr-date-on-pre-modify nil) - (narrow-to-region erc--insert-marker (point-max)) + (narrow-to-region erc--insert-marker end-marker) + (set-marker end-marker nil) (set-marker erc--insert-marker nil))) (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) (ts-right (with-suppressed-warnings diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index f6c4c268017..80f5fd22ac6 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -203,36 +203,39 @@ erc-fill-wrap--monospace (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) - (erc-fill-tests--wrap-populate - - (lambda () - (should (= erc-fill--wrap-value 27)) - (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-01-start") - - (ert-info ("Shift right by one (plus)") - ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p" - (ert-with-message-capture messages - ;; M-x erc-fill-wrap-nudge RET = - (ert-simulate-command '(erc-fill-wrap-nudge 2)) - (should (string-match (rx "for further adjustment") messages))) - (should (= erc-fill--wrap-value 29)) - (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-02-right")) - - (ert-info ("Shift left by five") - ;; "M-x erc-fill-wrap-nudge RET -----" - (ert-simulate-command '(erc-fill-wrap-nudge -4)) - (should (= erc-fill--wrap-value 25)) - (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-03-left")) + (let ((erc-prompt (lambda () "ABC>"))) + (erc-fill-tests--wrap-populate - (ert-info ("Reset") - ;; M-x erc-fill-wrap-nudge RET 0 - (ert-simulate-command '(erc-fill-wrap-nudge 0)) + (lambda () (should (= erc-fill--wrap-value 27)) (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-04-reset"))))) + (erc-fill-tests--compare "monospace-01-start") + + (ert-info ("Shift right by one (plus)") + ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p" + (ert-with-message-capture messages + ;; M-x erc-fill-wrap-nudge RET = + (ert-simulate-command '(erc-fill-wrap-nudge 2)) + (should (string-match (rx "for further adjustment") messages))) + (should (= erc-fill--wrap-value 29)) + (erc-fill-tests--wrap-check-prefixes "*** " " " " ") + (erc-fill-tests--compare "monospace-02-right")) + + (ert-info ("Shift left by five") + ;; "M-x erc-fill-wrap-nudge RET -----" + (ert-simulate-command '(erc-fill-wrap-nudge -4)) + (should (= erc-fill--wrap-value 25)) + (erc-fill-tests--wrap-check-prefixes "*** " " " " ") + (erc-fill-tests--compare "monospace-03-left")) + + (ert-info ("Reset") + ;; M-x erc-fill-wrap-nudge RET 0 + (ert-simulate-command '(erc-fill-wrap-nudge 0)) + (should (= erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes "*** " " " " ") + (erc-fill-tests--compare "monospace-04-reset")) + + (erc--assert-input-bounds))))) (defun erc-fill-tests--simulate-refill () ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without commit 7ffc79690ad63a09bc5baf99cbbe56654302dc72 Author: F. Jason Park Date: Sun Oct 15 17:22:22 2023 -0700 Restore missing metadata props in erc-display-line * etc/ERC-NEWS: Designate `erc-display-message' as the favored means of inserting messages. * lisp/erc/erc-fill.el (erc-fill-wrap): Skip any `unknown' `erc-msg'. * lisp/erc/erc-stamp.el (erc-stamp--current-time): Use an existing `erc-ts' text property, when present, for the current message time. * lisp/erc/erc.el (erc-display-line-1, erc-insert-line): Update doc string and declare the former an obsolete alias for the latter, `erc-insert-line'. Have `erc-log' label say `erc-display-message' even though this function is actually `erc-insert-line'. (erc-display-line): Convert to a thin wrapper around `erc-display-message', and move its existing body to a new internal function, `erc--route-insertion'. (erc--route-insertion): Adopt former body of `erc-display-line', now a convenience wrapper around `erc-display-message'. Copy `erc--msg-props' hash table when inserting a message in multiple buffers. At present, only `erc-server-QUIT' uses this facility, so such a move shouldn't impact performance in any measurable way. Also, improve readability with at most one recursive call for the fall-through case. (erc--compose-text-properties, erc--merge-text-properties-p): Rename former to latter to avoid confusion with `composition' property. (erc-display-message): Update doc string. Attempt to adapt a non-nil TYPE parameter for use as the value of the `erc-msg' text property before resorting to a value of `unknown'. But only do this when PARSED is nil, and MSG is a string. Call `erc--route-insertion' instead of `erc-display-line'. Use new name for `erc--compose-text-properties'. (erc-put-text-property): Update name of variable `erc--compose-text-properties'. * test/lisp/erc/erc-networks-tests.el (erc-networks--set-name): Mock `erc--route-insertion' instead of `erc-display-line'. * test/lisp/erc/erc-scenarios-display-message.el: New file. * test/lisp/erc/erc-tests.el (erc--route-insertion): New test. * test/lisp/erc/resources/base/display-message/multibuf.eld: New test data. ; * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update. ; * test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: Update. (Bug#60936) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 2e56539f210..e47c42a51a6 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -288,6 +288,29 @@ ERC also provisionally reserves the same depth interval for continue to modify non-ERC hooks locally whenever possible, especially in new code. +*** A singular entry point for inserting messages. +Displaying "local" messages, like help text and interactive-command +feedback, in ERC buffers has never been straightforward. As such, +ancient patterns, like the pairing of preformatted "notice" text with +ERC's oldest insertion function, 'erc-display-line', still appear +quite frequently in the wild despite having been largely phased out of +ERC's own code base in 2002. That this example has endured makes some +sense because it's probably seen as less cumbersome than fiddling with +the more powerful and complicated 'erc-display-message'. + +The latest twist in this saga comes with this release, in which a +healthy bit of "pre-insertion" business has taken up residence in +'erc-display-message'. While this would seem to put antiquated +patterns, like the above mentioned 'erc-make-notice' combo, at risk of +having messages ignored or subject to degraded treatment by built-in +modules, an adaptive measure has been introduced that recasts +'erc-display-line' as a thin wrapper around 'erc-display-message'. +And though nothing of the sort has been done for the lower-level +'erc-display-line-1' (now an obsolete alias for 'erc-insert-line'), +some last-ditch fallback code is in place to ensure baseline +functionality. As always, if you find these developments disturbing, +please say so on the tracker. + *** ERC now manages timestamp-related properties a bit differently. For starters, the 'cursor-sensor-functions' text property is absent by default unless the option 'erc-echo-timestamps' is already enabled on diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 0048956e075..e28c3563ebf 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -539,7 +539,8 @@ erc-fill-wrap (goto-char (point-min)) (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) - (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg))) + (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg)) + ((not (eq msg-prop 'unknown)))) (when-let ((e (erc--get-speaker-bounds)) (b (pop e)) ((or erc-fill--wrap-action-dedent-p diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 394643c03cb..57fd7f39e50 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -219,7 +219,9 @@ erc-stamp--current-time (erc-compat--current-lisp-time)) (cl-defmethod erc-stamp--current-time :around () - (or erc-stamp--current-time (cl-call-next-method))) + (or erc-stamp--current-time + (and erc--msg-props (gethash 'erc-ts erc--msg-props)) + (cl-call-next-method))) (defvar erc-stamp--skip nil "Non-nil means inhibit `erc-add-timestamp' completely.") diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a4c52389367..f2c93d29d5c 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3015,13 +3015,26 @@ erc--traverse-inserted (defvar erc--insert-marker nil "Internal override for `erc-insert-marker'.") -(defun erc-display-line-1 (string buffer) - "Display STRING in `erc-mode' BUFFER. -Auxiliary function used in `erc-display-line'. The line gets filtered to -interpret the control characters. Then, `erc-insert-pre-hook' gets called. -If `erc-insert-this' is still t, STRING gets inserted into the buffer. -Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called. -If STRING is nil, the function does nothing." +(define-obsolete-function-alias 'erc-display-line-1 'erc-insert-line "30.1") +(defun erc-insert-line (string buffer) + "Insert STRING in an `erc-mode' BUFFER. +When STRING is nil, do nothing. Otherwise, start off by running +`erc-insert-pre-hook' in BUFFER with `erc-insert-this' bound to +t. If the latter remains non-nil afterward, insert STRING into +BUFFER, ensuring a trailing newline. After that, narrow BUFFER +around STRING, along with its final line ending, and run +`erc-insert-modify' and `erc-insert-post-hook', respectively. In +all cases, run `erc-insert-done-hook' unnarrowed before exiting, +and update positions in `buffer-undo-list'. + +In general, expect to be called from a higher-level insertion +function, like `erc-display-message', especially when modules +should consider STRING as a candidate for formatting with +enhancements like indentation, fontification, timestamping, etc. +Otherwise, when called directly, allow built-in modules to ignore +STRING, which may make it appear incongruous in situ (unless +preformatted or anticipated by third-party members of the various +modification hooks)." (when string (with-current-buffer (or buffer (process-buffer erc-server-process)) (let ((insert-position (marker-position erc-insert-marker))) @@ -3033,7 +3046,7 @@ erc-display-line-1 (when (erc-string-invisible-p string) (erc-put-text-properties 0 (length string) '(invisible intangible) string))) - (erc-log (concat "erc-display-line: " string + (erc-log (concat "erc-display-message: " string (format "(%S)" string) " in buffer " (format "%s" buffer))) (setq erc-insert-this t) @@ -3103,39 +3116,45 @@ erc-is-valid-nick-p "Check if NICK is a valid IRC nickname." (string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick)) -(defun erc-display-line (string &optional buffer) - "Display STRING in the ERC BUFFER. -All screen output must be done through this function. If BUFFER is nil -or omitted, the default ERC buffer for the `erc-session-server' is used. -The BUFFER can be an actual buffer, a list of buffers, `all' or `active'. -If BUFFER = `all', the string is displayed in all the ERC buffers for the -current session. `active' means the current active buffer -\(`erc-active-buffer'). If the buffer can't be resolved, the current -buffer is used. `erc-display-line-1' is used to display STRING. - -If STRING is nil, the function does nothing." - (let (new-bufs) +(defun erc--route-insertion (string buffer) + "Insert STRING in BUFFER. +See `erc-display-message' for acceptable BUFFER types." + (let (seen msg-props) (dolist (buf (cond ((bufferp buffer) (list buffer)) - ((listp buffer) buffer) + ((consp buffer) + (setq msg-props erc--msg-props) + buffer) ((processp buffer) (list (process-buffer buffer))) ((eq 'all buffer) ;; Hmm, or all of the same session server? (erc-buffer-list nil erc-server-process)) - ((and (eq 'active buffer) (erc-active-buffer)) - (list (erc-active-buffer))) + ((and-let* (((eq 'active buffer)) + (b (erc-active-buffer))) + (list b))) ((erc-server-buffer-live-p) (list (process-buffer erc-server-process))) (t (list (current-buffer))))) (when (buffer-live-p buf) - (erc-display-line-1 string buf) - (push buf new-bufs))) - (when (null new-bufs) - (erc-display-line-1 string (if (erc-server-buffer-live-p) - (process-buffer erc-server-process) - (current-buffer)))))) - -(defvar erc--compose-text-properties nil + (when msg-props + (setq erc--msg-props (copy-hash-table msg-props))) + (erc-insert-line string buf) + (setq seen t))) + (unless (or seen (null buffer)) + (erc--route-insertion string nil)))) + +(defun erc-display-line (string &optional buffer) + "Insert STRING in BUFFER as a plain \"local\" message. +Take pains to ensure modification hooks see messages created by +the old pattern (erc-display-line (erc-make-notice) my-buffer) as +being equivalent to a `erc-display-message' TYPE of `notice'." + (let ((erc--msg-prop-overrides erc--msg-prop-overrides)) + (when (eq 'erc-notice-face (get-text-property 0 'font-lock-face string)) + (unless (assq 'erc-msg erc--msg-prop-overrides) + (push '(erc-msg . notice) erc--msg-prop-overrides))) + (erc-display-message nil nil buffer string))) + +(defvar erc--merge-text-properties-p nil "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") ;; To save space, we could maintain a map of all readable property @@ -3444,14 +3463,24 @@ erc-display-message Insert MSG or text derived from MSG into an ERC buffer, possibly after applying formatting by way of either a `format-spec' known to a message-catalog entry or a TYPE known to a specialized -string handler. Additionally, derive internal metadata, faces, -and other text properties from the various overloaded parameters, -such as PARSED, when it's an `erc-response' object, and MSG, when -it's a key (symbol) for a \"message catalog\" entry. Expect -ARGS, when applicable, to be `format-spec' args known to such an -entry, and TYPE, when non-nil, to be a symbol handled by +string handler. Additionally, derive metadata, faces, and other +text properties from the various overloaded parameters, such as +PARSED, when it's an `erc-response' object, and MSG, when it's a +key (symbol) for a \"message catalog\" entry. Expect ARGS, when +applicable, to be `format-spec' args known to such an entry, and +TYPE, when non-nil, to be a symbol handled by `erc-display-message-highlight' (necessarily accompanied by a -string MSG). +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 TYPE is a list of symbols, call handlers from left to right without influencing how they behave when encountering existing @@ -3463,24 +3492,31 @@ erc-display-message 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 user code will use this function instead of -`erc-display-line' when it's important that insert hooks treat -MSG in a manner befitting messages received from a server. That -is, expect to process most nontrivial informational messages, for -which PARSED is typically nil, when the caller desires -buttonizing and other effects." +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." (let ((string (if (symbolp msg) (apply #'erc-format-message msg args) msg)) (erc--msg-props (or erc--msg-props - (let* ((table (make-hash-table :size 5)) - (cmd (and parsed (erc--get-eq-comparable-cmd - (erc-response.command parsed)))) - (m (cond ((and msg (symbolp msg)) msg) - ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg)) - (t 'unknown)))) - (puthash 'erc-msg m table) + (let ((table (make-hash-table :size 5)) + (cmd (and parsed (erc--get-eq-comparable-cmd + (erc-response.command parsed))))) + (puthash 'erc-msg + (cond ((and msg (symbolp msg)) msg) + ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg)) + (type (pcase type + ((pred symbolp) type) + ((pred listp) + (intern (mapconcat #'prin1-to-string + type "-"))) + (_ 'unknown))) + (t 'unknown)) + table) (when cmd (puthash 'erc-cmd cmd table)) (and erc--msg-prop-overrides @@ -3493,7 +3529,7 @@ erc-display-message ((null type) string) ((listp type) - (let ((erc--compose-text-properties + (let ((erc--merge-text-properties-p (and (eq (car type) t) (setq type (cdr type))))) (dolist (type type) (setq string (erc-display-message-highlight type string)))) @@ -3502,13 +3538,13 @@ erc-display-message (erc-display-message-highlight type string)))) (if (not (erc-response-p parsed)) - (erc-display-line string buffer) + (erc--route-insertion string buffer) (unless (erc-hide-current-message-p parsed) (erc-put-text-property 0 (length string) 'erc-parsed parsed string) (when (erc-response.tags parsed) (erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed) string)) - (erc-display-line string buffer))))) + (erc--route-insertion string buffer))))) (defun erc-message-type-member (position list) "Return non-nil if the erc-parsed text-property at POSITION is in LIST. @@ -6493,7 +6529,7 @@ erc-put-text-property You can redefine or `defadvice' this function in order to add EmacsSpeak support." - (if erc--compose-text-properties + (if erc--merge-text-properties-p (erc--merge-prop start end property value object) (put-text-property start end property value object))) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index e95d99c128f..45ef0d10a6e 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1206,7 +1206,7 @@ erc-networks--set-name calls) (erc-mode) - (cl-letf (((symbol-function 'erc-display-line) + (cl-letf (((symbol-function 'erc--route-insertion) (lambda (&rest r) (push r calls)))) (ert-info ("Signals when `erc-server-announced-name' unset") diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el new file mode 100644 index 00000000000..51bdf305ad5 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-display-message.el @@ -0,0 +1,64 @@ +;;; erc-scenarios-display-message.el --- erc-display-message -*- lexical-binding: t -*- + +;; Copyright (C) 2023 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-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(ert-deftest erc-scenarios-display-message--multibuf () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/display-message") + (dumb-server (erc-d-run "localhost" t 'multibuf)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (erc-modules (cons 'fill-wrap erc-modules)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode"))) + + (ert-info ("User dummy is a member of #chan") + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (funcall expect 10 "dummy"))) + + (ert-info ("Dummy's QUIT notice in query contains metadata props") + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "dummy")) + (funcall expect 10 " hi") + (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit") + (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg))))) + + (ert-info ("Dummy's QUIT notice in #chan contains metadata props") + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit") + (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg))))) + + (erc-cmd-QUIT ""))) + +(eval-when-compile (require 'erc-join)) + +;;; erc-scenarios-display-message.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4f4662f5075..02dfc55b6d5 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1938,6 +1938,69 @@ erc-format-privmessage 2 5 (erc-speaker "Bob" font-lock-face erc-nick-default-face) 5 12 (font-lock-face erc-default-face)))))) +(ert-deftest erc--route-insertion () + (erc-tests--send-prep) + (erc-tests--set-fake-server-process "sleep" "1") + (setq erc-networks--id (erc-networks--id-create 'foonet)) + + (let* ((erc-modules) ; for `erc--open-target' + (server-buffer (current-buffer)) + (spam-buffer (save-excursion (erc--open-target "#spam"))) + (chan-buffer (save-excursion (erc--open-target "#chan"))) + calls) + (cl-letf (((symbol-function 'erc-insert-line) + (lambda (&rest r) (push (cons 'line-1 r) calls)))) + + (with-current-buffer chan-buffer + + (ert-info ("Null `buffer' routes to live server-buffer") + (erc--route-insertion "null" nil) + (should (equal (pop calls) `(line-1 "null" ,server-buffer))) + (should-not calls)) + + (ert-info ("Cons `buffer' routes to live members") + ;; Copies a let-bound `erc--msg-props' before mutating. + (let* ((table (map-into '(erc-msg msg) 'hash-table)) + (erc--msg-props table)) + (erc--route-insertion "cons" (list server-buffer spam-buffer)) + (should-not (eq table erc--msg-props))) + (should (equal (pop calls) `(line-1 "cons" ,spam-buffer))) + (should (equal (pop calls) `(line-1 "cons" ,server-buffer))) + (should-not calls)) + + (ert-info ("Variant `all' inserts in all session buffers") + (erc--route-insertion "all" 'all) + (should (equal (pop calls) `(line-1 "all" ,chan-buffer))) + (should (equal (pop calls) `(line-1 "all" ,spam-buffer))) + (should (equal (pop calls) `(line-1 "all" ,server-buffer))) + (should-not calls)) + + (ert-info ("Variant `active' routes to active buffer if alive") + (should (eq chan-buffer (erc-with-server-buffer erc-active-buffer))) + (erc-set-active-buffer spam-buffer) + (erc--route-insertion "act" 'active) + (should (equal (pop calls) `(line-1 "act" ,spam-buffer))) + (should (eq (erc-active-buffer) spam-buffer)) + (should-not calls)) + + (ert-info ("Variant `active' falls back to current buffer") + (should (eq spam-buffer (erc-active-buffer))) + (kill-buffer "#spam") + (erc--route-insertion "nact" 'active) + (should (equal (pop calls) `(line-1 "nact" ,server-buffer))) + (should (eq (erc-with-server-buffer erc-active-buffer) + server-buffer)) + (should-not calls)) + + (ert-info ("Dead single buffer defaults to live server-buffer") + (should-not (get-buffer "#spam")) + (erc--route-insertion "dead" 'spam-buffer) + (should (equal (pop calls) `(line-1 "dead" ,server-buffer))) + (should-not calls)))) + + (should-not (buffer-live-p spam-buffer)) + (kill-buffer chan-buffer))) + (defvar erc-tests--ipv6-examples '("1:2:3:4:5:6:7:8" "::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0" diff --git a/test/lisp/erc/resources/base/display-message/multibuf.eld b/test/lisp/erc/resources/base/display-message/multibuf.eld new file mode 100644 index 00000000000..e49a654cd06 --- /dev/null +++ b/test/lisp/erc/resources/base/display-message/multibuf.eld @@ -0,0 +1,45 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":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 Sat, 14 Oct 2023 16:08:20 UTC") + (0.02 ":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 5 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 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 5 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 5 5 :Current local users 5, max 5") + (0.02 ":irc.foonet.org 266 tester 5 5 :Current global users 5, max 5") + (0.01 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":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.")) + +((mode 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i")) + +((join 10 "JOIN #chan") + (0.03 ":tester!~u@rdjcgiwfuwqmc.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice dummy tester") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!")) + +((mode 10 "MODE #chan") + (0.01 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: Persuade this rude wretch willingly to die.") + (0.01 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1697299707") + (0.03 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :bob: It might be yours or hers, for aught I know.") + (0.07 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :Would all themselves laugh mortal.") + (0.04 ":dummy!~u@rdjcgiwfuwqmc.irc PRIVMSG tester :hi") + (0.06 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: It hath pleased the devil drunkenness to give place to the devil wrath; one unperfectness shows me another, to make me frankly despise myself.") + (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)") + (0.08 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :You speak of him when he was less furnished than now he is with that which makes him both without and within.")) + +((quit 10 "QUIT :\2ERC\2") + (0.04 ":tester!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)") + (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")) 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 238d8cc73c2..8a6f2289f5d 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 unknown 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-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-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 1680332400 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-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-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-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-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-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-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-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 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-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-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 1680332400 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-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-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-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-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-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-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-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#)) 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 d1ce9198e69..3eb4be4919b 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 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown 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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg erc-ts 0 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-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#) 436 437 (erc-msg datestamp erc-ts 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 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 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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg erc-ts 0 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-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#) 436 437 (erc-msg datestamp erc-ts 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 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#)) 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 d70184724ba..82c6d52cf7c 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* bob one\n two.\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 unknown 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-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-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 1680332400 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-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-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#)) \ 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* bob one\n two.\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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg 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-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 1680332400 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-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-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#)) 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 def97738ce6..84a1e34670c 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 unknown 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-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-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 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-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-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#)) 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 be3e2b33cfd..83394f2f639 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 unknown 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-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-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 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-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-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#)) 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 098257d0b49..1605628b29f 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 unknown 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-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-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 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-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-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#)) 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 def97738ce6..84a1e34670c 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 unknown 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-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-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 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-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-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#)) 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 360b3dafafd..7a7e01de49d 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 unknown 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-cmd PRIVMSG erc-ts 0 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-cmd PRIVMSG erc-ts 0 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-cmd PRIVMSG erc-ts 0 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 unknown 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 unknown 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-cmd PRIVMSG erc-ts 0 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#)) +#("\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-cmd PRIVMSG erc-ts 0 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-cmd PRIVMSG erc-ts 0 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-cmd PRIVMSG erc-ts 0 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-cmd PRIVMSG erc-ts 0 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#)) diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld index cd3537d3c94..bb248ffb28e 100644 --- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld @@ -1 +1 @@ -#("\n\n[00:00]*** 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.\n[00:00] 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[00:00] alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#)) \ No newline at end of file +#("\n\n[00:00]*** 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.\n[00:00] 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[00:00] alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg notice erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#)) commit a74b5de31f676d3a106687a3b972901c22784bff Author: F. Jason Park Date: Tue Oct 17 23:36:12 2023 -0700 Warn about top-level erc-update-modules calls * doc/misc/erc.texi (Modules): Describe unfavorable practices enacted by third-party modules, like running `erc-update-modules' on load. * lisp/erc/erc.el (erc-modules): Clarify comment in `custom-set' function. (erc--warn-about-aberrant-modules): Tweak warning message. (erc--requiring-module-mode-p): New internal variable. (erc--find-mode): Guard against recursive `erc-update-module' invocations. (Bug#57955) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3bfa240cacc..10902eac33f 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -412,16 +412,18 @@ Modules modules are loaded. There is a spiffy customize interface, which may be reached by typing -@kbd{M-x customize-option @key{RET} erc-modules @key{RET}}. -When removing a module outside of the Custom ecosystem, you may wish -to ensure it's disabled by invoking its associated minor-mode toggle -with a nonpositive prefix argument, for example, @kbd{C-u - M-x +@kbd{M-x customize-option @key{RET} erc-modules @key{RET}}. When +removing a module outside of Customize, you may wish to ensure it's +disabled by invoking its associated minor-mode toggle with a +nonpositive prefix argument, for example, @kbd{C-u - M-x erc-spelling-mode @key{RET}}. Additionally, if you plan on loading third-party modules that perform atypical setup on activation, you may need to arrange for calling @code{erc-update-modules} in your init file. Examples of such setup might include registering an @code{erc-before-connect} hook, advising @code{erc-open}, and -modifying @code{erc-modules} itself. +modifying @code{erc-modules} itself. On Emacs 29 and greater, you can +also run @code{erc-update-modules} indirectly, via @code{(setopt +erc-modules erc-modules)}. The following is a list of available modules. @@ -652,41 +654,54 @@ Modules And unlike global toggles, none of these ever mutates @code{erc-modules}. - +@c FIXME add section to Advanced chapter for creating modules, and +@c move this there. @anchor{Module Loading} -@subheading Module Loading +@subheading Loading @cindex module loading ERC loads internal modules in alphabetical order and third-party modules as they appear in @code{erc-modules}. When defining your own module, take care to ensure ERC can find it. An easy way to do that is by mimicking the example in the doc string for -@code{define-erc-module}. For historical reasons, ERC also falls back -to @code{require}ing features. For example, if some module -@code{} in @code{erc-modules} lacks a corresponding -@code{erc--mode} command, ERC will attempt to load the library -@code{erc-} prior to connecting. If this fails, ERC signals an -error. Users wanting to define modules in an init files should -@code{(provide 'erc-)} somewhere to placate ERC. Dynamically -generating modules on the fly is not supported. - -Sometimes, packages attempt to autoload a module's definition instead -of its minor-mode command, which breaks the link between the library -and the module. This means that enabling the mode by invoking its -command toggle isn't enough to load its defining library. Such -packages should instead only supply autoload cookies featuring an -explicit @code{autoload} form for their module's minor-mode command. -As mentioned above, packages can also usually avoid autoload cookies -entirely so long as their module's prefixed name matches that of its -defining library and the latter's provided feature. - -Packages have also been seen to specify unnecessary top-level -@code{eval-after-load} forms, which end up being ineffective in most -cases. Another unfortunate practice is mutating @code{erc-modules} -itself in an autoloaded form. Doing this tricks Customize into -displaying the widget for @code{erc-modules} incorrectly, with -built-in modules moved from the predefined checklist to the -user-provided free-form area. +@code{define-erc-module} (also shown below). For historical reasons, +ERC falls back to @code{require}ing features. For example, if some +module @code{my-module} in @code{erc-modules} lacks a corresponding +@code{erc-my-module-mode} command, ERC will attempt to load the +library @code{erc-my-module} prior to connecting. If this fails, ERC +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 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 +its command toggle isn't enough to load its defining library. As +such, packages should only supply module-related autoload cookies with +an actual @code{autoload} form for their module's minor-mode command, +like so: + +@lisp +;;;###autoload(autoload 'erc-my-module-mode "erc-my-module" nil t) +(define-erc-module my-module nil + "My doc string." + ((add-hook 'erc-insert-post-hook #'erc-my-module-on-insert-post)) + ((remove-hook 'erc-insert-post-hook #'erc-my-module-on-insert-post))) +@end lisp + +@noindent +As implied earlier, packages can usually omit such cookies entirely so +long as their module's prefixed name matches that of its defining +library and the library's provided feature. + +Finally, packages have also been observed to run +@code{erc-update-modules} in top-level forms, forcing ERC to take +special precautions to avoid recursive invocations. Another +unfortunate practice is mutating @code{erc-modules} itself upon +loading @code{erc}, possibly by way of an autoload. Doing this tricks +Customize into displaying the widget for @code{erc-modules} +incorrectly, with built-in modules moved from the predefined checklist +to the user-provided free-form area. @c PRE5_4: Document every option of every module in its own subnode diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5bf6496e926..a4c52389367 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2047,6 +2047,7 @@ erc-modules (when (symbol-value f) (message "Disabling `erc-%s'" module) (funcall f 0)) + ;; Disable local module in all ERC buffers. (unless (or (custom-variable-p f) (not (fboundp 'erc-buffer-filter))) (erc-buffer-filter (lambda () @@ -2055,8 +2056,8 @@ erc-modules (kill-local-variable f))))))))) ;; Calling `set-default-toplevel-value' complicates testing. (set sym (erc--sort-modules val)) - ;; this test is for the case where erc hasn't been loaded yet - ;; FIXME explain how this ^ can occur or remove comment. + ;; Don't initialize modules on load, even though the rare + ;; third-party module may need it. (when (fboundp 'erc-update-modules) (unless erc--inside-mode-toggle-p (erc-update-modules)))) @@ -2129,12 +2130,17 @@ erc--aberrant-modules (defun erc--warn-about-aberrant-modules () (when (and erc--aberrant-modules (not erc--target)) (erc-button--display-error-notice-with-keys-and-warn - "The following modules exhibited strange loading behavior: " + "The following modules likely engage in unfavorable loading practices: " (mapconcat (lambda (s) (format "`%s'" s)) erc--aberrant-modules ", ") ". Please contact ERC with \\[erc-bug] if you believe this to be untrue." " See Info:\"(erc) Module Loading\" for more.") (setq erc--aberrant-modules nil))) +(defvar erc--requiring-module-mode-p nil + "Non-nil while doing (require \\='erc-mymod) for `mymod' in `erc-modules'. +Used for inhibiting potentially recursive `erc-update-modules' +invocations by third-party packages.") + (defun erc--find-mode (sym) (setq sym (erc--normalize-module-symbol sym)) (if-let ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode"))) @@ -2144,10 +2150,16 @@ erc--find-mode (symbol-file mode) (ignore (cl-pushnew sym erc--aberrant-modules))))) mode - (and (require (or (get sym 'erc--feature) - (intern (concat "erc-" (symbol-name sym)))) - nil 'noerror) - (setq mode (intern-soft (concat "erc-" (symbol-name sym) "-mode"))) + (and (or (and erc--requiring-module-mode-p + ;; Also likely non-nil: (eq sym (car features)) + (cl-pushnew sym erc--aberrant-modules)) + (let ((erc--requiring-module-mode-p t)) + (require (or (get sym 'erc--feature) + (intern (concat "erc-" (symbol-name sym)))) + nil 'noerror)) + (memq sym erc--aberrant-modules)) + (or mode (setq mode (intern-soft (concat "erc-" (symbol-name sym) + "-mode")))) (fboundp mode) mode))) commit b86b187aa90a12a5228f7169eb3269684464f4ec Author: F. Jason Park Date: Thu Oct 19 22:59:17 2023 -0700 * lisp/erc/erc-backend.el (define-erc-response-handler) Edebug spec. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 3d34fc97d00..d3094b0b955 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1611,7 +1611,9 @@ define-erc-response-handler \(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)" (declare (debug (&define [&name "erc-response-handler@" - (symbolp &rest symbolp)] + ;; No `def-edebug-elem-spec' in 27. + ([&or integerp symbolp] + &rest [&or integerp symbolp])] &optional sexp sexp def-body)) (indent defun)) (if (numberp name) (setq name (intern (format "%03i" name)))) commit 6daa6f5f5ce971289831f7a1ecb50652f73a8476 Author: F. Jason Park Date: Sun Oct 15 13:43:12 2023 -0700 ; Mark erc-log test as :unstable * test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--truncate): Mark :unstable for now. * test/lisp/erc/resources/base/renick/queries/solo.eld: Timeouts. * test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld: Timeouts. * test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld: Timeouts. * test/lisp/erc/resources/erc-scenarios-common.el: Timeouts. diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index f7e7d61c92e..cd28ea54b2e 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -149,7 +149,7 @@ erc-scenarios-log--clear-stamp (when noninteractive (delete-directory tempdir :recursive)))) (ert-deftest erc-scenarios-log--truncate () - :tags '(:expensive-test) + :tags '(:expensive-test :unstable) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/assoc/bouncer-history") (dumb-server (erc-d-run "localhost" t 'foonet)) diff --git a/test/lisp/erc/resources/base/renick/queries/solo.eld b/test/lisp/erc/resources/base/renick/queries/solo.eld index 12fa7d264e9..fa4c075adac 100644 --- a/test/lisp/erc/resources/base/renick/queries/solo.eld +++ b/test/lisp/erc/resources/base/renick/queries/solo.eld @@ -30,7 +30,7 @@ (0 ":irc.foonet.org NOTICE tester :[09:56:57] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away")) -((mode 1 "MODE #foo") +((mode 10 "MODE #foo") (0 ":irc.foonet.org 324 tester #foo +nt") (0 ":irc.foonet.org 329 tester #foo 1622454985") (0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.") diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld index efc2506fd6f..d106a45cf66 100644 --- a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld +++ b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld @@ -56,7 +56,7 @@ (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!") (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!")) -((mode 1 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620205534") (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Chi non te vede, non te pretia.") diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld index a11cfac2e73..603afa2fc3e 100644 --- a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld +++ b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld @@ -52,7 +52,7 @@ (0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!") (0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!")) -((mode 1 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620205534") (0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Thou desirest me to stop in my tale against the hair.") diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 5354b300b47..9e134e6932f 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -574,7 +574,7 @@ erc-scenarios-common--upstream-reconnect :password "changeme" :full-name "tester") (erc-scenarios-common-assert-initial-buf-name nil port) - (erc-d-t-wait-for 3 (eq (erc-network) 'foonet)) + (erc-d-t-wait-for 6 (eq (erc-network) 'foonet)) (erc-d-t-wait-for 3 (string= (buffer-name) "foonet")) (funcall expect 5 "foonet"))) @@ -713,7 +713,7 @@ erc-scenarios-common--join-network-id (erc-d-t-wait-for 3 (eq erc-server-process erc-server-process-foo)) (funcall expect 3 "") (erc-d-t-absent-for 0.1 "") - (funcall expect 10 "not given me"))) + (funcall expect 20 "not given me"))) (ert-info ("All #chan@barnet output received") (with-current-buffer chan-buf-bar commit 1a8f61a9f6515901bccf69271daed0158d946dda Author: Dmitry Gutov Date: Fri Oct 20 22:04:03 2023 +0300 project--switch-project-command: Retouch * lisp/progmodes/project.el (project--switch-project-command): Remove outdated comment and clear the echo area at the end. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 0d6539113cc..fda1081eb62 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2006,13 +2006,12 @@ project--switch-project-command (when (numberp command) (setq command nil)) (unless (or project-switch-use-entire-map (assq command commands-menu)) - ;; TODO: Add some hint to the prompt, like "key not - ;; recognized" or something. (setq command nil))) (let ((global-command (lookup-key (current-global-map) choice))) (when (memq global-command '(keyboard-quit keyboard-escape-quit)) (call-interactively global-command))))) + (message nil) command)) ;;;###autoload commit 377a3c428164f3905f1f7683cfa7c3ea103667a5 Author: Eli Zaretskii Date: Fri Oct 20 15:55:45 2023 +0300 ; More fixes for LLDB support * lisp/progmodes/gud.el (gud-gud-lldb-command-name, lldb): Doc fixes. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d48ff68cc5e..aad052012cf 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3862,8 +3862,9 @@ gud-tooltip-tips (defvar gud-lldb-history nil) (defcustom gud-gud-lldb-command-name "lldb" - "Default command to run an executable under LLDB." - :type 'string) + "Default command to invoke LLDB in order to debug a progra with it." + :type 'string + :version "30.1") (defun gud-lldb-marker-filter (string) "Deduce interesting stuff from process output STRING." @@ -3999,17 +4000,17 @@ gud-lldb-initialize ;;;###autoload (defun lldb (command-line) - "Run lldb passing it COMMAND-LINE as arguments. -If COMMAND-LINE names a program FILE to debug, lldb will run in + "Run LLDB passing it COMMAND-LINE as arguments. +If COMMAND-LINE names a program FILE to debug, LLDB will run in a buffer named *gud-FILE*, and the directory containing FILE becomes the initial working directory and source-file directory -for your debugger. If you don't want `default-directory' to +for the debug session. If you don't want `default-directory' to change to the directory of FILE, specify FILE without leading directories, in which case FILE should reside either in the directory of the buffer from which this command is invoked, or it can be found by searching PATH. -If COMMAND-LINE requests that lldb attaches to a process PID, lldb +If COMMAND-LINE requests that LLDB attaches to a process PID, LLDB will run in *gud-PID*, otherwise it will run in *gud*; in these cases the initial working directory is the `default-directory' of the buffer in which this command was invoked. commit 1dac154c5d83c70c66866339c62159436d63c6b4 Author: Ulrich Müller Date: Fri Oct 20 14:50:45 2023 +0200 ; * lisp/calc/calc-units.el (math-standard-units): Drop comment for mu0. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 3e8f25966ef..f20e5801a01 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -269,8 +269,8 @@ math-standard-units ;; and mu0 no longer has the previous exact value of 4 pi 10^(-7) H/m. ( eps0 "ech^2 / (2 alpha h c)" "Permittivity of vacuum" ) ( ε0 "eps0" "Permittivity of vacuum" ) - ( mu0 "1 / (eps0 c^2)" "Permeability of vacuum") ;; Exact - ( μ0 "mu0" "Permeability of vacuum") ;; Exact + ( mu0 "1 / (eps0 c^2)" "Permeability of vacuum") + ( μ0 "mu0" "Permeability of vacuum") ( G "6.67408*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil "6.67408 10^-11 m^3/(kg s^2) (*)") ( Nav "6.02214076*10^(23) / mol" "Avogadro's constant" nil commit 199e42be2aa0a8670abd6563286da8ccc298dc79 Author: Eli Zaretskii Date: Fri Oct 20 15:50:33 2023 +0300 ; Fix recent changes of LLDB support * lisp/progmodes/gud.el (gud-lldb-max-completions) (gud-lldb-fetch-completions): Fix doc string and :version tag. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 9922948fdc2..d48ff68cc5e 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3907,7 +3907,8 @@ gud-lldb-marker-filter (defcustom gud-lldb-max-completions 20 "Maximum number of completions to request from LLDB." - :type 'integer) + :type 'integer + :version "30.1") (defvar gud-lldb-def-python-completion-function " @@ -3927,7 +3928,9 @@ gud-lldb-def-python-completion-function (defun gud-lldb-fetch-completions (context command) "Return the data to complete the LLDB command before point. This is what the Python function we installed at initialzation -time returns, as a Lisp list." +time returns, as a Lisp list. +Maximum number of completions requested from LLDB is controlled +by `gud-lldb-max-completions', which see." (let* ((process (get-buffer-process gud-comint-buffer)) (to-complete (concat context command)) (output-buffer (get-buffer-create "*lldb-completions*"))) commit a8b14b77ffa11803fda02c645b0181b616950b71 Author: Eli Zaretskii Date: Fri Oct 20 15:46:20 2023 +0300 ; * lisp/emacs-lisp/comp-cstr.el: Fix punctuation. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 57ae39520c5..d23304c8874 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -263,7 +263,7 @@ comp-intersection-valsets ;;; Type handling. (defun comp--sym-lessp (x y) - "Like `string-lessp' but for strings." + "Like `string-lessp' but for symbol names." (string-lessp (symbol-name x) (symbol-name y))) @@ -277,7 +277,7 @@ comp--direct-supertype do (cl-return-from outer y)))) (defun comp--normalize-typeset0 (typeset) - ;; For every type search its supertype. If all the subtypes of that + ;; For every type search its supertype. If all the subtypes of that ;; supertype are presents remove all of them, add the identified ;; supertype and restart. (when typeset @@ -302,7 +302,7 @@ comp-normalize-typeset (defun comp--direct-subtypes (type) "Return all the direct subtypes of TYPE." - ;; TODO memoize. + ;; TODO: memoize. (cl-sort (cl-loop for j in (comp-cstr-ctxt-typeof-types comp-ctxt) for res = (cl-loop for i in j commit 8fa0f13e6e05ba1e9e7f27f240f6ec7d08d09901 Author: Po Lu Date: Fri Oct 20 19:09:22 2023 +0800 Repair detection of empty mailto URLs * java/org/gnu/emacs/EmacsOpenActivity.java (onCreate): Additonally regard mailto:// as an empty URL, since Android does interpret them as such. diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java index f0f1068d3e2..a5e8be2f238 100644 --- a/java/org/gnu/emacs/EmacsOpenActivity.java +++ b/java/org/gnu/emacs/EmacsOpenActivity.java @@ -470,7 +470,7 @@ private class EmacsClientThread extends Thread whereupon Emacs should replace it with any address provided as EXTRA_EMAIL. */ - if (fileName.equals ("mailto:")) + if (fileName.equals ("mailto:") || fileName.equals ("mailto://")) { tem = intent.getCharSequenceExtra (Intent.EXTRA_EMAIL); commit feba0dd457cf69168efe7501070124b35f0a5373 Author: Gerd Möllmann Date: Thu Oct 19 16:24:53 2023 +0200 Fix Gud LLDB completion for function names LLDB completion candidates can contain parentheses. * lisp/progmodes/gud.el (gud-lldb-fetch-completions): Use unique completion list delimiters. Add timeout to accept-process-input. (gud-lldb-def-python-completion-function): Use new completion list delimiters. (lldb): Add hint about completions to doc string. (gud-lldb-marker-filter): Don't use eval. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 8518738d09e..9922948fdc2 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -40,7 +40,6 @@ ;;; Code: (require 'comint) -(require 'cl-macs) (defvar gdb-active-process) (defvar gdb-define-alist) @@ -3866,9 +3865,6 @@ gud-gud-lldb-command-name "Default command to run an executable under LLDB." :type 'string) -(cl-defun gud-lldb-stop (&key file line column) - (setq gud-last-frame (list file line column))) - (defun gud-lldb-marker-filter (string) "Deduce interesting stuff from process output STRING." (cond @@ -3876,8 +3872,13 @@ gud-lldb-marker-filter ((string-match (rx line-start (0+ blank) "gud-info:" (0+ blank) (group "(" (1+ (not ")")) ")")) string) - (let ((form (string-replace "///" "\"" (match-string 1 string)))) - (eval (car (read-from-string form))))) + (let* ((form (string-replace "///" "\"" (match-string 1 string))) + (form (car (read-from-string form)))) + (when (eq (car form) 'gud-lldb-stop) + (let ((plist (cdr form))) + (setq gud-last-frame (list (plist-get plist :file) + (plist-get plist :line) + (plist-get plist :column))))))) ;; Process 72874 exited with status = 9 (0x00000009) killed. ;; Doesn't seem to be changeable as of LLDB 17.0.2. ((string-match (rx "Process " (1+ digit) " exited with status") @@ -3914,12 +3915,12 @@ gud-lldb-def-python-completion-function interpreter = lldb.debugger.GetCommandInterpreter() string_list = lldb.SBStringList() interpreter.HandleCompletion(s, len(s), len(s), max, string_list) - print('gud-completions: (') + print('gud-completions: ##(') # Specifying a max count doesn't seem to work in LLDB 17. max = min(max, string_list.GetSize()) for i in range(max): print(f'\"{string_list.GetStringAtIndex(i)}\" ') - print(')') + print(')##') " "LLDB Python function for completion.") @@ -3940,12 +3941,12 @@ gud-lldb-fetch-completions ;; Wait for output (unwind-protect (while (not comint-redirect-completed) - (accept-process-output process)) + (accept-process-output process 2)) (comint-redirect-cleanup)) ;; Process the completion output. (with-current-buffer output-buffer (goto-char (point-min)) - (when (search-forward "gud-completions:" nil t) + (when (search-forward "gud-completions: ##" nil t) (read (current-buffer)))))) (defun gud-lldb-completions (context command) @@ -4008,7 +4009,13 @@ lldb If COMMAND-LINE requests that lldb attaches to a process PID, lldb will run in *gud-PID*, otherwise it will run in *gud*; in these cases the initial working directory is the `default-directory' of -the buffer in which this command was invoked." +the buffer in which this command was invoked. + +Please note that completion framework that complete while you +type, like Corfu, do not work well with this mode. You should +consider to turn them off in this mode. + +This command runs functions from `lldb-mode-hook'. " (interactive (list (gud-query-cmdline 'lldb))) (when (and gud-comint-buffer commit 90bfb1075d1615da7f80432d6c3465210bb96f0d Author: Po Lu Date: Fri Oct 20 15:03:56 2023 +0800 Treat empty mailto URIs properly under Android * java/org/gnu/emacs/EmacsOpenActivity.java (onCreate): If an empty mailto: URI is supplied, ascertain if EXTRA_EMAIL is set, then derive a mailto URI from that if so. diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java index 0c0da6acd1f..f0f1068d3e2 100644 --- a/java/org/gnu/emacs/EmacsOpenActivity.java +++ b/java/org/gnu/emacs/EmacsOpenActivity.java @@ -462,10 +462,30 @@ private class EmacsClientThread extends Thread /* Escape the special characters $ and " before enclosing the string within the `message-mailto' wrapper. */ fileName = uri.toString (); + + /* If fileName is merely mailto: (absent either an email + address or content), then the program launching Emacs + conceivably provided such an URI to exclude non-email + programs from being enumerated within the Share dialog; + whereupon Emacs should replace it with any address + provided as EXTRA_EMAIL. */ + + if (fileName.equals ("mailto:")) + { + tem = intent.getCharSequenceExtra (Intent.EXTRA_EMAIL); + + if (tem != null) + fileName = "mailto:" + tem; + } + + /* Subsequently, escape fileName such that it is rendered + safe to append to the command line. */ + fileName = (fileName .replace ("\\", "\\\\") .replace ("\"", "\\\"") .replace ("$", "\\$")); + fileName = "(message-mailto \"" + fileName + "\" "; /* Parse the intent itself to ascertain if any commit b99d12c30c3abc05fd977b695b7beac12e9302f0 Author: Jens Schmidt Date: Wed Oct 18 22:43:37 2023 +0200 ; Fix argument name for function `copy-file' * doc/lispref/files.texi (Changing Files): Change name of last argument of function `copy-file' from `preserve-extended-attributes' to `preserve-permissions', as used in the function's description, its doc string and the description below in the manual. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index f8781d4895b..6a8bd69b102 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1797,7 +1797,7 @@ Changing Files @var{oldname} is a directory and a non-directory otherwise. @end deffn -@deffn Command copy-file oldname newname &optional ok-if-already-exists time preserve-uid-gid preserve-extended-attributes +@deffn Command copy-file oldname newname &optional ok-if-already-exists time preserve-uid-gid preserve-permissions This command copies the file @var{oldname} to @var{newname}. An error is signaled if @var{oldname} is not a regular file. If @var{newname} names a directory, it copies @var{oldname} into that directory, commit e170869712295a97815044a89fa4157450f1674d Author: Dmitry Gutov Date: Fri Oct 20 01:24:56 2023 +0300 Improve behavior with project-switch-use-entire-map=t * lisp/progmodes/project.el (project--keymap-prompt): New function. (project--switch-project-command): Use it when project-switch-use-entire-map is non-nil. Also check that CHOICE is not a number (bug#63648). And print incorrect inputs too. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4a47b4e94a1..0d6539113cc 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1941,6 +1941,15 @@ project-key-prompt-style :version "30.1") (defun project--keymap-prompt () + "Return a prompt for the project switching using the prefix map." + (let (keys) + (map-keymap + (lambda (evt _) + (when (characterp evt) (push evt keys))) + project-prefix-map) + (mapconcat (lambda (key) (help-key-description (string key) nil)) keys " "))) + +(defun project--menu-prompt () "Return a prompt for the project switching dispatch menu." (mapconcat (pcase-lambda (`(,cmd ,label ,key)) @@ -1979,11 +1988,22 @@ project--switch-project-command (when-let ((cmd (nth 0 row)) (keychar (nth 2 row))) (define-key temp-map (vector keychar) cmd))))) - command) + command + choice) (while (not command) (let* ((overriding-local-map commands-map) - (choice (read-key-sequence (project--keymap-prompt)))) + (prompt (if project-switch-use-entire-map + (project--keymap-prompt) + (project--menu-prompt)))) + (when choice + (setq prompt (concat prompt + (format " %s: %s" + (propertize "Unrecognized input" + 'face 'warning) + (help-key-description choice nil))))) + (setq choice (read-key-sequence (concat "Choose: " prompt))) (when (setq command (lookup-key commands-map choice)) + (when (numberp command) (setq command nil)) (unless (or project-switch-use-entire-map (assq command commands-menu)) ;; TODO: Add some hint to the prompt, like "key not commit 4ace48f394e6c825393f9a0d58024af18a7d675b Author: Juri Linkov Date: Thu Oct 19 21:50:28 2023 +0300 * lisp/progmodes/project.el (project--other-place-prefix): New function. (project-other-window-command, project-other-frame-command) (project-other-tab-command): Use it in Emacs versions not less than 30 where other-*-prefix commands are available. This fixes the cases such as 'C-u C-x 5 p p f TAB' from bug#65558. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index b9ecb770e60..4a47b4e94a1 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -880,6 +880,17 @@ project--other-place-command (call-interactively cmd) (user-error "%s is undefined" (key-description key))))) +(defun project--other-place-prefix (place &optional extra-keymap) + (cl-assert (member place '(window frame tab))) + (prefix-command-preserve-state) + (let ((inhibit-message t)) (funcall (intern (format "other-%s-prefix" place)))) + (message "Display next project command buffer in a new %s..." place) + ;; Should return exitfun from set-transient-map + (set-transient-map (if extra-keymap + (make-composed-keymap project-prefix-map + extra-keymap) + project-prefix-map))) + ;;;###autoload (defun project-other-window-command () "Run project command, displaying resultant buffer in another window. @@ -889,9 +900,11 @@ project-other-window-command \\{project-prefix-map} \\{project-other-window-map}" (interactive) - (project--other-place-command '((display-buffer-pop-up-window) - (inhibit-same-window . t)) - project-other-window-map)) + (if (< emacs-major-version 30) + (project--other-place-command '((display-buffer-pop-up-window) + (inhibit-same-window . t)) + project-other-window-map) + (project--other-place-prefix 'window project-other-window-map))) ;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command) @@ -904,8 +917,10 @@ project-other-frame-command \\{project-prefix-map} \\{project-other-frame-map}" (interactive) - (project--other-place-command '((display-buffer-pop-up-frame)) - project-other-frame-map)) + (if (< emacs-major-version 30) + (project--other-place-command '((display-buffer-pop-up-frame)) + project-other-frame-map) + (project--other-place-prefix 'frame project-other-frame-map))) ;;;###autoload (define-key ctl-x-5-map "p" #'project-other-frame-command) @@ -917,7 +932,9 @@ project-other-tab-command \\{project-prefix-map}" (interactive) - (project--other-place-command '((display-buffer-in-new-tab)))) + (if (< emacs-major-version 30) + (project--other-place-command '((display-buffer-in-new-tab))) + (project--other-place-prefix 'tab))) ;;;###autoload (when (bound-and-true-p tab-prefix-map) commit abbd86d90ef61b5ffe72178b4d94eae314e4572c Author: Michael Albinus Date: Thu Oct 19 16:39:01 2023 +0200 Adapt Tramp version * lisp/net/trampver.el (customize-package-emacs-version-alist): Adapt Tramp version integrated in Emacs 29.2. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 4d56cf367e3..aefe14e845e 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -105,7 +105,7 @@ tramp-inside-emacs ("2.3.5.26.3" . "26.3") ("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2") ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2") ("2.5.4" . "28.3") - ("2.6.0.29.1" . "29.1"))) + ("2.6.0.29.1" . "29.1") ("2.6.2.29.2" . "29.2"))) (add-hook 'tramp-unload-hook (lambda () commit 62920dcb0de440aac8e7d69ee33f27d5400d405e Author: Michael Albinus Date: Thu Oct 19 16:28:26 2023 +0200 Update Tramp version (don't merge with master) * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.6.2.29.2". (customize-package-emacs-version-alist): Adapt Tramp version integrated in Emacs 29.2. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index c2560169e31..a2ab225f7f7 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-pre +@set trampver 2.6.2.29.2 @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/trampver.el b/lisp/net/trampver.el index f96ffac2e13..44a39dbfc12 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-pre +;; Version: 2.6.2.29.2 ;; 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-pre" +(defconst tramp-version "2.6.2.29.2" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ tramp-repository-version ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "26.1")) "ok" - (format "Tramp 2.6.2-pre is not fit for %s" + (format "Tramp 2.6.2.29.2 is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) @@ -105,7 +105,7 @@ tramp-inside-emacs ("2.3.5.26.3" . "26.3") ("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2") ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2") ("2.5.4" . "28.3") - ("2.6.0.29.1" . "29.1"))) + ("2.6.0.29.1" . "29.1") ("2.6.2.29.2" . "29.2"))) (add-hook 'tramp-unload-hook (lambda () commit d7c91d74b659c0bc5afb9bb79ba0b729ab7f14d8 Author: Stefan Monnier Date: Thu Oct 19 10:21:22 2023 -0400 (cl--typeof-types): Complete last change * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Add `integer-or-marker` in the hierarchy as well. diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 96e288db7d5..27603ae8626 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -52,12 +52,12 @@ cl--assertion-failed (defconst cl--typeof-types ;; Hand made from the source code of `type-of'. - '((integer number number-or-marker atom) + '((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 number-or-marker atom) + (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 @@ -65,7 +65,7 @@ cl--typeof-types (subr atom) ;; FIXME: We should probably reverse the order between ;; `compiled-function' and `byte-code-function' since arguably - ;; `subr' and also "compiled functions" but not "byte code functions", + ;; `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. commit d1bc4cdc6a4173a7aa4832562d625fe68bc20a8f Author: Ulf Jasper Date: Thu Oct 19 15:59:40 2023 +0200 * admin/MAINTAINERS: Remove Ulf Jasper as maintainer of icalendar.el diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 1801842bdcb..a6e1baf85e1 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -124,10 +124,6 @@ Ulf Jasper lisp/net/newsticker.el test/lisp/net/newsticker-tests.el - Icalendar - lisp/calendar/icalendar.el - test/lisp/calendar/icalendar-tests.el - Amin Bandali ERC lisp/erc/* commit 694c4d538ed388b0972415474e609ab54721c29f Author: Gerd Möllmann Date: Thu Oct 19 14:56:07 2023 +0200 Fix last change in gud.el * lisp/progmodes/gud.el (gud-lldb-initialize): Fix duplicated output. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 805e7a1b7a4..8518738d09e 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3991,7 +3991,6 @@ gud-lldb-initialize (gud-basic-call "settings set stop-line-count-after 0") (gud-basic-call (format "settings set frame-format \"%s\"" gud-lldb-frame-format)) - (gud-basic-call "script --language python -- print('Gud initialized')") (gud-basic-call "script --language python -- print('Gud initialized.')")) ;;;###autoload commit a567faf4c2bc497e50ce3c6ace32c1333cf3b706 Author: Andrea Corallo Date: Wed Oct 18 16:10:08 2023 +0200 Add two missing 'number-or-marker' entries to the cl machinery (bug#66615) Assuming 'number-or-marker' is a type (as present multiple times in cl--typeof-types) adding some missing entries for coherency. * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Add 'number-or-marker' as supertype of 'number' in the 'float' branch. * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add 'number-or-marker'. * test/lisp/emacs-lisp/comp-cstr-tests.el (comp-cstr-typespec-tests-alist): Update test. * test/src/comp-tests.el (comp-tests-type-spec-tests): Update two testes. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 8025a64f1bf..722d561b9f4 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3502,7 +3502,8 @@ cl--macroexp-fboundp (symbol . symbolp) (vector . vectorp) (window . windowp) - ;; FIXME: Do we really want to consider this a type? + ;; FIXME: Do we really want to consider these types? + (number-or-marker . number-or-marker-p) (integer-or-marker . integer-or-marker-p) )) (put type 'cl-deftype-satisfies pred)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 676326980aa..96e288db7d5 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -58,8 +58,8 @@ cl--typeof-types ;; Markers aren't `numberp', yet they are accepted wherever integers are ;; accepted, pretty much. (marker number-or-marker atom) - (overlay atom) (float number atom) (window-configuration atom) - (process atom) (window 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) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index a4f282fcfef..d2f552af6fa 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -191,7 +191,7 @@ ;; 74 ((and boolean (or number marker)) . nil) ;; 75 - ((and atom (or number marker)) . (or marker number)) + ((and atom (or number marker)) . number-or-marker) ;; 76 ((and symbol (or number marker)) . nil) ;; 77 diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 4444ab61219..2b3c3dd4c75 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -977,7 +977,7 @@ comp-tests-check-ret-type-spec (if (= x y) x 'foo)) - '(or (member foo) marker number)) + '(or (member foo) number-or-marker)) ;; 14 ((defun comp-tests-ret-type-spec-f (x) @@ -1117,7 +1117,7 @@ comp-tests-check-ret-type-spec ((defun comp-tests-ret-type-spec-f (x) (when (> x 1.0) x)) - '(or null marker number)) + '(or null number-or-marker)) ;; 36 ((defun comp-tests-ret-type-spec-f (x y) commit 3e193edd68b1abd9483267ba09c6e5c0c59e6c23 Author: Andrea Corallo Date: Wed Oct 18 16:14:45 2023 +0200 Improve cstr typeset normalization * test/lisp/emacs-lisp/comp-cstr-tests.el (comp-cstr-typespec-tests-alist): Add four tests. * lisp/emacs-lisp/comp-cstr.el (comp--sym-lessp) (comp--direct-supertype, comp--normalize-typeset0): New functions. (comp-normalize-typeset): Rework to make use of 'comp--normalize-typeset0'. (comp--direct-subtypes): New function. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 7e3ca1f3bae..57ae39520c5 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -262,12 +262,57 @@ comp-intersection-valsets ;;; Type handling. +(defun comp--sym-lessp (x y) + "Like `string-lessp' but for strings." + (string-lessp (symbol-name x) + (symbol-name y))) + +(defun comp--direct-supertype (type) + "Return the direct supertype of TYPE." + (cl-loop + named outer + for i in (comp-cstr-ctxt-typeof-types comp-ctxt) + do (cl-loop for (j y) on i + when (eq j type) + do (cl-return-from outer y)))) + +(defun comp--normalize-typeset0 (typeset) + ;; For every type search its supertype. If all the subtypes of that + ;; supertype are presents remove all of them, add the identified + ;; supertype and restart. + (when typeset + (while (eq 'restart + (cl-loop + named main + for i in typeset + for sup = (comp--direct-supertype i) + for subs = (comp--direct-subtypes sup) + when (and sup + (length> subs 1) + (cl-every (lambda (x) (member x typeset)) subs)) + do (cl-loop for s in subs + do (setq typeset (cl-delete s typeset)) + finally (progn (push sup typeset) + (cl-return-from main 'restart)))))) + typeset)) + (defun comp-normalize-typeset (typeset) "Sort TYPESET and return it." - (cl-sort (cl-remove-duplicates typeset) - (lambda (x y) - (string-lessp (symbol-name x) - (symbol-name y))))) + (cl-sort (comp--normalize-typeset0 (cl-remove-duplicates typeset)) #'comp--sym-lessp)) + +(defun comp--direct-subtypes (type) + "Return all the direct subtypes of TYPE." + ;; TODO memoize. + (cl-sort + (cl-loop for j in (comp-cstr-ctxt-typeof-types comp-ctxt) + for res = (cl-loop for i in j + with last = nil + when (eq i type) + return last + do (setq last i)) + when res + collect res) + #'comp--sym-lessp)) (defun comp-supertypes (type) "Return a list of pairs (supertype . hierarchy-level) for TYPE." diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index 78d9bb49b98..a4f282fcfef 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -217,7 +217,16 @@ ;; 87 ((and (or null integer) (not (or null integer))) . nil) ;; 88 - ((and (or (member a b c)) (not (or (member a b)))) . (member c))) + ((and (or (member a b c)) (not (or (member a b)))) . (member c)) + ;; 89 + ((or cons symbol) . list) + ;; 90 + ((or string char-table bool-vector vector) . array) + ;; 91 + ((or string char-table bool-vector vector number) . (or array number)) + ;; 92 + ((or string char-table bool-vector vector cons symbol number) . + (or number sequence))) "Alist type specifier -> expected type specifier.")) (defmacro comp-cstr-synthesize-tests () commit d963bc6c6b69c084e64d421d5f4938c13ed24c0f (tag: refs/tags/emacs-29.1.90) Author: Eli Zaretskii Date: Thu Oct 19 05:38:30 2023 -0400 ; * lisp/ldefs-boot.el: Regenerated for Emacs 29.1.90. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 99fff8d8c98..82643a55508 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5202,6 +5202,24 @@ dynamic-completion-mode (autoload 'dynamic-completion-mode "completion" "\ Toggle dynamic word-completion on or off. +When this minor mode is turned on, typing \\`M-RET' or \\`C-RET' +invokes the command `complete', which completes the word or +symbol at point using the record of words/symbols you used +previously and the previously-inserted completions. Typing +a word or moving point across it constitutes \"using\" the +word. + +By default, the database of all the dynamic completions that +were inserted by \\[complete] is saved on the file specified +by `save-completions-file-name' when you exit Emacs, and will +be loaded from that file when this mode is enabled in a future +Emacs session. + +The following important options control the various aspects of +this mode: `enable-completion', `save-completions-flag', and +`save-completions-retention-time'. Few other less important +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 @@ -8938,7 +8956,7 @@ 'edirs-merge-with-ancestor (autoload 'ediff-windows-wordwise "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, wordwise. This compares the portions of text visible in each of the two windows. -With prefix argument, DUMB-MODE, or on a non-windowing display, works as +With prefix argument, DUMB-MODE, or on a non-graphical display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A. @@ -8949,7 +8967,7 @@ 'edirs-merge-with-ancestor (autoload 'ediff-windows-linewise "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, linewise. This compares the portions of text visible in each of the two windows. -With prefix argument, DUMB-MODE, or on a non-windowing display, works as +With prefix argument, DUMB-MODE, or on a non-graphical display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A. @@ -17701,9 +17719,8 @@ "image-file" (fn &optional ARG)" t) (autoload 'image-mode-to-text "image-mode" "\ -Set a non-image mode as major mode in combination with image minor mode. -A non-mage major mode found from `auto-mode-alist' or fundamental mode -displays an image file as text.") +Set current buffer's modes be a non-image major mode, plus `image-minor-mode'. +A non-image major mode displays an image file as text.") (autoload 'image-bookmark-jump "image-mode" "\ @@ -19185,6 +19202,13 @@ "less-css-mode" inside the original alist by using dots inside the symbol, as displayed in the example above. +Note that there is no way to differentiate the case where a key +is missing from when it is present, but its value is nil. Thus, +the following form evaluates to nil: + + (let-alist \\='((some-key . nil)) + .some-key) + (fn ALIST &rest BODY)" nil t) (function-put 'let-alist 'lisp-indent-function 1) (register-definition-prefixes "let-alist" '("let-alist--")) @@ -22474,7 +22498,7 @@ "opascal" ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 6 6)) package--builtin-versions) +(push (purecopy '(org 9 6 10)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -28325,7 +28349,7 @@ "sendmail" ;;; Generated autoloads from emacs-lisp/seq.el -(push (purecopy '(seq 2 23)) package--builtin-versions) +(push (purecopy '(seq 2 24)) package--builtin-versions) ;;; Generated autoloads from server.el @@ -32199,7 +32223,10 @@ 'time-to-seconds (fn SECONDS)") (autoload 'days-to-time "time-date" "\ -Convert DAYS into a time value. +Convert Emacs-epoch DAYS into a time value. +Note that this does not use the same epoch as `time-to-days'; you +must subtract (time-to-days 0) first to convert, and may get nil +if the result is before the start. (fn DAYS)") (autoload 'time-since "time-date" "\ @@ -32228,7 +32255,7 @@ 'subtract-time (fn TIME)") (autoload 'time-to-days "time-date" "\ -The absolute date corresponding to TIME, a time value. +The absolute pseudo-Gregorian date for TIME, a time value. The absolute date is the number of days elapsed since the imaginary Gregorian date Sunday, December 31, 1 BC. @@ -32844,7 +32871,7 @@ "tramp-uu" ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 6 0 29 1)) package--builtin-versions) +(push (purecopy '(tramp 2 6 2 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -33186,7 +33213,9 @@ "type-break" ;;; Generated autoloads from progmodes/typescript-ts-mode.el (autoload 'typescript-ts-base-mode "typescript-ts-mode" "\ -Major mode for editing TypeScript. +Generic major mode for editing TypeScript. + +This mode is intended to be inherited by concrete major modes. (fn)" t) (autoload 'typescript-ts-mode "typescript-ts-mode" "\ @@ -33205,7 +33234,7 @@ "type-break" at least 3 (which is the default value). (fn)" t) -(register-definition-prefixes "typescript-ts-mode" '("tsx-ts-mode--" "typescript-ts-mode-")) +(register-definition-prefixes "typescript-ts-mode" '("tsx-ts-" "typescript-ts-")) ;;; Generated autoloads from international/ucs-normalize.el @@ -34087,7 +34116,7 @@ "use-package-ensure" ;;; Generated autoloads from use-package/use-package-ensure-system-package.el -(push (purecopy '(use-package-ensure-system-package 0 2)) package--builtin-versions) +(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). @@ -34254,18 +34283,23 @@ vc-before-checkin-hook (autoload 'vc-next-action "vc" "\ Do the next logical version control operation on the current fileset. This requires that all files in the current VC fileset be in the -same state. If not, signal an error. - -For merging-based version control systems: - If every file in the VC fileset is not registered for version - control, register the fileset (but don't commit). - If every work file in the VC fileset is added or changed, pop - up a *vc-log* buffer to commit the fileset. +same state. If they are not, signal an error. Also signal an error if +files in the fileset are missing (removed, but tracked by version control), +or are ignored by the version control system. + +For modern merging-based version control systems: + If every file in the fileset is not registered for version + control, register the fileset (but don't commit). If VERBOSE is + non-nil (interactively, the prefix argument), ask for the VC + backend with which to register the fileset. + If every work file in the VC fileset is either added or modified, + pop up a *vc-log* buffer to commit the fileset changes. For a centralized version control system, if any work file in the VC fileset is out of date, offer to update the fileset. For old-style locking-based version control systems, like RCS: - If every file is not registered, register the file(s). + If every file is not registered, register the file(s); with a prefix + argument, allow to specify the VC backend for registration. If every file is registered and unlocked, check out (lock) the file(s) for editing. If every file is locked by you and has changes, pop up a @@ -34273,14 +34307,21 @@ vc-before-checkin-hook read-only copy of each changed file after checking in. If every file is locked by you and unchanged, unlock them. If every file is locked by someone else, offer to steal the lock. + If files are unlocked, but have changes, offer to either claim the + lock or revert to the last checked-in version. + +If this command is invoked from a patch buffer under `diff-mode', it +will apply the diffs from the patch and pop up a *vc-log* buffer to +check-in the resulting changes. When using this command to register a new file (or files), it will automatically deduce which VC repository to register it with, using the most specific one. If VERBOSE is non-nil (interactively, the prefix argument), -you can specify a VC backend or (for centralized VCS only) -the revision ID or branch ID. +you can specify another VC backend for the file(s), +or (for centralized VCS only) the revision ID or branch ID +from which to check out the file(s). (fn VERBOSE)" t) (autoload 'vc-register "vc" "\ @@ -36829,6 +36870,10 @@ woman-locale Used non-interactively, arguments are optional: if given then TOPIC should be a topic string and non-nil RE-CACHE forces re-caching. +Note that `M-x woman' doesn’t yet support the latest features of +modern man pages, so we recommend using `M-x man' if that is +available on your system. + (fn &optional TOPIC RE-CACHE)" t) (autoload 'woman-dired-find-file "woman" "\ In dired, run the WoMan man-page browser on this file." t) commit 0fd7f785e76c9f2eea1baa40aed6ee327f68a993 Author: Gerd Möllmann Date: Thu Oct 19 11:27:14 2023 +0200 Gud support for column numbers Allow gud-last-frame to be of the form (FILE LINE COLUMN). * lisp/progmodes/gud.el (gud-display-frame): Support column numbers. (gud-display-line): New optional parameter for column number. Move point to that column, if set. (gud-lldb-marker-filter): Set column number. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 5bc333c6730..805e7a1b7a4 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3021,7 +3021,12 @@ gud-display-frame (interactive) (when gud-last-frame (gud-set-buffer) - (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) + ;; Support either (file . line) or (file line column). + (if (consp (cdr gud-last-frame)) + (let ((line (cadr gud-last-frame)) + (column (caddr gud-last-frame))) + (gud-display-line (car gud-last-frame) line column)) + (gud-display-line (car gud-last-frame) (cdr gud-last-frame))) (setq gud-last-last-frame gud-last-frame gud-last-frame nil))) @@ -3054,7 +3059,7 @@ gud-highlight-current-line-face "Face for highlighting the source code line being executed." :version "30.1") -(defun gud-display-line (true-file line) +(defun gud-display-line (true-file line &optional column) (let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. (buffer (with-current-buffer gud-comint-buffer @@ -3080,6 +3085,8 @@ gud-display-line (goto-char (point-min)) (forward-line (1- line)) (setq pos (point)) + (when column + (forward-char (1- column))) (or gud-overlay-arrow-position (setq gud-overlay-arrow-position (make-marker))) (set-marker gud-overlay-arrow-position (point) (current-buffer)) @@ -3859,8 +3866,8 @@ gud-gud-lldb-command-name "Default command to run an executable under LLDB." :type 'string) -(cl-defun gud-lldb-stop (&key file line _column) - (setq gud-last-frame (cons file line))) +(cl-defun gud-lldb-stop (&key file line column) + (setq gud-last-frame (list file line column))) (defun gud-lldb-marker-filter (string) "Deduce interesting stuff from process output STRING." commit f2ae1996f74320a0fbefa66cb7acc88fe4c163e3 Author: Gerd Möllmann Date: Thu Oct 19 10:28:15 2023 +0200 Don't rely on LLDB output format Let Gud define its own frame format that is easily parseable, and also contains the full source file path. * lisp/progmodes/gud.el (gud-lldb-stop): New function. (gud-lldb-marker-filter): Support new frame-format. (gud-lldb-frame-format): variable for frame-format. (gud-lldb-initialize): Set frame-format. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 1c7810803e2..5bc333c6730 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -40,6 +40,7 @@ ;;; Code: (require 'comint) +(require 'cl-macs) (defvar gdb-active-process) (defvar gdb-define-alist) @@ -708,7 +709,7 @@ gud-gdb-marker-filter (setq gud-marker-acc (concat gud-marker-acc string)) (let ((output "")) - ;; Process all the complete markers in this chunk. + ;; Processn all the complete markers in this chunk. (while (string-match gud-gdb-marker-regexp gud-marker-acc) (setq @@ -3858,25 +3859,24 @@ gud-gud-lldb-command-name "Default command to run an executable under LLDB." :type 'string) +(cl-defun gud-lldb-stop (&key file line _column) + (setq gud-last-frame (cons file line))) + (defun gud-lldb-marker-filter (string) "Deduce interesting stuff from process output STRING." - (cond (;; Process 72668 stopped - ;; * thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 1.1 - ;; frame #0: ...) at emacs.c:1310:9 [opt] - (string-match (rx (and line-start (0+ blank) "frame" - (0+ not-newline) " at " - (group (1+ (not ":"))) - ":" - (group (1+ digit)))) - string) - (setq gud-last-frame - (cons (match-string 1 string) - (string-to-number (match-string 2 string))))) - (;; Process 72874 exited with status = 9 (0x00000009) killed - (string-match (rx "Process " (1+ digit) " exited with status") - string) - (setq gud-last-last-frame nil) - (setq gud-overlay-arrow-position nil))) + (cond + ;; gud-info: (function-name args...) + ((string-match (rx line-start (0+ blank) "gud-info:" (0+ blank) + (group "(" (1+ (not ")")) ")")) + string) + (let ((form (string-replace "///" "\"" (match-string 1 string)))) + (eval (car (read-from-string form))))) + ;; Process 72874 exited with status = 9 (0x00000009) killed. + ;; Doesn't seem to be changeable as of LLDB 17.0.2. + ((string-match (rx "Process " (1+ digit) " exited with status") + string) + (setq gud-last-last-frame nil) + (setq gud-overlay-arrow-position nil))) string) ;; According to SBCommanInterpreter.cpp, the return value of @@ -3963,6 +3963,15 @@ gud-lldb-completion-at-point (completion-table-dynamic (apply-partially #'gud-lldb-completions context))))) +(defvar gud-lldb-frame-format + (concat "gud-info: (gud-lldb-stop " + ;; Quote the filename this way to avoid quoting issues in + ;; the interplay between Emacs and LLDB. The quotes are + ;; corrected in the process filter. + ":file ///${line.file.fullpath}/// " + ":line ${line.number} " + ":column ${line.column})\\n")) + (defun gud-lldb-send-python (python) (gud-basic-call "script --language python --") (mapc #'gud-basic-call (split-string python "\n")) @@ -3973,6 +3982,9 @@ gud-lldb-initialize (gud-lldb-send-python gud-lldb-def-python-completion-function) (gud-basic-call "settings set stop-line-count-before 0") (gud-basic-call "settings set stop-line-count-after 0") + (gud-basic-call (format "settings set frame-format \"%s\"" + gud-lldb-frame-format)) + (gud-basic-call "script --language python -- print('Gud initialized')") (gud-basic-call "script --language python -- print('Gud initialized.')")) ;;;###autoload commit 0cbc91f29aef47c37d671c5a4ad30d7a5c819a1e Author: Eli Zaretskii Date: Thu Oct 19 05:12:20 2023 -0400 Bump Emacs version * README: * configure.ac: * msdos/sed2v2.inp: * nt/README.W32: Bump Emacs version to 29.1.90. diff --git a/README b/README index 64b8c833d3f..fc3752cc71c 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2023 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 29.1.50 of GNU Emacs, the extensible, +This directory tree holds version 29.1.90 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index a4986c7a43c..29b71ea2730 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ AC_PREREQ([2.65]) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT([GNU Emacs], [29.1.50], [bug-gnu-emacs@gnu.org], [], +AC_INIT([GNU Emacs], [29.1.90], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index bcf92ac6be3..d559322a689 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.1.50"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.1.90"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 4eda5e1e243..fa7c4809bf3 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2023 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 29.1.50 for MS-Windows + Emacs version 29.1.90 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You commit ab9d6482e3b1835c3e1a835fb7edd51b61797bb3 Author: Eli Zaretskii Date: Thu Oct 19 04:53:08 2023 -0400 ; Update ChangeLog.4 and etc/AUTHORS. diff --git a/ChangeLog.4 b/ChangeLog.4 index 39b165717c3..64f7f87f9ad 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -1,3 +1,1984 @@ +2023-10-16 Po Lu + + Correctly register focus events concomitant with alpha changes + + * src/xterm.c (x_frame_highlight, x_frame_unhighlight): Skip + changing the frame alpha when the frame is not eligible for + focus state-specific alpha values; otherwise, the alpha might be + reset by the time a alpha change wrought by a focus change + arrives, impeding handle_one_xevent from subsequently restoring + the initial value. (bug#66398) + +2023-10-16 Michael Albinus + + * doc/man/emacsclient.1: Add missing options. + +2023-10-15 Michael Albinus + + Fix test in files-tests + + * test/lisp/files-tests.el + (files-tests-file-name-non-special-expand-file-name-tilde): Fix test. + +2023-10-14 Stefan Kangas + + Add missing :version to two defcustoms + + * lisp/emacs-lisp/eldoc.el (eldoc-print-after-edit) + (eldoc-echo-area-prefer-doc-buffer): Add missing custom :version. + +2023-10-14 Mauro Aranda + + Fix a defcustom :type in eldoc.el + + * lisp/emacs-lisp/eldoc.el (eldoc-echo-area-prefer-doc-buffer): Make + :type a choice, to allow for the value 'maybe'. (Bug##66539) + +2023-10-14 Eshel Yaron + + Document 'M-x align' in the Emacs manual + + * doc/emacs/indent.texi (Alignment): New section. + * doc/emacs/emacs.texi: Update menu. (Bug#66303) + +2023-10-14 Bob Rogers + + Document that time-to-days and days-to-time use different epochs + + * doc/lispref/os.texi (Time Calculations): + * lisp/calendar/time-date.el (days-to-time, time-to-days): Doc fixes. + (Bug#66502) + +2023-10-14 Michael Albinus + + * lisp/files.el (file-name-non-special): Handle quoted tilde. + + (Bug#65685) + + * test/lisp/files-tests.el + (files-tests-file-name-non-special-expand-file-name-tilde): + New test. + +2023-10-13 Michael Albinus + + Handle quoted tilde in Tramp + + * lisp/net/tramp.el (tramp-handle-expand-file-name): + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name): + * lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name): + * lisp/net/tramp-smb.el (tramp-smb-handle-expand-file-name): + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-expand-file-name): + Handle quoted tilde. (Bug#65685) + + * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name-tilde): + New test. + +2023-10-09 Kyle Meyer + + Update to Org 9.6.10 + +2023-10-09 Yuan Fu + + Don't call font-lock-mode in treesit-major-mode-setup (bug#66223) + + * lisp/treesit.el (treesit-major-mode-setup): Remove. + + (cherry picked from commit a3a840c80a217db7d4d125c667ff7d4946507fbb) + +2023-10-09 Noah Peart + + Fix treesit-query-validate for string input (bug#66400) + + * lisp/treesit.el (treesit-query-validate): Don't expand if QUERY is + string. + +2023-10-07 Stefan Kangas + + Recommend `M-x man` in woman.el docs + + * lisp/woman.el (Commentary, woman): Recommend using 'M-x man' where + available. The added sentence is copied from the emacs manual. + Ref: https://lists.gnu.org/r/emacs-devel/2023-10/msg00090.html + +2023-10-07 Eli Zaretskii + + Fix updating process-mark position in 'set-process-buffer' + + * src/process.c (update_process_mark): Update marker position only + if P's process-mark is not already associated with P's buffer. + (Bug#66313) + +2023-10-07 Mauro Aranda + + Fix a defcustom :type + + * lisp/cedet/srecode/map.el (srecode-map-save-file): Expand :type to + allow nil. (Bug#66377) + +2023-10-07 Eli Zaretskii + + Fix 'ido--ffap-find-file' + + * lisp/ido.el (ido--ffap-find-file): Make the signature consistent + with that of 'find-file', and pass the optional second argument to + 'find-file'. (Bug#66382) + +2023-10-06 Eli Zaretskii + + Fix setting the pipe capacity for subprocesses + + * src/process.c (create_process) [F_SETPIPE_SZ]: Set the pipe + capacity only if the required read-process-max is larger than the + default capacity of the pipe. (Bug#66288) + +2023-10-05 Gerd Möllmann + + Handle LANG on macOS differently (bug#65908) + + * src/nsterm.m (ns_init_locale): If LANG is set, try to use that, + otherwise try to deduce what LANG should be. Check is the result is + valid, and use LANG="en_US.UTF-8" if not. + +2023-10-05 Jens Schmidt + + Silence macro expansion during completion at point + + To keep risk in the current release branch low, do not avoid compiler + macros as suggested by Stefan in the bug, but rather suppress all errors. + + * lisp/progmodes/elisp-mode.el (elisp--local-variables): Silence + messages. Suppress all errors during macro expansion. (Bug#58148) + + Do not merge to master. + +2023-10-05 Mauro Aranda + + Fix a defcustom :type + + * lisp/cedet/ede/base.el (ede-project-placeholder-cache-file): Expand + :type to allow nil. (Bug#66361) + +2023-10-04 Mauro Aranda + + Fix pulse-flag :type + + * lisp/cedet/pulse.el (pulse-flag): Expand :type to allow 'never as + value. (Bug#66341) + +2023-10-03 Mauro Aranda + + Fix defcustoms in timeclock.el + + * lisp/calendar/timeclock.el (timeclock-get-project-function) + (timeclock-get-reason-function): Fix :type to allow nil. (Bug#66320) + +2023-10-01 Stefan Kangas + + Improve documentation of `ns-use-proxy-icon` + + * doc/emacs/macos.texi (Mac / GNUstep Customization): + * src/nsfns.m (syms_of_nsfns): Fix documentation of + 'ns-use-proxy-icon'; explain what it does and how it's + used. (Bug#66190) + +2023-10-01 Stefan Kangas + + Document assigning libraries to packages in make-tarball.txt + + * admin/make-tarball.txt: Add new step to ensure that new libraries + are assigned to packages. + +2023-10-01 Stefan Kangas + + Doc fix; more consistently refer to "text terminals" + + In the Emacs Lisp manual, we refer to "text terminals" and "graphical + terminals" (see Info node `(elisp) Frames'). But in some places, + including the user manual, the alternative terminology "non-window + terminals" is used instead. + + In other places, we use the terminology "non-windowing display" + instead of the more canonical "non-graphical display". + + This is less clear than it could be. Let's consolidate our + terminology to prefer the wording from the Emacs Lisp manual; in other + words, prefer "text" and "non-graphical" to "non-window". + + * doc/emacs/frames.texi (Non-Window Terminals): Rename node from this... + (Text Terminals): ...to this. (Bug#66282) + * doc/emacs/display.texi (Standard Faces): + * doc/emacs/emacs.texi (Top): + * doc/emacs/misc.texi (emacsclient Options): + * doc/misc/viper.texi (Rudimentary Changes) + (Packages that Change Keymaps): + * doc/emacs/frames.texi (Frames, Frame Commands, Mouse Avoidance): + Replace instances of "non-window terminals" with "text terminals". + * doc/misc/ediff.texi (Quick Help Customization): + (Window and Frame Configuration): + * lisp/vc/ediff.el (ediff-windows-wordwise) + (ediff-windows-linewise): Prefer saying 'non-graphical display' to + 'non-windowing display'. + * lisp/net/tramp.el (tramp-default-method): + * lisp/printing.el (pr-find-command): Capitalize 'Windows' where it + clearly refers to the non-free operating system with that name. + +2023-09-30 Mauro Aranda + + Fix defcustoms in type-break.el (Bug#66210) + + * lisp/type-break.el (type-break-good-rest-interval) + (type-break-file-name): Allow nil. + +2023-09-30 Mauro Aranda + + Fix term-scroll-to-bottom-on-output :type + + * lisp/term.el (term-scroll-to-bottom-on-output): Add missing choices. + Don't advertise the value 'all' in docstring. (Bug#66071) + +2023-09-28 Stefan Kangas + + Doc fix in let-alist for keys with nil value + + * lisp/emacs-lisp/let-alist.el (let-alist): Clarify that keys with a + nil value will give the same result as if they were missing. + +2023-09-28 Michael Albinus + + Fix tramp-test.el (don't merge with master) + + * test/lisp/net/tramp-tests.el (tramp--test-check-files): + Don't err out when "printenv" doesn't exist on remote side. + +2023-09-25 Michael Albinus + + Improve Emacs 30 compatibility in tramp-tests.el (don't merge) + + * test/lisp/net/tramp-tests.el (tramp--test-deftest-direct-async-process) + (tramp-test30-make-process): Improve Emacs 30 compatibility. + +2023-09-25 Michael Albinus + + Add new Tramp test + + * test/lisp/net/tramp-tests.el (tramp-test46-read-password): + Use `copy-tree' but `copy-sequence'. + (tramp-test46-read-otp-password): New test. + +2023-09-25 Mauro Aranda + + Fix tmm-mid-prompt :type (Bug#66179) + + * lisp/tmm.el (tmm-mid-prompt): Allow nil. + +2023-09-24 Augustin Chéneau (tiny change) + + Fix tree-sitter indentation conflict with multiple languages + + * lisp/treesit.el (treesit--indent-1): Use bol instead of point. + +2023-09-24 Michael Albinus + + Fix bug#66093 in Tramp + + * lisp/net/tramp-sshfs.el (tramp-methods): Use "%a". + (tramp-sshfs-handle-process-file): Replace ?a by "-t". + + * lisp/net/tramp.el (tramp-methods): Adapt docstring. (Bug#66093) + (tramp-handle-make-process): Replace ?a by "-t" if indicated. + +2023-09-24 Eli Zaretskii + + Support regeneration of ja-dic.el under '--with-small-ja-dic' + + * lisp/international/ja-dic-cnv.el (skkdic-convert): Record the + value of SMALL_JA_DIC option used to produce ja-dic.el. + * leim/Makefile.in (small-ja-dic-option): New target, triggers + regeneration of ja-dic.el when the value of SMALL_JA_DIC option + changes by the configure script. Suggested by Ulrich Mueller + . + (${leimdir}/ja-dic/ja-dic.el): Depend on 'small-ja-dic-option'. + (Bug#66125) + + * make-dist (possibly_non_vc_files): + * .gitignore: Add 'leim/small-ja-dic-option'. + +2023-09-22 Basil L. Contovounesios + + Improve remote-file-name-inhibit-cache :type + + * lisp/files.el (remote-file-name-inhibit-cache) + (shell-highlight-undef-remote-file-name-inhibit-cache): Avoid + duplicated :tag string. Try to clarify wording and + formatting (bug#66150). + * lisp/shell.el (shell--highlight-undef-exec-cache): Reference + correct user option in docstring. + +2023-09-22 Stefan Kangas + + Ensure bind-key is its own package + + * lisp/finder.el (finder--builtins-alist): Remove "use-package" + directory. + * lisp/use-package/bind-key.el: Declare library as part of the + 'bind-key' package. + * lisp/use-package/use-package-bind-key.el: + * lisp/use-package/use-package-core.el: + * lisp/use-package/use-package-delight.el: + * lisp/use-package/use-package-diminish.el: + * lisp/use-package/use-package-ensure-system-package.el: + * lisp/use-package/use-package-ensure.el: + * lisp/use-package/use-package-jump.el: + * lisp/use-package/use-package-lint.el: Declare library as part of the + 'use-package' package. (Bug#62751) + + Do not merge to master. + +2023-09-21 Michael Albinus + + * lisp/net/tramp.el (tramp-skeleton-write-region): Fix missing comma. + + (Bug#66123) + +2023-09-18 Yuan Fu + + Fix tree-sitter range update function + + * lisp/treesit.el (treesit-update-ranges): If an embedded language + doesn't have any range, don't set its range to nil (which means whole + buffer), instead, set its range to a dummy (1 . 1) zero range. + +2023-09-18 Ihor Radchenko + + Announce handling 'org-protocol' URI scheme in NEWS + + * etc/NEWS: Document handling 'org-protocol' URI scheme. The commit + implementing the new functionality is 05a7c91b91c. (Bug#65469) + +2023-09-18 Ihor Radchenko + + Make emacsclient handle org-protocol:// links + + Org mode provides a way to quickly capture bookmarks, notes, and links + using emacsclient: + + emacsclient "org-protocol://store-link?url=URL&title=TITLE" + + * etc/emacsclient.desktop: Make Emacs the default application for + org-protocol. (Bug#65469) + + (cherry picked from commit 05a7c91b91c02c34ec6527119a465e5408dea2b1) + +2023-09-18 Robert Pluim + + Ensure ucs-names is consistent with Unicode names + + * lisp/international/mule-cmds.el (ucs-names): Skip adding an old-name + if it conflicts with the offical name of a codepoint. Adjust the + ranges iterated over to account for new Unicode codepoints. + * test/lisp/international/mule-tests.el + (mule-cmds-tests--ucs-names-old-name-override, + mule-cmds-tests--ucs-names-missing-names): New tests for checking + 'ucs-names' consistency. + + Bug#65997 + +2023-09-18 Shynur + + Make key-translate actually work + + * lisp/keymap.el (key-translate): Use the first element of the parsed + keys rather than the whole vector. (Bug#65735) + +2023-09-17 Kyle Meyer + + Update to Org 9.6.9 + +2023-09-17 Stefan Kangas + + Add leim subdirectories to emacs package + + * lisp/finder.el (finder--builtins-alist): Add subdirectories + 'leim/ja-dic' and 'leim/quail' as part of the 'emacs' + package. (Bug#62751) + +2023-09-17 Stefan Kangas + + Add missing builtin package declarations + + * lisp/finder.el (finder--builtins-alist): Add new package + directories 'leim' and 'obsolete' as part of the 'emacs' package. + Add new package directory 'use-package' as part of the + 'use-package' package. + * lisp/net/eudc-capf.el: + * lisp/net/eudcb-ecomplete.el: + * lisp/net/eudcb-macos-contacts.el: + * lisp/net/eudcb-mailabbrev.el: Declare library as part of the + 'eudc' package. + * lisp/mail/ietf-drums-date.el: Declare library as part of the + 'ietf-drums' package. + * lisp/image/image-dired-dired.el: + * lisp/image/image-dired-external.el: + * lisp/image/image-dired-tags.el: + * lisp/image/image-dired-util.el: Declare library as part of the + 'image-dired' package. + * lisp/emacs-lisp/oclosure.el: + * lisp/keymap.el: + * lisp/progmodes/c-ts-common.el: Declare library as part of the + 'emacs' package. (Bug#62751) + + (cherry picked from commit 94b1de2774b5c1fa3c28285229900657638f5c3f) + +2023-09-17 Stefan Kangas + + Add more missing builtin package declarations + + * lisp/emacs-lisp/shorthands.el: Declare library as part of the + 'emacs' package. + * lisp/epa-ks.el: Declare library as part of the 'epa' + package. (Bug#55388) + +2023-09-17 Stefan Kangas + + Document shell-command-to-string security considerations + + * lisp/simple.el (shell-command-to-string): Document security + considerations in docstring. + +2023-09-17 Mauro Aranda + + Fix shell-indirect-setup-hook :type (Bug#66051) + + * lisp/shell.el (shell-indirect-setup-hook): It's a hook, not a + boolean. + +2023-09-17 Thomas Hilke (tiny change) + + Remove column quoting from sqlite-mode + + * lisp/sqlite-mode.el (sqlite-mode--column-names): Unquote column + name. (Bug#65998) + +2023-09-17 Theodor Thornhill + + Add indentation rules for type_arguments + + * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Indent + as opening braces. + +2023-09-16 Dmitry Gutov + + typescript-ts-mode.el: Minor touches + + * lisp/progmodes/typescript-ts-mode.el + (tsx-ts-mode--indent-compatibility-b893426) + (tsx-ts-mode--font-lock-compatibility-bb1f97b): + Catch specific error. + (typescript-ts-base-mode): Improve docstring (bug#65470). + +2023-09-16 Dmitry Gutov + + Improve namespacing situation WRT to recent change in typescript-ts-mode.el + + * lisp/progmodes/typescript-ts-mode.el + (typescript-ts--syntax-propertize): + Rename from ts-ts--syntax-propertize. + (tsx-ts--syntax-propertize-captures): + Rename from ts-ts--syntax-propertize-captures. + (typescript-ts--s-p-query): + Rename from ts-ts--s-p-query. + Update all references (bug#65470). + +2023-09-16 Stephen Berman + + Make move-end-of-line in minibuffer consistent (bug#65980) + + * lisp/simple.el (move-end-of-line): Always move to eol when + invoking `C-e' from within the minibuffer's prompt string. + +2023-09-16 Jens Schmidt + + Fix loss of encrypted data in plstore.el + + * lisp/plstore.el (plstore--insert-buffer): Fix loss of encrypted + data when a plstore gets opened and saved without being decrypted + between these steps. (Bug#63627) + +2023-09-16 Thomas Hilke (tiny change) + + Close SQL database when corresponding 'sqlite-mode' buffer is killed + + * lisp/sqlite-mode.el (sqlite-mode-open-file): Close DB when the + buffer is killed. (Bug#65998) + +2023-09-16 Eli Zaretskii + + Fix Unicode normalization of characters + + * lisp/international/ucs-normalize.el + (ucs-normalize-composition-exclusions, check-range): Update from + Unicode 15.0 data. (Bug#65996) + + * test/lisp/international/ucs-normalize-tests.el + (ucs-normalize-tests--failing-lines-part1) + (ucs-normalize-tests--failing-lines-part2): Update to reflect + changes in ucs-normalize.el. + + * admin/notes/unicode: Mention the updates in ucs-normalize.el. + +2023-09-16 Michael Albinus + + Support one-time passwords in Tramp + + * doc/misc/tramp.texi (Remote shell setup): + Describe tramp-otp-password-prompt-regexp. + + * lisp/net/tramp-sh.el (tramp-actions-before-shell) + (tramp-actions-copy-out-of-band): + Use `tramp-otp-password-prompt-regexp'. + + * lisp/net/tramp.el (tramp-otp-password-prompt-regexp): New defcustom. + (tramp-action-otp-password): New defun. + +2023-09-16 Eli Zaretskii + + Fix the 'C' and 'c' categories of characters + + * lisp/international/characters.el: Fix categories of Chinese + characters. (Bug65995) + +2023-09-16 Eli Zaretskii + + Fix Emoji zooming commands + + * lisp/international/emoji.el (emoji-zoom-increase): Handle the + case where face property at point is a list of faces. (Bug#65994) + +2023-09-15 Dmitry Gutov + + tsx-ts-mode--font-lock-compatibility-bb1f97b: Improve + + * lisp/progmodes/typescript-ts-mode.el + (tsx-ts-mode--font-lock-compatibility-bb1f97b): + Test the more complex query, because the current one leads to + false positives (mentioned in bug#65470). + +2023-09-15 Davide Masserut + + Avoid using --display in emacsclient to reuse frames on PGTK + + Using hard-coded display values can cause PGTK graphical frames to + open using the wrong backend or not open at all. + * Makefile.in (install-etc): Use --reuse-frame instead of + --display=$DISPLAY. (Bug#65509) + +2023-09-15 Eli Zaretskii + + Support emacsclient on Windows with server on GNU or Unix systems + + * lisp/server.el (server-process-filter): If 'tty-name' is literally + "CONOUT$", assume the client runs on MS-Windows and force the + frame type to GUI. This allows to run emacsclient on MS-Windows + when the server runs on a Posix host. (Bug#65812) + +2023-09-14 Mauro Aranda + + Fix defcustom in saveplace.el (Bug#65977) + + * lisp/saveplace.el (save-place-ignore-files-regexp): Allow nil. + +2023-09-14 Eli Zaretskii + + Fix 'window-text-pixel-size' when there are several images at START + + * src/xdisp.c (window_text_pixel_size): Remove unnecessary call to + 'move_it_to'. (Bug#65899) (Bug#54862) + +2023-09-14 Eli Zaretskii + + : Doc fix. + + * lisp/progmodes/prog-mode.el + (prettify-symbols-unprettify-at-point): Doc fix. + +2023-09-14 Stefan Kangas + + Doc fix for prettify-symbols-unprettify-at-point + + * lisp/progmodes/prog-mode.el + (prettify-symbols-unprettify-at-point): Document that it has to be + set before enabling 'prettify-symbols-mode'. (Bug#65884) + +2023-09-13 Stefan Monnier + + (report_overlay_modification): Fix bug#65929 + + Somehow the new overlay code in Emacs-29 changed slightly + the test to decide when to run the `modification-hooks` of overlays, + with the consequence that these hook functions end up being executed + also when text is deleted right after an empty overlay, which is + contrary to Emacs-28 behavior as well as contrary to the Texinfo doc. + + * src/buffer.c (report_overlay_modification): Better reproduce the + Emacs-28 code. + + * test/src/buffer-tests.el (overlay-modification-hooks): + Add corresponding test. + +2023-09-13 Alan Third + + Fix SVG colors (bug#56182) + + * src/image.c (svg_load_image): Reverse the R and B bytes in the + Windows colors before using them to generate the SVG. + +2023-09-13 Juri Linkov + + * doc/emacs/text.texi (Outline Minor Mode): Add a note about value 'insert'. + + * lisp/outline.el (outline-minor-mode-use-buttons): Add a note and + a comment about the value 'insert' (bug#65874). + +2023-09-13 Eli Zaretskii + + Improve documentation of 'list-abbrevs' + + * doc/emacs/abbrevs.texi (Editing Abbrevs): Describe how system + abbrevs are shown by 'list-abbrevs'. Suggested by Shynur Xie + . (Bug#65907) + +2023-09-12 Dmitry Gutov + + Tweak s-p-f for js-ts-mode + + * lisp/progmodes/js.el (js-ts--s-p-query): + Consider two more contexts (bug#65470). + +2023-09-12 Jostein Kjønigsen + + typescript-ts-mode, tsx-ts-mode: Fix syntax properties for regexp and jsx + + Propertize regexps as strings and JSX elements as generic strings. + + * lisp/progmodes/typescript-ts-mode.el (ts-ts--s-p-query) + (tsx-ts--s-p-query): New variables. + (ts-ts--syntax-propertize, tsx-ts--syntax-propertize) + (ts-ts--syntax-propertize-captures): New functions. + (typescript-ts-mode, tsx-ts-mode): Use them (bug#65470). + +2023-09-12 Eli Zaretskii + + * lisp/progmodes/c-ts-mode.el (c++-ts-mode): Provide (bug#65895). + +2023-09-11 Yuan Fu + + Fix regression of treesit_cursor_helper_1 + + * src/treesit.c (treesit_cursor_helper_1) + (treesit_cursor_first_child_for_byte): Use + ts_tree_cursor_goto_first_child_for_byte first, and + ts_tree_cursor_goto_first_child second. + +2023-09-10 Stefan Kangas + + Update docs for passing of Thien-Thi Nguyen + + * doc/emacs/ack.texi (Acknowledgments): Add Thien-Thi Nguyen. + * lisp/play/zone.el: Set maintainer to emacs-devel. + +2023-09-10 Stefan Kangas + + Update defvar usage tips example in manual + + * doc/lispref/variables.texi (Tips for Defining): Change example + to be about syntax tables instead of old way of defining keymaps + using 'defvar' and 'make-sparse-keymap'. (Bug#59224) + +2023-09-10 Stefan Kangas + + Document using Flymake together with Eglot + + * doc/misc/flymake.texi (Top, Using Flymake): Document using + Flymake together with Eglot. (Bug#60040) + +2023-09-08 Mauro Aranda + + Fix defcustom :type of ielm-indirect-setup-hook + + * lisp/ielm.el (ielm-indirect-setup-hook): Fix :type and remove :safe + property, since it was probably a copy-pasta. (Bug#65821) + +2023-09-08 Stefan Kangas + + Document NonGNU ELPA in FAQ + + * doc/misc/efaq.texi (Packages that do not come with Emacs): + Document NonGNU ELPA. (Bug#65818) + +2023-09-07 Jim Porter + + Fix remote path setting in Eshell + + This ensures that we supply Tramp with the local PATH so that it can + do its job of starting the local "ssh", or whatever the method uses + (bug#65551). + + * lisp/eshell/esh-proc.el (eshell-gather-process-output): Add special + handling for remote processes. + + * test/lisp/eshell/esh-proc-tests.el + (esh-var-test/remote/remote-path): New test. + +2023-09-07 Stefan Kangas + + Update docs for (co-)maintainer changes + + * admin/MAINTAINERS: Add information on current maintainers as a + canonical place to find this information. + * doc/emacs/ack.texi (Acknowledgments): Update for recent + Emacs (co-)maintainer changes. + * admin/make-tarball.txt: Add note as a reminder to update the above + before making a new release. + +2023-09-07 Sebastian Miele + + * doc/lispref/strings.texi (Text Comparison): Fix typo (bug#65799). + +2023-09-07 Michael Albinus + + Adapt Tramp manual + + * doc/misc/tramp.texi (Frequently Asked Questions): Do not use + `defadvice'. Add indices. (Bug#65481) + +2023-09-07 Stefan Kangas + + Improve docstring of message-sendmail-envelope-from + + * lisp/gnus/message.el (message-sendmail-envelope-from): Doc fix. + +2023-09-07 Philipp Stephani + + Unbreak builds with CHECK_STRUCTS. + + * src/pdumper.c (dump_buffer): Fix hash for 'struct buffer'. The + recent changes to that structure where commits + 8f3091defb3ec4396ccea563f67c005044b822ca and + 0bd46619413e83fe3c85c8a1dfbf5e20dfce8605, both of which just affected + comments. + +2023-09-07 Jens Schmidt + + Improve documentation of EPG + + * lisp/epg.el (epg-context-set-passphrase-callback): Update + GnuPG-version-dependent information in docstring and refer to + Info node `(epa)' for details. + (epg-start-edit-key): Replace description of arguments by a + reference to `epg-edit-key'. + (epg-edit-key): More precisely describe callback operation and + arguments and provide an example of how to edit a key. (Bug#65603) + +2023-09-07 Daniel Martín + + Avoid crashes on macOS with context menus + + * src/nsmenu.m ([EmacsMenu menuNeedsUpdate:]): Avoid crashes with + context menus. (Bug#63495) + +2023-09-07 Yuan Fu + + Fix c-ts-mode BSD style indentation + + * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): + Add else_clause. + + (cherry picked from commit d392a5d3c11b7e7479d31421f8237f29952c909e) + +2023-09-06 David Ponce + + Fix regexp for recognizing PBM images + + * lisp/image.el (image-type-header-regexps): Don't use [:space:], + as its meaning depends on the current buffer's syntax tables. + (Bug#65496) + +2023-09-06 Eli Zaretskii + + Improve wording in ELisp manual + + * doc/lispref/objects.texi (Printed Representation): Improve + wording. Suggested by Xie Shynur . + (Bug# 60639) + +2023-09-06 Joseph Turner + + Fix typo (Bug#65764) + + * lisp/subr.el (backward-word-strictly): Fix typo. + +2023-09-05 Po Lu + + Fix libgccjit build on Haiku + + * configure.ac (LIBGCCJIT_LIBS): Link only with -lgccjit under + Haiku. + +2023-09-05 Stefan Monnier + + (regexp-tests-backtrack-optimization): Mark it as failing + + * test/src/regex-emacs-tests.el (regexp-tests-backtrack-optimization): + The fix for bug#65726 broke some of the optimization added for bug#61514. + +2023-09-04 Stefan Monnier + + * src/regex-emacs.c (mutually_exclusive_p): Fix inf-loop (bug#65726) + +2023-09-04 Stefan Kangas + + Bump seq version to 2.24 + + * lisp/emacs-lisp/seq.el: Bump version to 2.24. (Bug#60990) + +2023-09-04 Stefan Kangas + + Add note on ELPA to admin/notes/bug-triage + + * admin/notes/bug-triage: Add section on (Non-)GNU ELPA packages and + do some copy editing. + +2023-09-02 Po Lu + + * etc/PROBLEMS: Mention bug#65432 and its remedy. + +2023-09-02 Theodor Thornhill + + Ignore errors when checking for object initializers (bug#63379) + + Since this is merely a check for syntax, we don't really care about + any internal errors inside of backward-up-list. + + * lisp/progmodes/csharp-mode.el (csharp-guess-basic-syntax): Wrap + command in ignore-errors. + +2023-09-02 Stefan Kangas + + * CONTRIBUTE: Document making ChangeLogs with Magit. + +2023-09-02 Stefan Kangas + + Doc fixes for obsolete functions and variables + + * admin/notes/multi-tty: + * doc/emacs/building.texi (Debugger Operation): + * doc/misc/efaq-w32.texi (Line ends by file system): + * doc/misc/gnus.texi (Hashcash): + * lisp/emacs-lisp/eieio.el (eieio-class-parents) + (eieio-class-children): + * lisp/progmodes/perl-mode.el: + * lisp/textmodes/ispell.el (ispell-lookup-words): + * src/buffer.h: Update or delete references to variables and functions + made obsolete in Emacs 24.4. + +2023-09-02 Mauro Aranda + + A revision to the Widget manual + + * doc/misc/widget.texi (Widgets Basics, Working with Widgets) + (Widgets and the Buffer, Widget Gallery, Customization): New chapters. + (Basic Types, Sexp Types): Demote to subsections. + (Widget Browser): Rename to Inspecting Widgets. + (Widget Properties): Remove. + + (Top): Adapt menu to changes. + (Introduction): Rearrange text. Move warnings to a better place, and + user options to the Customization chapter. + (User Interface): Don't fully describe commands and customization + options here. + (Setting Up the Buffer): Expand on widget creation process and add + documentation for useful functions which deal with + creation/conversion. + (Defining New Widgets): Expand the documentation on define-widget. + All relevant properties moved to the description of the default + widget, in Widget Gallery. + (Utilities): Add some more useful functions not previously documented. + (Wishlist): Remove out-of-date items. + +2023-09-02 Stefan Kangas + + Fix fontification of " in edit-kbd-macro + + * lisp/edmacro.el (edit-kbd-macro): Fix fontification when editing + keyboard macros containing the " character. + +2023-09-02 Eli Zaretskii + + * lisp/emacs-lisp/gv.el (buffer-local-value): Unobsolete (bug#65555). + +2023-09-02 Jens Schmidt + + Add documentation to plstore.el + + * lisp/plstore.el: Add link to epa manual. Describe more + restrictions. Fix a typo in the examples. Fix terminology. Mark + FIXMEs as such. + * lisp/plstore.el (plstore-save): Describe edge case when no recipient + matches and mark as FIXME. (Bug#63627) + +2023-09-01 Stefan Kangas + + * lisp/help.el (substitute-quotes): Improve docstring. + +2023-09-01 Stefan Kangas + + Fix two defcustom :types + + * lisp/frame.el (blink-cursor-blinks): + * lisp/url/url-vars.el (url-max-redirections): Revert defcustom :types + back to integer. (Bug#65655) + +2023-09-01 Manuel Giraud + + Fix `image-auto-resize-on-window-resize' custom :type + + * lisp/image-mode.el (image-auto-resize-on-window-resize): Change + custom :type from integer to number to be able to set below 1 + second. (Bug#65626) + +2023-09-01 Ross Timson (tiny change) + + Add "terraform-ls" LSP server to Eglot + + * lisp/progmodes/eglot.el (eglot-server-programs): Add "terraform-ls", + the official Terraform LSP server. (Bug#65671) + +2023-09-01 Eli Zaretskii + + Fix minor bugs in vc-git and vc-hg on Windows uncovered by vc-tests + + * lisp/vc/vc-hg.el (vc-hg-state-slow): Non-existing files emit a + different message on MS-Windows; support that. + * lisp/vc/vc-git.el (vc-git-checkin): Make sure + 'default-directory' is not nil when calling + 'make-nearby-temp-file' on MS-Windows. + + * test/lisp/vc/vc-tests.el (vc-test--version-diff): Run + 'default-directory' through 'file-truename', otherwise the + 'vc-test-cvs06-version-diff' test might fail on MS-Windows. + +2023-08-31 Dmitry Gutov + + Add syntax-propertize-function to js-ts-mode + + * lisp/progmodes/js.el (js-ts--s-p-query): + New variable (bug#65470). + (js-ts--syntax-propertize): New function. + (js-ts-mode): Use it. + +2023-08-30 Yuan Fu + + Improve performance of treesit_cursor_helper_1 + + * src/treesit.c: (treesit_cursor_helper_1): Use + ts_tree_cursor_goto_first_child_for_byte to speed up traversing among + siblings. The "while (ts_node_end_byte (cursor_node) < end_pos)" can + be removed with the check added in the loop below. + +2023-08-28 Stefan Monnier + + * lisp/subr.el (combine-change-calls-1): Fix bug#64989 + + Silence the spurious warning, and improve the warning while at it. + Do not merge to master. + +2023-08-27 Kyle Meyer + + Update to Org 9.6.8-3-g21171d + +2023-08-27 Yuan Fu + + Escape percent character in treesit--inspect-name (bug#65540) + + * lisp/treesit.el (treesit-inspect-node-at-point): Escape percent. + +2023-08-27 Jim Porter + + Don't add an extraneous slash in remote PATH list in Eshell + + Previously, in a remote directory, '(eshell-get-path)' would return a + list of strings like "/ssh:localhost://usr/bin". While that shouldn't + break most things, it's not strictly correct either. See bug#65551. + + * lisp/eshell/esh-util.el (eshell-get-path): Use 'concat' instead of + 'file-name-concat'. + + * test/lisp/eshell/esh-util-tests.el: Require 'tramp' and + 'eshell-tests-helpers'. + (esh-util-test/path/get, eshell-util-test/path/get-remote): New tests. + +2023-08-27 Michael Albinus + + Fix Tramp on MS Windows + + * lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name): + Apply `tramp-drop-volume-letter' consequently. + +2023-08-27 Andrea Corallo + + * Fix native disassemble on Windows platforms (bug#65455) + + * lisp/emacs-lisp/disass.el (disassemble-internal): Improve regexp. + +2023-08-27 Andrea Corallo + + * Handle missing eln file when trying to disassble (bug#65455) + + * lisp/emacs-lisp/disass.el (disassemble-internal): Handle missing + eln file. + +2023-08-27 Andrea Corallo + + * lisp/emacs-lisp/comp.el (comp--native-compile): Fix OUTPUT for non abs paths + +2023-08-27 Jonas Bernoulli + + Update to Transient v0.4.3 + +2023-08-27 Michael Albinus + + Adapt Eshell manual + + * doc/misc/eshell.texi (Arguments): Mention more special + characters to be quoted in remote file names. (Bug#65431) + +2023-08-27 Eli Zaretskii + + Fix applying patches with Git on MS-Windows + + * lisp/vc/vc.el (vc-diff-internal): For Git, always suppress EOL + conversion when reading the diffs into a buffer. Doc fix. + * lisp/vc/vc-git.el (vc-git-checkin): Make sure to suppress EOL + conversion when the patch file is written. (Bug#65049) + +2023-08-26 Po Lu + + Repair bug#65068 on Emacs 29 + + * src/xterm.c (x_term_init): Disable ControlFallback library + control wherever present. (bug#65068) + + Do not merge to master. + +2023-08-24 Stefan Kangas + + Fix custom :type of dired-mouse-drag-files + + * lisp/dired.el (dired-mouse-drag-files): Fix :type to allow + specifying 'move'. (Bug#65497) + +2023-08-24 James Thomas + + Account for string names in active file + + Account also for strings when reading in group names from an active + file (bug#62812). + * lisp/gnus/nnmail.el (nnmail-parse-active): Make it similar to + gnus-active-to-gnus-format + +2023-08-24 Christoph Göttschkes (tiny change) + + Fix 'makefile-browser-client' variable initialization + + * lisp/progmodes/make-mode.el (makefile-browser-client): + Initialize to nil. (Bug#65487) + +2023-08-19 Yuan Fu + + Support defun navigation for DEFUN in c-ts-mode (bug#64442) + + Before this change, beginning/end-of-defun just ignores DEFUN in + c-ts-mode. After this change, beginning/end-of-defun can recognize + DEFUN, but a DEFUN definition is considered two defuns. Eg, + beginning/end-of-defun will stop at (1) (2) and (3) in the following + snippet: + + (1)DEFUN ("treesit-node-parser", + Ftreesit_node_parser, Streesit_node_parser, + 1, 1, 0, + doc: /* Return the parser to which NODE belongs. */) + (Lisp_Object node) + (2){ + CHECK_TS_NODE (node); + return XTS_NODE (node)->parser; + } + (3) + + Ideally we want point to only stop at (1) and (3), but that'll be a + lot harder to do. + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--defun-valid-p): Refactor to take in account of DEFUN body. + (c-ts-mode--emacs-defun-body-p): New function. + (c-ts-base-mode): Add DEFUN and DEFUN body to recognized types. + (c-ts-mode--emacs-defun-at-point): Now that we recognize both parts of + a DEFUN as defun, c-ts-mode--emacs-defun-at-point needs to be updated + to adapt to it. + +2023-08-19 Eli Zaretskii + + Fix touchpad scrolling on MS-Windows + + * src/w32term.c (w32_construct_mouse_wheel): The number of lines + to scroll should always be positive in wheel-scroll events. + Whether to scroll up or down is encoded in the modifiers, which + produce either wheel-up or wheel-down event. (Bug#65070) + + * doc/lispref/commands.texi (Misc Events): Clarify the + documentation of 'wheel-up' and 'wheel-down' events. + +2023-08-19 Philip Kaludercic + + Fix order in which package-vc dependencies are resolved + + * lisp/emacs-lisp/package-vc.el (package-vc-install-dependencies): + Avoid a type-mismatch when comparing two packages. (Bug#65283) + +2023-08-19 Joseph Turner + + Fix building of VC package manuals with relative org links/includes + + * lisp/emacs-lisp/package-vc.el (package-vc--build-documentation): + Ensure that default-default is the docs-directory around + org-export-to-file to ensure that links to relative files work + correctly. (Bug#65243) + +2023-08-19 Eli Zaretskii + + Fix the documentation of 'cl-flet' + + * doc/misc/cl.texi (Function Bindings): Update the description. + (Bug#65362) + +2023-08-17 Jens Schmidt + + Avoid false "wrong passphrase" messages in EPA + + * lisp/epa-file.el (epa--wrong-password-p): Use a stricter regexp + to match "wrong passphrase" errors generated by GnuPG. (Bug#65316) + +2023-08-17 dannyfreeman + + Fix jsx font-lock in older tree-sitter-js grammars + + * lisp/progmodes/js.el (js--treesit-font-lock-settings): Use + queries that are backwards compatible with + tree-sitter-javascript bb1f97b. + * lisp/progmodes/js.el + (-jsx--treesit-font-lock-compatibility-bb1f97b): Delete unused + function. (Bug#65234) + +2023-08-17 Eli Zaretskii + + Fix cloning 'face-remapping-alist' for indirect buffers + + * lisp/face-remap.el (face-remap--copy-face): Remove. + (face-attrs--make-indirect-safe): Use 'copy-tree'. Suggested by + Stefan Monnier . + +2023-08-17 Eli Zaretskii + + Improve documentation of case transfer in replacement commands + + * doc/emacs/search.texi (Replacement and Lax Matches): + * src/search.c (Freplace_match): + * lisp/replace.el (query-replace, query-replace-regexp): Clarify + in the doc string and the manual how letter-case is transferred + from the replaced text to the replacement text. (Bug#65347) + +2023-08-16 Eli Zaretskii + + Fix horizontal scrolling of images with C-f + + * lisp/image-mode.el (image-forward-hscroll): Calculate the + window-width more accurately, as the number of full columns that + fits in the window's text-area. (Bug#65187) + +2023-08-16 Eli Zaretskii + + Fix unpacking ZIP archives on MS-Windows + + * lisp/arc-mode.el (archive-zip-summarize): Decode file names as + UTF-8 when bit 11 of flags is set, even on MS-Windows. + (Bug#65305) + +2023-08-16 Jim Porter + + Fix command example in Eshell manual + + * doc/misc/eshell.texi (Introduction): Fix example (bug#65303). + + Reported by Eric Gillespie . + +2023-08-14 Jim Porter + + Add user options mentioned in the Eshell manual to the variable index + + * doc/misc/eshell.texi: Make variable index entries use "code" style, + and add indexing for any options already in the manual. + +2023-08-14 Andrea Corallo + + * Add missing alias to `native-comp-enable-subr-trampolines'. + + * lisp/subr.el (native-comp-deferred-compilation): Alias to + native-comp-jit-compilation. + +2023-08-14 Andrea Corallo + + * Add missing alias to `native-comp-enable-subr-trampolines'. + + * lisp/subr.el (comp-enable-subr-trampolines): Alias to + native-comp-enable-subr-trampolines. + +2023-08-13 Kyle Meyer + + Update to Org 9.6.7-13-g99cc96 + +2023-08-13 Michael Albinus + + Handle last-coding-system-used in Tramp for all backends + + * lisp/net/tramp.el (tramp-skeleton-write-region): + Handle `last-coding-system-used'. + (tramp-handle-write-region): + * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): + * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): + * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): + Set `coding-system-used'. (Bug#65022) + + * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): + Move `last-coding-system-used' handling to + `tramp-skeleton-write-region'. + +2023-08-13 Devon Sean McCullough + + Add 2 Welsh characters to iso-transl.el + + * lisp/international/iso-transl.el (iso-transl-char-map): Add two + Welsh characters. (Bug#65248) + +2023-08-12 Andrea Corallo + + * Fix `batch-byte+native-compile' target directory. + + * lisp/emacs-lisp/comp.el (batch-native-compile): Don't shadow + `native-compile-target-directory' unless necessary. + +2023-08-12 Eli Zaretskii + + Avoid crashes in 'display_count_lines' when current buffer was killed + + * src/xdisp.c (Fformat_mode_line): + * src/fns.c (Fline_number_at_pos): Don't allow to count lines in a + dead buffer. (Bug#65060) + +2023-08-12 J M + + Update csharp tree-sitter support due to upstream changes + + A change in tree-sitter-c-sharp grammar for csharp (commit + 18a531), has removed the keyword void_keyword and advised + we should use predefined_type. + * lisp/progmodes/csharp-mode.el (csharp-ts-mode--font-lock-settings): + Support both old and new style of keywords in tree-sitter-c-sharp + grammar. (Bug#65113) + +2023-08-12 Matthew Tromp (tiny change) + + Substitute command keys in 'ielm-header' at use time + + Before, command keys were substituted into the ielm-header when + ielm.el was loaded, which resulted in the substitutions depending on + the user's current buffer instead of the ielm buffer. + For example, if the user was in an info-mode buffer, the key would + appear as 'H' instead of 'C-h m'. + Now, the command key is substituted after the ielm buffer has been + created. + * lisp/ielm.el (ielm-header): Remove substitute-command-keys. + (inferior-emacs-lisp-mode): Add substitute-command-keys. (Bug#65213) + +2023-08-12 Eli Zaretskii + + Fix rare crashes in redisplay due to problems with fontsets + + * src/xdisp.c (get_next_display_element): If we have no usable + face to display a character/composition, treat that as glyphless. + (produce_glyphless_glyph): If neither it->face nor its ASCII face + are usable, fall back to the frame's default font. (Bug#65198) + +2023-08-12 Eli Zaretskii + + Fix a typo in 'leuven-dark-theme.el' + + * etc/themes/leuven-dark-theme.el (leuven-dark): Fix a typo. + Reported by John Poole . (Bug#65239) + +2023-08-10 Michael Albinus + + Adapt Tramp test + + * test/lisp/net/tramp-tests.el (tramp-test41-special-characters): + Skip for macOS. + +2023-08-10 dannyfreeman + + Properly expand the JSX indentation rules in 'js-ts-mode' + + * lisp/progmodes/js.el (js--treesit-indent-rules): Fix + 'js-ts-mode' indent bug in JSX expressions. Before this + change, treesit indent mechanisms were trying to call this + compatibility function like a matching or anchor rule. + This resulted in an error when running `indent-for-tab-command` + while the cursor was in a JSX expression: + + treesit--simple-indent-eval: Wrong number of + arguments: ((cl-struct-js--pitem-tags ido-cur-list t) nil "Indent rules + helper, to handle different releases of tree-sitter-javascript." + + (Bug#65134) + +2023-08-10 Andrea Corallo + + * Add `emacs-lisp-native-compile' to easy-menu. + + * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-menu): Add menu + item for emacs-lisp-native-compile. + +2023-08-10 Andrea Corallo + + * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-menu): Simplify condition. + +2023-08-10 Andrea Corallo + + * Introduce `emacs-lisp-native-compile'. + + * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile): New command. + (emacs-lisp-native-compile-and-load): Make use of. + +2023-08-10 Eli Zaretskii + + Fix the -x switch in non-X builds + + * src/emacs.c (main): Move the handling of the -x switch out of + the HAVE_X_WINDOWS condition, and simplify the rest of the code by + avoiding code duplication in HAVE_X_WINDOWS and !HAVE_X_WINDOWS + cases. (Bug#65048) + +2023-08-10 Po Lu + + Document that `set-mouse-color' does not work everywhere + + * etc/PROBLEMS (Miscellaneous Problems): Mention where + `set-mouse-color' does not work. + +2023-08-10 Eli Zaretskii + + Fix the effects and documentation of 'dired-free-space' + + * lisp/dired.el (dired-free-space): Fix doc string and Custom tags. + (dired--insert-disk-space): When 'dired-free-space' is 'separate', + return the position of the beginning of the disk-space line, to be + compatible with pre-Emacs 29 behavior under + 'dired-hide-details-mode'. (Bug#65186) + + * doc/emacs/dired.texi (Misc Dired Features): Fix wording in + documentation of 'dired-free-space'. + +2023-08-09 Stefan Kangas + + Fix cross-reference to eldoc in eglot manual + + * doc/misc/eglot.texi (Eglot Features): Fix cross-reference to eldoc + node in the Emacs manual. + +2023-08-09 Eli Zaretskii + + Add native-compilation to Emacs Lisp mode menu + + * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-menu): Add menu + item for emacs-lisp-native-compile-and-load. + +2023-08-09 Andrea Corallo + + Fix emacs-lisp-native-compile-and-load eln target directory (bug#64226) + + * lisp/emacs-lisp/comp.el (comp-spill-lap-function): Don't use + `byte+native-compile' to select output directory but always axpect + it explicit through `native-compile-target-directory'. + (batch-byte+native-compile): Set `native-compile-target-directory'. + * test/src/comp-tests.el (comp-tests-bootstrap): Set + `native-compile-target-directory'. + +2023-08-09 Mattias Engdegård + + Disable failing test (bug#65156) + + * test/src/fileio-tests.el (fileio-tests--non-regular-insert): + Mark as :unstable, since /dev/urandom is seekable. + + Do not merge to master. + +2023-08-08 Po Lu + + Better fix for bug#65156 + + * src/fileio.c (Finsert_file_contents): Correct seek-ability + test, since lseek returns -1 upon failure. (Bug#65156) + +2023-08-08 Eli Zaretskii + + Fix insert-file-contents with pipes and /dev/stdin + + * src/fileio.c (Finsert_file_contents): Restore logic of + non-regular but seekable files. (Bug#65156) + +2023-08-07 Po Lu + + Fix bug#65042 + + * src/pgtkterm.c (fill_background_by_face): Respect the frame's + background alpha property. + +2023-08-07 Eli Zaretskii + + * configure.ac (HAVE_TREE_SITTER): Set NEED_DYNLIB=yes (bug#65123). + +2023-08-06 Michael Albinus + + * etc/NEWS: Mention tramp-show-ad-hoc-proxies. + + * test/lisp/net/tramp-tests.el (tramp-test42-utf8): Skip for macOS. + + * test/lisp/net/tramp-tests.el (tramp-test10-write-region): Extend test. + +2023-08-06 Eli Zaretskii + + Fix reverting Rmail buffers + + This bug happened because rmail.el relied on 'revert-buffer' to + return non-nil when it succeeds to revert, but a recent change + in 'revert-buffer' broke that promise in Emacs 29.1. + * lisp/files.el (revert-buffer--default, revert-buffer): Doc fix. + (revert-buffer): Return whatever 'revert-buffer-function' returns. + (Bug#65071) + +2023-08-05 Jim Porter + + Fix handling of 'byte-compile-ignore-files' when nil + + Before this fix, when 'byte-compile-ignore-files' was nil, + 'byte-recompile-directory' would ignore every file (bug#64985). + + * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Handle case + when 'byte-compile-ignore-files' is nil. + +2023-08-05 Michael Albinus + + Sync with Tramp 2.6.2-pre + + * doc/misc/tramp.texi (Overview): Use "scp" in example. + (Obtaining @value{tramp}): Prefer https: to git: URIs on Savannah. + (Ssh setup): Extend for MS Windows and ssh. Explain + tramp-use-ssh-controlmaster-options value `suppress'. + (File name completion): Remove completion styles restrictions. + (Ad-hoc multi-hops): Describe tramp-show-ad-hoc-proxies. + (Remote processes): Add reference to "Using ssh connection sharing". + + * doc/misc/trampver.texi: + * lisp/net/trampver.el (tramp-version): Set to "2.6.2-pre". + + * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): + * lisp/net/tramp-archive.el + (tramp-archive-handle-file-name-all-completions): + * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): + * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): + * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): + * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): + * lisp/net/tramp-sudoedit.el + (tramp-sudoedit-handle-file-name-all-completions): Return nil when + DIRECTORY is missing. (Bug#61890) + + * lisp/net/tramp.el (tramp-accept-process-output): Don't use TIMEOUT + anymore, default it to 0. When the connection uses a shared + socket possibly, accept also the output from other processes over + the same connection. (Bug#61350) + (tramp-handle-file-notify-rm-watch, tramp-action-process-alive) + (tramp-action-out-of-band, tramp-process-one-action) + (tramp-interrupt-process): + * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): + * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch): + * lisp/net/tramp-smb.el (tramp-smb-action-get-acl) + (tramp-smb-action-set-acl, tramp-smb-wait-for-output): + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-action-sudo): Adapt callees. + + * lisp/net/tramp.el (tramp-get-process, tramp-message) + (tramp-handle-make-process, tramp-handle-file-notify-valid-p) + (tramp-process-actions, tramp-accept-process-output) + (tramp-process-sentinel, tramp-read-passwd) + (tramp-interrupt-process, tramp-signal-process): + * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): + * lisp/net/tramp-cmds.el (tramp-cleanup-connection): + * lisp/net/tramp-crypt.el (tramp-crypt-maybe-open-connection): + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch) + (tramp-gvfs-monitor-process-filter) + (tramp-gvfs-maybe-open-connection): + * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): + * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) + (tramp-sh-handle-file-notify-add-watch) + (tramp-sh-gio-monitor-process-filter) + (tramp-sh-inotifywait-process-filter) + (tramp-barf-if-no-shell-prompt, tramp-maybe-open-connection): + * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) + (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl) + (tramp-smb-maybe-open-connection): + * lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection): + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection) + (tramp-sudoedit-send-command): Prefix internal process properties + with "tramp-". + + * lisp/net/tramp.el (tramp-skeleton-file-exists-p): New defmacro, + which also handles host name completion. + (tramp-handle-file-exists-p): + * lisp/net/tramp-adb.el (tramp-adb-handle-file-exists-p): + * lisp/net/tramp-sh.el (tramp-sh-handle-file-exists-p): + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-exists-p): Use it. + + * lisp/net/tramp.el (tramp-wrong-passwd-regexp): + * lisp/net/tramp-adb.el (tramp-adb-prompt): + * lisp/net/tramp-sh.el (tramp-sh-inotifywait-process-filter): + * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Unify regexps. + + * lisp/net/tramp.el: + * lisp/net/tramp-cmds.el: + * lisp/net/tramp-crypt.el: + * lisp/net/tramp-gvfs.el: + * lisp/net/tramp-sh.el: + * lisp/net/tramp-smb.el: Fix error messages. + + * lisp/net/tramp-cmds.el (tramp-cleanup-connection): + Protect `delete-process'. + + * lisp/net/tramp.el (tramp-prefix-format, tramp-prefix-regexp) + (tramp-method-regexp, tramp-postfix-method-format) + (tramp-postfix-method-regexp, tramp-prefix-ipv6-format) + (tramp-prefix-ipv6-regexp, tramp-postfix-ipv6-format) + (tramp-postfix-ipv6-regexp, tramp-postfix-host-format) + (tramp-postfix-host-regexp, tramp-remote-file-name-spec-regexp) + (tramp-file-name-structure, tramp-file-name-regexp) + (tramp-completion-method-regexp) + (tramp-completion-file-name-regexp): + * lisp/net/tramp-compat.el (tramp-syntax): + * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-event-vector): + Rearrange declarations. + + * lisp/net/tramp-compat.el (ansi-color): Require. + (ls-lisp): Don't require. (Bug#64124) + (tramp-compat-replace-regexp-in-region): Move up. + (tramp-compat-length<, tramp-compat-length>) + (tramp-compat-length=): New defaliases. + (tramp-compat-file-name-unquote, tramp-compat-take) + (tramp-compat-ntake): Use them. + + * lisp/net/tramp-container.el (tramp-container--completion-function): + Rename from `tramp-docker--completion-function'. Add argument + PROGRAM. Use it for "docker" and "podman" host name completion. + + * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-exists-p): + New defun. + (tramp-crypt-file-name-handler-alist): Add it. + + * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-exists-p): New defun. + (tramp-fuse-mount-timeout): Move up. + (tramp-fuse-mount-point): Use `tramp-fuse-mount-timeout'. + (tramp-fuse-unmount): Flush "mount-point" file property. + (tramp-fuse-mount-point, tramp-fuse-mounted-p): Support existing + mount points. + (tramp-fuse-mounted-p): The mount-spec could contain an optional + trailing slash. (Bug#64278) + + * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file) + * lisp/net/tramp-rclone.el (tramp-rclone-do-copy-or-rename-file): + Improve stability for WebDAV. + (tramp-rclone-handle-file-system-info): Check return code of + command. + + * lisp/net/tramp-gvfs.el (while-no-input-ignore-events): + Add `dbus-event' for older Emacs versions. + (tramp-gvfs-parse-device-names): Ignore errors. + + * lisp/net/tramp-sh.el (tramp-display-escape-sequence-regexp) + (tramp-device-escape-sequence-regexp): Delete. + (tramp-sh-handle-insert-directory, tramp-barf-if-no-shell-prompt) + (tramp-wait-for-output): Use `ansi-color-control-seq-regexp'. + (tramp-use-ssh-controlmaster-options): Allow new value `suppress'. + (tramp-ssh-option-exists-p): New defun. + (tramp-ssh-controlmaster-options): Implement `suppress' actions. + Should never return nil, but empty string. + (tramp-perl-file-name-all-completions): Don't print status message. + (tramp-sh-handle-file-name-all-completions): Return nil when check + fails. (Bug#61890) + (tramp-run-test): Add VEC argument. + (tramp-sh-handle-file-executable-p) + (tramp-sh-handle-file-readable-p) + (tramp-sh-handle-file-directory-p) + (tramp-sh-handle-file-writable-p): Adapt callees. + (tramp-sh-handle-insert-directory): + (tramp-sh-handle-insert-directory): Test whether -N is understood + by ls since that option is used along with --dired. Remove -N + when we remove --dired. (Bug#63142) + (tramp-sh-handle-insert-directory, tramp-barf-if-no-shell-prompt) + (tramp-wait-for-output): Use `ansi-color-control-seq-regexp'. + (tramp-sh-handle-expand-file-name): `null-device' could be nil. + Reported by Richard Copley . + (tramp-sh-handle-make-process): Improve handling of + connection-type `pipe'. (Bug#61341) + + * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link): + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-symbolic-link): + Flush TARGET file properties. + + * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file): Flush proper + file properties. + (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl): + Remove superfluous `unwind-protect'. + + * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): + Use `tramp-fuse-handle-file-exists-p'. + (tramp-sshfs-handle-insert-file-contents): Move result out of + unwindform. + + * lisp/net/tramp.el (tramp-string-empty-or-nil-p): New defsubst. + Use it everywhere when appropriate. + + * lisp/net/tramp.el (tramp-methods) <->: Add. + (tramp-completion-file-name-handler-alist): + Add `expand-file-name', `file-exists-p', `file-name-directory' and + `file-name-nondirectory'. + (tramp-dissect-file-name): Do not extra check for + `tramp-default-method-marker'. + (tramp-completion-handle-expand-file-name) + (tramp-completion-handle-file-exists-p) + (tramp-completion-handle-file-name-directory) + (tramp-completion-handle-file-name-nondirectory): New defuns. + (tramp-completion-handle-file-name-all-completions): Remove duplicates. + (tramp-show-ad-hoc-proxies): New defcustom. + (tramp-make-tramp-file-name): Use it. + (tramp-make-tramp-hop-name): Don't add hop twice. + (tramp-shell-prompt-pattern): Remove escape characters. + (tramp-process-one-action, tramp-convert-file-attributes): + Use `ansi-color-control-seq-regexp'. (Bug#63539) + (tramp-wrong-passwd-regexp): Add "Authentication failed" string + (from doas). + (tramp-terminal-type): Fix docstring. + (tramp-process-one-action): Delete ANSI control escape sequences + in buffer. (Bug#63539) + (tramp-build-completion-file-name-regexp): Support user name + completion. + (tramp-make-tramp-file-name): Keep hop while in file + (tramp-set-completion-function): Check, that cdr of FUNCTION-LIST + entries is a string. + (tramp-completion-file-name-handler): Run only when + `minibuffer-completing-file-name' is non-nil. + (tramp-skeleton-write-region): Fix scoping. (Bug#65022) + (tramp-handle-memory-info): Work on newly created objects, or use + non-destructive operations. + (tramp-accept-process-output): Use `with-local-quit'. + (tramp-call-process, tramp-call-process-region): + Let-bind `temporary-file-directory'. + + * test/lisp/net/tramp-archive-tests.el (tramp-archive--test-emacs28-p): + New defun. + (tramp-archive-test16-directory-files): Don't mutate. + (tramp-archive-test47-auto-load): Adapt test. + + * test/lisp/net/tramp-tests.el (tramp-display-escape-sequence-regexp): + Dont't declare. + (tramp-action-yesno): Suppress run in tests. + (tramp-test02-file-name-dissect): + (tramp-test02-file-name-dissect-simplified) + (tramp-test02-file-name-dissect-separate): Adapt tests. + (tramp-test21-file-links): + (tramp-test21-file-links, tramp-test26-file-name-completion) + (tramp-test28-process-file, tramp-test29-start-file-process) + (tramp-test30-make-process, tramp-test33-environment-variables) + (tramp-test38-find-backup-file-name, tramp-test47-auto-load) + (tramp-test39-detect-external-change, tramp-test42-utf8) + (tramp-test47-auto-load, tramp-test47-delay-load) + (tramp-test48-unload): Adapt tests. + (tramp-test26-file-name-completion-with-perl): + (tramp-test26-file-name-completion-with-ls) + (tramp-test26-interactive-file-name-completion): New tests. + (tramp-test44-asynchronous-requests): Mark as :unstable. + +2023-08-05 Eli Zaretskii + + Fix documentation of saveplace facilities for Dired + + * lisp/saveplace.el (save-place-dired-hook, save-place-alist): + * lisp/dired.el (dired-initial-position-hook) + (dired-initial-position): Doc fixes. (Bug#65055) + +2023-08-04 Jim Porter + + Fix loaddef generation with ";;;foo-autoload" cookies in external packages + + This caused an issue where package-specific autoload cookies weren't + being correctly recognized, so they got dumped into the package's main + "-autoloads.el" file, instead of "-loaddefs.el" as they + should (bug#65023). + + * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): + Save match data when checking syntax. + +2023-08-04 Stefan Kangas + + Delete comment saying that project.el is experimental + + * lisp/progmodes/project.el (Commentary): Delete comment saying that + the API is "still experimental". It is to be considered stable + starting with the version released with Emacs 29. + Ref: https://lists.gnu.org/r/emacs-devel/2023-07/msg00415.html + +2023-08-04 Eli Zaretskii + + Fix byte-compiled files that use 'bind-key' from use-package + + * lisp/use-package/bind-key.el (bind-key): Ensure 'bind-key' is + loaded at run time. Patch by John Wiegley . + (Bug#64901) + +2023-08-04 Eli Zaretskii + + Fix "Paste from Kill Menu" in non X toolkit builds + + * src/keymap.c (possibly_translate_key_sequence): Don't signal an + error if 'key-valid-p' returns nil. Suggested by Stefan Monnier + . (Bug#64927) + +2023-08-03 john muhl + + Handle tabs in the SQL shown in the column listing + + * lisp/sqlite-mode.el (sqlite-mode-list-columns): Handle tabs. + (Bug#64964) + +2023-08-03 Eli Zaretskii + + Add new keyword to 'typescript-ts-mode' + + * lisp/progmodes/typescript-ts-mode.el + (typescript-ts-mode--keywords): Add "satisfies", a new operator in + Typescript 4.9. (Bug#64924) + +2023-08-03 Stefan Kangas + + Fix link to info node in prin1 docstring + + * src/print.c (Fprin1): Fix linking to info node in docstring. + + (cherry picked from commit 4b73edb8d1da74fd1bda8894e982d9768fd1f18c) + +2023-08-03 Eli Zaretskii + + Clarify the meaning of the argument of ':align-to' space spec + + * doc/lispref/display.texi (Specified Space): Clarify the meaning + and measurement of HPOS in ':align-to' space specs. (Bug#65015) + +2023-08-01 Jim Porter + + Fix handling of ".elpaignore" file when compiling packages + + * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Treat + 'byte-compile-ignore-files' as a list of regexps per its docstring + (bug#64985). + +2023-08-01 Amritpal Singh (tiny change) + + Support files compressed by 'pigz' + + * src/decompress.c (md5_gz_stream): Check 'stream.avail_in' as + well. (Bug#63832) + + (cherry picked from commit 46b6d175054e8f6bf7cb45e112048c0cf02bfee9) + +2023-07-31 Eli Zaretskii + + Fix 'string-pixel-width' under 'line-prefix' + + * lisp/emacs-lisp/subr-x.el (string-pixel-width): Disable + 'line-prefix' and 'wrap-prefix' to avoid their effect on the + calculated string width. (Bug#64971) + +2023-07-31 Michael Albinus + + Fix find-dired-with-command for remote directories + + * lisp/find-dired.el (find-dired-with-command): + Use `start-file-process-shell-command'. (Bug#64897) + +2023-07-30 Kyle Meyer + + Update to Org 9.6.7-5-gd1d0c3 + +2023-07-30 Mattias Engdegård + + Fix rx wrong-code bug: ranges starting with ^ + + (rx (in (?^ . ?a))) was incorrectly translated to "[^-a]". + Change it so that we get "[_-a^]" instead. + + * lisp/emacs-lisp/rx.el (rx--generate-alt): Split ranges starting with + `^` occurring first in a non-negated character alternative. + * test/lisp/emacs-lisp/rx-tests.el (rx-any): Add and adapt tests. + + (cherry picked from commit 5f5d668ac7917d61e9366fe0c3efd7b542671c3d) + +2023-07-30 Basil L. Contovounesios + + Backport: Fix some tree-sitter :match regexps + + This was originally installed on 2023-06-17 in the emacs-29 release + branch and later reverted. This backport follows the Emacs 29.1 + release (bug#64019). + + The shy groups were caught by modified versions of the GNU ELPA + packages xr and relint: + - https://github.com/mattiase/xr/pull/6 + - https://github.com/mattiase/relint/pull/14 + + * lisp/progmodes/ruby-ts-mode.el (ruby-ts--s-p-query): Quote special + character in regexp. + * lisp/progmodes/java-ts-mode.el (java-ts-mode--font-lock-settings): + * lisp/progmodes/js.el (js--plain-method-re): + (js--treesit-font-lock-settings): + * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--font-lock-settings): + * lisp/progmodes/typescript-ts-mode.el + (typescript-ts-mode--font-lock-settings): Replace character + alternative [\\d], which matches '\' or 'd', with the most likely + intention [0-9]. Fix shy groups mistyped as optional colons. + Remove unneeded numbered :match group in rust-ts-mode. + + (cherry picked from commit cd8d3f3379ec7179fac4bb8e9c40658be15a64f6) + +2023-07-30 Po Lu + + Fix bug#64923 + + * src/xfns.c (Fx_create_frame): Prevent cairo surface from being + left without a desired size. (bug#64923) + +2023-07-30 Ulrich Müller + + Avoid spurious whitespace in the modeline of emacsclient frames + + * lisp/bindings.el (mode-line-client): Compute 'help-echotext + property in advance. (Bug#58183) + + (cherry picked from commit 8c3338f6ba354218aee12c223d778be4180f892b) + +2023-07-30 Mattias Engdegård + + Fix function help for advised aliases (bug#64797) + + * lisp/help-fns.el (help-fns--analyze-function): + For aliases, use the base function name if at the end of the chain. + This fixes a regression introduced in d30fde6b0cc. + + Reported by Michael Heerdegen. + + (cherry picked from commit 024bd1f09099ae186442001a75e578638070e296) + +2023-07-30 Eli Zaretskii + + Avoid crashes due to invalid 'mode-line-format' + + * src/xdisp.c (display_mode_element, redisplay_window_error): + Don't take XCAR of what can be Qnil. (Bug#64893) + + (cherry picked from commit 7ea3f39deec3d54914077455e70605a14eb7d200) + +2023-07-30 Eli Zaretskii + + Avoid crashes under 'which-key-mode' + + * src/keyboard.c (Fthis_single_command_keys): Don't allow calls to + Fvector with negative first argument. (Bug#64857) + + (cherry picked from commit 65834b8f8d53402517da7fe2446f5bac0aa30c39) + +2023-07-30 Eli Zaretskii + + Bump Emacs version + + * README: + * configure.ac: + * nt/README.W32: + * msdos/sed2v2.inp: + * etc/NEWS: Bump Emacs version to 29.1.50. + +2023-07-29 Vincenzo Pupillo + + Update CMake support due to upstream changes (bug#64922) + + A recent change in tree-sitter-cmake grammar support for CMake (commit + fe9b5e0), now put arguments are wrapped in a new argument_list node. + To support the old and new version of the grammar, a new function was + added on which string syntax highlighting now depends. + + * lisp/progmodes/cmake-ts-mode.el + (cmake-ts-mode--font-lock-compatibility-fe9b5e0): Indent helper + function to handle different tree-sitter-cmake version. + * lisp/progmodes/cmake-ts-mode.el + (cmake-ts-mode--font-lock-settings): Use the new function to handle + the new argument_list node. + +2023-07-24 Theodor Thornhill + + Remove nullptr named node from c++-ts-mode (bug#64818) + + The nullptr node was changed from a named node to an unnamed node + upstream[0], which caused font locking to break. As this is a small + enough regression, no compat code is required. + + * lisp/progmodes/c-ts-mode.el (c-ts-mode--font-lock-settings): Remove + node no longer in use. + + [0]: + https://github.com/tree-sitter/tree-sitter-c/commit/c75868f8b508ae32a0c8490da91bb31b2b96430e + +2023-07-24 Theodor Thornhill + + Make compat check also check typescript + + * lisp/progmodes/typescript-ts-mode.el + (tsx-ts-mode--font-lock-compatibility-bb1f97b): + Add argument so that we run the 'treesit-query-capture' when the + language is 'typescript', not only 'tsx'. + + * lisp/progmodes/typescript-ts-mode.el + (typescript-ts-mode--font-lock-settings): Use supplied argument. + +2023-07-23 Eli Zaretskii + + Update HISTORY and ChangeLog.4 + + * etc/HISTORY: + * ChangeLog.4: Update for the Emacs 29.1 release. + 2023-07-30 Eli Zaretskii * Version 29.1 released. @@ -117380,7 +119361,7 @@ This file records repository revisions from commit f2ae39829812098d8269eafbc0fcb98959ee5bb7 (exclusive) to -commit 7d1737071fba1fd83039aac34f34f6b90c9579b8 (inclusive). +commit d9e1605122b4ba70a55f7b168505b7d7f8d2bdd6 (inclusive). See ChangeLog.3 for earlier changes. ;; Local Variables: diff --git a/etc/AUTHORS b/etc/AUTHORS index 27d01ed9eb9..5fc54f1909f 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -280,6 +280,8 @@ Amin Bandali: changed erc.el erc.texi erc-backend.el erc-button.el Amos Bird: changed xfns.c +Amritpal Singh: changed decompress.c + Anand Mitra: changed gnus-sum.el Anders Holst: wrote hippie-exp.el @@ -296,9 +298,9 @@ Anders Waldenborg: changed emacsclient.c Andrea Corallo: wrote comp-cstr-tests.el comp-cstr.el comp-tests.el comp.el and changed comp.c pdumper.c lread.c bytecomp.el startup.el configure.ac - comp.h loadup.el lisp.h data.c alloc.c emacs.c .gitlab-ci.yml - cl-macs.el elisp-mode.el nadvice.el comp-test-funcs.el lisp/Makefile.in - subr.el Makefile.in advice.el and 70 other files + comp.h loadup.el lisp.h data.c elisp-mode.el alloc.c emacs.c subr.el + .gitlab-ci.yml cl-macs.el nadvice.el comp-test-funcs.el + lisp/Makefile.in Makefile.in advice.el and 70 other files André A. Gomes: changed ispell.el @@ -535,6 +537,8 @@ Aubrey Jaffer: changed info.el unexelf.c August Feng: changed bookmark.el +Augustin Chéneau: changed treesit.el + Augusto Stoffel: co-wrote ansi-osc.el and changed progmodes/python.el isearch.el eglot.el comint.el eldoc.el project.el README.md font-lock.el man.el misc.texi modes.texi @@ -578,8 +582,8 @@ Bartosz Duszel: changed allout.el bib-mode.el cc-cmds.el hexl.el icon.el Basil L. Contovounesios: changed simple.el subr.el message.el eww.el modes.texi custom.el text.texi bibtex.el gnus-sum.el internals.texi - customize.texi display.texi files.texi gnus-group.el gnus-win.el - gnus.texi gravatar.el js.el json.el map.el shr.el and 345 other files + js.el customize.texi display.texi files.texi gnus-group.el gnus-win.el + gnus.texi gravatar.el json.el map.el shr.el and 345 other files Bastian Beischer: changed semantic/complete.el calc-yank.el include.el mru-bookmark.el refs.el senator.el @@ -702,9 +706,9 @@ Bob Olson: co-wrote cperl-mode.el Bob Rogers: wrote ietf-drums-date-tests.el ietf-drums-date.el ietf-drums-tests.el -and changed ietf-drums.el vc-dir.el vc-svn.el cperl-mode.el diff.el - ewoc.el ffap.el files.el maintaining.texi sql.el thingatpt.el - time-date.el vc.el vc1-xtra.texi +and changed ietf-drums.el vc-dir.el time-date.el vc-svn.el cperl-mode.el + diff.el ewoc.el ffap.el files.el maintaining.texi os.texi sql.el + thingatpt.el vc.el vc1-xtra.texi Bob Weiner: changed info.el quail.el dframe.el etags.c rmail.el rmailsum.el speedbar.el @@ -1014,6 +1018,8 @@ Christopher Wellons: changed emacs-lisp/cl-lib.el hashcash.el Christophe Troestler: changed gnus-icalendar.el epg.el newcomment.el +Christoph Göttschkes: changed make-mode.el + Christoph Scholtes: changed README.W32 progmodes/python.el stdint.h INSTALL maintaining.texi INSTALL.REPO admin.el bookmark.el configure.bat control.texi cua-base.el help-mode.el help.el ibuffer.el @@ -1158,7 +1164,7 @@ Daniele Nicolodi: changed url-http.el Daniel Fleischer: changed TUTORIAL browse-url.el startup.el -Daniel Freeman: changed eglot.el eglot.texi +Daniel Freeman: changed eglot.el js.el eglot.texi Daniel Gröber: changed rxvt.el @@ -1190,7 +1196,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 45 other files + compile.texi configure.ac and 46 other files Daniel McClanahan: changed lisp-mode.el @@ -1316,7 +1322,7 @@ David Edmondson: changed message.el erc.el mml2015.el process.c gnus-cite.el gnus-cloud.el gnus.texi imap.el mm-uu.el mm-view.el nnfolder.el nnimap.el nnml.el rcirc.el shr.el -Davide Masserut: changed bindings.el sh-script.el basic.texi +Davide Masserut: changed bindings.el sh-script.el Makefile.in basic.texi dictionary.el eglot.el faces.el go-ts-mode-tests.el go-ts-mode.el indent.erts @@ -1420,8 +1426,8 @@ David Ponce: wrote bovine/grammar.el cedet.el comp.el java-tags.el and co-wrote util-modes.el and changed w32menu.c w32term.c close.png close.xpm empty.png empty.xpm end-guide.png end-guide.xpm files.el guide.png guide.xpm handle.png - handle.xpm keyboard.c leaf.png leaf.xpm no-guide.png no-guide.xpm - no-handle.png no-handle.xpm open.png and 22 other files + handle.xpm image.el keyboard.c leaf.png leaf.xpm no-guide.png + no-guide.xpm no-handle.png no-handle.xpm and 22 other files David Raynes: changed ns-win.el @@ -1496,7 +1502,7 @@ Detlev Zundel: wrote re-builder.el and changed buffer.c Devon Sean McCullough: changed url-http.el buff-menu.el comint.el - ns-win.el + iso-transl.el ns-win.el Dhruva Krishnamurthy: changed emacsclient.c fontset.c image.c sound.c w32proc.c @@ -1660,9 +1666,9 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c] chartab-tests.el coding-tests.el etags-tests.el rxvt.el tty-colors.el and co-wrote help-tests.el and changed xdisp.c display.texi w32.c msdos.c simple.el w32fns.c - files.el fileio.c keyboard.c emacs.c text.texi w32term.c configure.ac + 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 1330 other files + dispextern.h lisp.h and 1334 other files Eliza Velasquez: changed server.el @@ -1808,7 +1814,7 @@ Ernesto Alfonso: changed simple.el E Sabof: changed hi-lock.el image-dired.el -Eshel Yaron: changed eglot.el eww.el +Eshel Yaron: changed eglot.el emacs.texi eww.el indent.texi Espen Skoglund: wrote pascal.el @@ -1877,10 +1883,8 @@ and changed minibuf.c esh-var.el minibuf.texi mouse.el package.el rect.el edebug.el em-dirs.el eshell-tests.el eww.el fileio-tests.el fileio.c files.texi gamegrid.el keyboard.c and 8 other files -Felician Nemeth: changed rmc.el - Felicián Németh: changed eglot.el EGLOT-NEWS README.md eglot-tests.el - project.el xref.el + project.el rmc.el xref.el Felipe Ochoa: changed faces.el js.el paren.el @@ -2154,12 +2158,10 @@ and changed tar-mode.el Greg Minshall: changed eldoc.el -Gregoire Jadi: changed proced.el - Grégoire Jadi: changed org.texi configure.ac emacsgtkfixed.c keyboard.c rcirc.el xwidget.c xwidget.el Makefile.in bibtex-tests.el bibtex.el cl-generic.el dispextern.h dispnew.c emacs.c latin-post.el lisp.h - ob-core.el org-id.el org.el print.c reporter.el and 8 other files + ob-core.el org-id.el org.el print.c proced.el and 9 other files Gregorio Gervasio, Jr.: changed gnus-sum.el @@ -2342,7 +2344,8 @@ Igor Kuzmin: wrote cconv.el Igor Saprykin: changed ftfont.c Ihor Radchenko: wrote org-fold-core.el org-fold.el org-persist.el -and changed ox.el fns.c help-mode.el oc.el org-element.el +and changed ox.el fns.c emacsclient.desktop help-mode.el oc.el + org-element.el Iku Iwasa: changed auth-source-pass-tests.el auth-source-pass.el @@ -2504,7 +2507,7 @@ James TD Smith: changed org.el org-colview.el org-clock.el org-remember.el org-plot.el org-agenda.el org-compat.el org-habit.el org.texi -James Thomas: changed quail/indian.el gnus-msg.el ind-util.el +James Thomas: changed quail/indian.el gnus-msg.el ind-util.el nnmail.el James Troup: changed gnus-sum.el @@ -2545,10 +2548,8 @@ Jan Seeger: changed ox-publish.el parse-time.el Jan Stranik: changed ebrowse.c -Jan Synacek: changed emacs-lisp-intro.texi minibuffer.el mwheel.el - vc-git.el - -Jan Synáček: changed maintaining.texi project.el +Jan Synáček: changed emacs-lisp-intro.texi maintaining.texi minibuffer.el + mwheel.el project.el vc-git.el Jan Tatarik: wrote gnus-icalendar-tests.el gnus-icalendar.el and changed gnus-score.el gnus-logic.el @@ -2686,8 +2687,8 @@ and changed mml-sec.el gnus-util.el message.texi mml-smime.el mml1991.el Jens Petersen: wrote find-func.el and changed mule-cmds.el pcmpl-rpm.el -Jens Schmidt: changed epa.texi plstore.el auth.texi comint.el gnus.texi - isearch.el ldap.el +Jens Schmidt: changed plstore.el epa.texi auth.texi comint.el + elisp-mode.el epa-file.el epg.el gnus.texi isearch.el ldap.el Jens Toivo Berger Thielemann: changed word-help.el @@ -2766,7 +2767,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 90 other files + and 92 other files Jim Radford: changed gnus-start.el @@ -2778,12 +2779,13 @@ Jim Wilson: changed alloca.c oldXMenu/Makefile.in Jin Choi: changed progmodes/python.el -Jindrich Makovicka: changed eval.c fns.c - -Jindřich Makovička: changed pgtkfns.c pgtkselect.c pgtkterm.c +Jindřich Makovička: changed eval.c fns.c pgtkfns.c pgtkselect.c + pgtkterm.c Jirka Kosek: changed mule.el +J M: changed csharp-mode.el + Joachim Nilsson: changed cc-styles.el Joachim Reiter: changed org-footnote.el @@ -2920,7 +2922,7 @@ John Mastro: changed auth-source.el ibuffer.el w32heap.c John Mongan: changed progmodes/f90.el -John Muhl: changed calculator.el +John Muhl: changed calculator.el sqlite-mode.el John Paul Wallington: changed ibuffer.el ibuf-ext.el subr.el help-fns.el rmail.el files.el thumbs.el bindings.el fns.c xfns.c arc-mode.el @@ -3044,7 +3046,7 @@ and changed xterm.c xfns.c keyboard.c screen.c dispnew.c xdisp.c window.c Joseph M. Kelsey: changed fileio.c skeleton.el -Joseph Turner: changed package-vc.el +Joseph Turner: changed package-vc.el subr.el Josh Elsasser: changed eglot.el README.md configure.ac @@ -3125,8 +3127,8 @@ Juri Linkov: wrote compose.el emoji.el files-x.el misearch.el repeat-tests.el replace-tests.el tab-bar-tests.el tab-bar.el tab-line.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 mouse.el - outline.el diff-mode.el repeat.el image-mode.el files.el menu-bar.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 Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h @@ -3387,8 +3389,6 @@ Kishore Kumar: changed terminal.el Kiso Katsuyuki: changed tab-line.el -Kjartan Oli Agustsson: changed doc-view.el - Kjartan Óli Ágústsson: changed doc-view.el Klaus Straubinger: changed url-http.el url-history.el pcmpl-rpm.el @@ -3666,7 +3666,7 @@ Manuel Giraud: changed vc.el ox-html.el bookmark.el image-dired.el longlines.el ox-publish.el keyboard.c paragraphs.el simple.el basic.texi battery.el bookmark-tests.el cus-start.el dired.texi dispextern.h easymenu.el find-dired.el ibuf-ext.el ibuf-macs.el - idlwave.el image.c and 11 other files + idlwave.el image-mode.el and 12 other files Manuel Gómez: changed speedbar.el @@ -3935,6 +3935,8 @@ Matthew Mundell: changed calendar.texi diary-lib.el files.texi Matthew Newton: changed imenu.el +Matthew Tromp: changed ielm.el + Matthew White: changed buffer.c bookmark-tests.el bookmark.el test-list.bmk @@ -3988,7 +3990,7 @@ 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 button.el and 45 other files + autorevert.el base.el and 56 other files Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el @@ -4011,8 +4013,8 @@ 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-x.el - and 308 other files + os.texi tramp-gw.el test/Makefile.in README shell.el files-tests.el + and 309 other files Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h unexec.c @@ -4453,6 +4455,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 Swainland: changed calc.el goto-addr.el misc.texi Noam Postavsky: changed progmodes/python.el lisp-mode.el bytecomp.el @@ -4795,9 +4799,10 @@ Philipp Stephani: wrote callint-tests.el checkdoc-tests.el cl-preloaded-tests.el ediff-diff-tests.el eval-tests.el ido-tests.el lread-tests.el mouse-tests.el startup-tests.el xt-mouse-tests.el and changed emacs-module.c emacs-module-tests.el configure.ac json.c - process.c eval.c internals.texi json-tests.el process-tests.el alloc.c - emacs-module.h.in emacs.c lread.c nsterm.m pdumper.c bytecomp.el lisp.h - seccomp-filter.c callproc.c cl-macs.el gtkutil.c and 188 other files + process.c eval.c internals.texi json-tests.el process-tests.el + pdumper.c alloc.c emacs-module.h.in emacs.c lread.c nsterm.m + bytecomp.el lisp.h seccomp-filter.c callproc.c cl-macs.el gtkutil.c + and 188 other files Phillip Dixon: changed eglot.el @@ -5092,7 +5097,7 @@ and changed configure.ac process.c blocks.awk keymap.el font.c network-stream-tests.el processes.texi custom.texi emoji-zwj.awk ftfont.c gtkutil.c process-tests.el unicode vc-git.el terminal.c char-fold.el gnutls.el keymaps.texi network-stream.el nsm.el nsterm.m - and 192 other files + and 193 other files Robert Thorpe: changed cus-start.el indent.el rmail.texi @@ -5154,6 +5159,8 @@ Ross Donaldson: changed progmodes/python.el Ross Patterson: co-wrote org-protocol.el +Ross Timson: changed eglot.el + Roy Hashimoto: changed mm-view.el Roy Liu: changed ns-win.el @@ -5324,6 +5331,8 @@ Sebastian Kremer: wrote dired-aux.el dired.el ls-lisp.el and co-wrote dired-x.el find-dired.el and changed add-log.el +Sebastian Miele: changed strings.texi + Sebastian Reuße: changed find-dired.el Sebastian Rose: co-wrote org-protocol.el @@ -5515,10 +5524,10 @@ Stefan Kangas: wrote bookmark-tests.el cal-julian-tests.el studly-tests.el tabify-tests.el time-tests.el timezone-tests.el underline-tests.el uudecode-tests.el wallpaper.el warnings-tests.el and co-wrote help-tests.el keymap-tests.el -and changed image-dired.el package.el efaq.texi cperl-mode.el subr.el - checkdoc.el help.el bookmark.el simple.el dired.el files.el dired-x.el - gnus.texi keymap.c image-mode.el erc.el ediff-util.el speedbar.el - browse-url.el bytecomp-tests.el bytecomp.el and 1657 other files +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 Stefan Merten: co-wrote rst.el @@ -5571,7 +5580,7 @@ and co-wrote todo-mode.el 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 subr.el + hl-line.el menu-bar.el mouse.el otodo-mode.el simple.el and 63 other files Stephen C. Gilardi: changed configure.ac @@ -5781,7 +5790,7 @@ Thamer Mahmoud: changed arabic.el 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 js.el csharp-mode.el css-mode.el project.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 @@ -5833,6 +5842,8 @@ and changed soap-inspect.el eudc.el eudc-vars.el eudc.texi ldap.el README authinfo bbdb diary-lib.el display.texi eudc-capf.el and 8 other files +Thomas Hilke: changed sqlite-mode.el + Thomas Horsley: changed cxux-crt0.s cxux.h cxux7.h emacs.c nh3000.h nh4000.h simple.el sysdep.c xterm.c @@ -6075,8 +6086,8 @@ Ulrich Leodolter: changed w32proc.c Ulrich Müller: changed configure.ac calc-units.el emacsclient-mail.desktop lib-src/Makefile.in src/Makefile.in version.el Makefile.in doctor.el emacs.1 files.el gamegrid.el gud.el server.el - ChgPane.c ChgSel.c HELLO INSTALL XMakeAssoc.c authors.el bytecomp.el - case-table.el and 44 other files + ChgPane.c ChgSel.c HELLO INSTALL XMakeAssoc.c authors.el bindings.el + bytecomp.el and 45 other files Ulrich Neumerkel: changed xterm.c @@ -6151,7 +6162,8 @@ Vincent Bernat: changed gnus-int.el nnimap.el xsettings.c Vincent Del Vecchio: changed info.el mh-utils.el -Vincenzo Pupillo: changed js.el typescript-ts-mode.el java-ts-mode.el +Vincenzo Pupillo: changed cmake-ts-mode.el js.el typescript-ts-mode.el + java-ts-mode.el Vince Salvino: changed msdos.texi w32.c w32fns.c commit e84e0cfb38282921eadbf0e4a1e08466ab787235 Author: Po Lu Date: Thu Oct 19 16:19:18 2023 +0800 Relay body and attachments within Android e-mails to message-mailto * java/org/gnu/emacs/EmacsOpenActivity.java (onCreate): Infer e-mail body and subject from its parameters and convey this information to message-mailto. * lisp/gnus/message.el (message-mailto): New arguments SUBJECT, BODY and FILE-ATTACHMENTS. (message-mailto-1): Insert these arguments as appropriate. diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java index 202b3c8c5dc..0c0da6acd1f 100644 --- a/java/org/gnu/emacs/EmacsOpenActivity.java +++ b/java/org/gnu/emacs/EmacsOpenActivity.java @@ -55,6 +55,7 @@ import android.os.Build; import android.os.Bundle; import android.os.ParcelFileDescriptor; +import android.os.Parcelable; import android.util.Log; @@ -67,6 +68,8 @@ import java.io.InputStream; import java.io.UnsupportedEncodingException; +import java.util.List; + public final class EmacsOpenActivity extends Activity implements DialogInterface.OnClickListener, DialogInterface.OnCancelListener @@ -396,6 +399,7 @@ private class EmacsClientThread extends Thread Finally, display any error message, transfer the focus to an Emacs frame, and finish the activity. */ + @SuppressWarnings ("deprecation") /* getParcelableExtra */ @Override public void onCreate (Bundle savedInstanceState) @@ -407,6 +411,11 @@ private class EmacsClientThread extends Thread ParcelFileDescriptor fd; byte[] names; String errorBlurb, scheme; + String subjectString, textString, attachmentString; + CharSequence tem; + String tem1; + StringBuilder builder; + List list; super.onCreate (savedInstanceState); @@ -425,6 +434,7 @@ private class EmacsClientThread extends Thread if (action.equals ("android.intent.action.VIEW") || action.equals ("android.intent.action.EDIT") || action.equals ("android.intent.action.PICK") + || action.equals ("android.intent.action.SEND") || action.equals ("android.intent.action.SENDTO")) { /* Obtain the URI of the action. */ @@ -452,8 +462,110 @@ private class EmacsClientThread extends Thread /* Escape the special characters $ and " before enclosing the string within the `message-mailto' wrapper. */ fileName = uri.toString (); - fileName.replace ("\"", "\\\"").replace ("$", "\\$"); - fileName = "(message-mailto \"" + fileName + "\")"; + fileName = (fileName + .replace ("\\", "\\\\") + .replace ("\"", "\\\"") + .replace ("$", "\\$")); + fileName = "(message-mailto \"" + fileName + "\" "; + + /* Parse the intent itself to ascertain if any + non-standard subject, body, or something else of the + like is set. Such fields, non-standard as they are, + yield to fields provided within the URL itself; refer + to message-mailto. */ + + textString = attachmentString = subjectString = "()"; + + tem = intent.getCharSequenceExtra (Intent.EXTRA_SUBJECT); + + if (tem != null) + subjectString = ("\"" + (tem.toString () + .replace ("\\", "\\\\") + .replace ("\"", "\\\"") + .replace ("$", "\\$")) + + "\" "); + + tem = intent.getCharSequenceExtra (Intent.EXTRA_TEXT); + + if (tem != null) + textString = ("\"" + (tem.toString () + .replace ("\\", "\\\\") + .replace ("\"", "\\\"") + .replace ("$", "\\$")) + + "\" "); + + /* Producing a list of attachments is prey to two + mannerisms of the system: in the first instance, these + attachments are content URIs which don't allude to + their content types; and in the second instance, they + are either a list of such URIs or one individual URI, + subject to the type of the intent itself. */ + + if (Intent.ACTION_SEND.equals (action)) + { + /* The attachment in this case is a single content + URI. */ + + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.TIRAMISU) + uri = intent.getParcelableExtra (Intent.EXTRA_STREAM, + Uri.class); + else + uri = intent.getParcelableExtra (Intent.EXTRA_STREAM); + + if (uri != null + && (scheme = uri.getScheme ()) != null + && scheme.equals ("content")) + { + tem1 = EmacsService.buildContentName (uri); + attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\") + .replace ("\"", "\\\"") + .replace ("$", "\\$")) + + "\")"); + } + } + else + { + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.TIRAMISU) + list + = intent.getParcelableArrayListExtra (Intent.EXTRA_STREAM, + Parcelable.class); + else + list + = intent.getParcelableArrayListExtra (Intent.EXTRA_STREAM); + + if (list != null) + { + builder = new StringBuilder ("'("); + + for (Parcelable parcelable : list) + { + if (!(parcelable instanceof Uri)) + continue; + + uri = (Uri) parcelable; + + if (uri != null + && (scheme = uri.getScheme ()) != null + && scheme.equals ("content")) + { + tem1 = EmacsService.buildContentName (uri); + builder.append ("\""); + builder.append (tem1.replace ("\\", "\\\\") + .replace ("\"", "\\\"") + .replace ("$", "\\$")); + builder.append ("\""); + } + } + + builder.append (")"); + attachmentString = builder.toString (); + } + } + + fileName += subjectString; + fileName += textString; + fileName += attachmentString; + fileName += ")"; /* Execute emacsclient in order to execute this code. */ currentActivity = this; diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 969589bb942..0071c02c081 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8971,32 +8971,61 @@ message-parse-mailto-url retval)) ;;;###autoload -(defun message-mailto (&optional url) +(defun message-mailto (&optional url subject body file-attachments) "Command to parse command line mailto: links. This is meant to be used for MIME handlers: Setting the handler for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" will then start up Emacs ready to compose mail. For emacsclient use - emacsclient -e \\='(message-mailto \"%u\")'" + emacsclient -e \\='(message-mailto \"%u\")' + +To facilitate the use of this function within window systems that +provide message subject, body and attachments independent of URL +itself, the arguments SUBJECT, BODY and FILE-ATTACHMENTS may also +provide alternative message subject and body text, which is +inserted in lieu of nothing if URL does not incorporate such +information itself, and a list of files to insert as attachments +to the E-mail." (interactive) ;; Send email (message-mail) - (message-mailto-1 (or url (pop command-line-args-left)))) + (message-mailto-1 (or url (pop command-line-args-left)) + subject body file-attachments)) -(defun message-mailto-1 (url) - (let ((args (message-parse-mailto-url url))) +(defun message-mailto-1 (url &optional subject body file-attachments) + (let ((args (message-parse-mailto-url url)) + (need-body nil) (need-subject nil)) (dolist (arg args) (unless (equal (car arg) "body") (message-position-on-field (capitalize (car arg))) (insert (string-replace "\r\n" "\n" (mapconcat #'identity (reverse (cdr arg)) ", "))))) - (when (assoc "body" args) - (message-goto-body) - (dolist (body (cdr (assoc "body" args))) - (insert body "\n"))) + (if (assoc "body" args) + (progn + (message-goto-body) + (dolist (body (cdr (assoc "body" args))) + (insert body "\n"))) + + (setq need-body t)) (if (assoc "subject" args) (message-goto-body) - (message-goto-subject)))) + (setq need-subject t) + (message-goto-subject)) + ;; If either one of need-subject and need-body is non-nil then + ;; attempt to insert the absent information from an external + ;; SUBJECT or BODY. + (when (or need-body need-subject) + (when (and need-body body) + (message-goto-body) + (insert body)) + (when (and need-subject subject) + (message-goto-subject) + (insert subject) + (message-goto-body))) + ;; Subsequently insert each attachment enumerated within + ;; FILE-ATTACHMENTS. + (dolist (file file-attachments) + (mml-attach-file file nil 'attachment)))) (provide 'message) commit 77755706f086ac3d8d1fc560aee4a29e0fb64c77 Author: Gerd Möllmann Date: Thu Oct 19 08:39:07 2023 +0200 Gud LLDB fix for large completion count (bug#66625) * lisp/progmodes/gud.el (gud-lldb-max-completions): New defcustom. (gud-lldb-def-python-completion-function): New argument. (gud-lldb-fetch-completions): Pass max count to gud_complete. (gud-lldb-initialize): Change text displayed at the end. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 86836e153e5..1c7810803e2 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3855,7 +3855,7 @@ gud-tooltip-tips (defvar gud-lldb-history nil) (defcustom gud-gud-lldb-command-name "lldb" - "Default command to run an executable under LLDB in text command mode." + "Default command to run an executable under LLDB." :type 'string) (defun gud-lldb-marker-filter (string) @@ -3897,6 +3897,25 @@ gud-lldb-marker-filter ;; ;; If there is no common prefix, index 0 has an empty string "". +(defcustom gud-lldb-max-completions 20 + "Maximum number of completions to request from LLDB." + :type 'integer) + +(defvar gud-lldb-def-python-completion-function + " +def gud_complete(s, max): + interpreter = lldb.debugger.GetCommandInterpreter() + string_list = lldb.SBStringList() + interpreter.HandleCompletion(s, len(s), len(s), max, string_list) + print('gud-completions: (') + # Specifying a max count doesn't seem to work in LLDB 17. + max = min(max, string_list.GetSize()) + for i in range(max): + print(f'\"{string_list.GetStringAtIndex(i)}\" ') + print(')') +" + "LLDB Python function for completion.") + (defun gud-lldb-fetch-completions (context command) "Return the data to complete the LLDB command before point. This is what the Python function we installed at initialzation @@ -3908,8 +3927,8 @@ gud-lldb-fetch-completions (with-current-buffer output-buffer (erase-buffer)) (comint-redirect-send-command-to-process - (format "script --language python -- gud_complete('%s')" - to-complete) + (format "script --language python -- gud_complete('%s', %d)" + to-complete gud-lldb-max-completions) output-buffer process nil t) ;; Wait for output (unwind-protect @@ -3944,19 +3963,6 @@ gud-lldb-completion-at-point (completion-table-dynamic (apply-partially #'gud-lldb-completions context))))) -(defvar gud-lldb-def-python-completion-function - " -def gud_complete(s): - interpreter = lldb.debugger.GetCommandInterpreter() - string_list = lldb.SBStringList() - interpreter.HandleCompletion(s, len(s), len(s), -1, string_list) - print('gud-completions: (') - for i in range(string_list.GetSize()): - print(f'\"{string_list.GetStringAtIndex(i)}\" ') - print(')') -" - "LLDB command to define a Python function for completion.") - (defun gud-lldb-send-python (python) (gud-basic-call "script --language python --") (mapc #'gud-basic-call (split-string python "\n")) @@ -3967,7 +3973,7 @@ gud-lldb-initialize (gud-lldb-send-python gud-lldb-def-python-completion-function) (gud-basic-call "settings set stop-line-count-before 0") (gud-basic-call "settings set stop-line-count-after 0") - (gud-basic-call "script --language python -- print('Gud initialized')")) + (gud-basic-call "script --language python -- print('Gud initialized.')")) ;;;###autoload (defun lldb (command-line) commit 1038e480382d243adcbb0d173050f7c41234a0b5 Author: Gerd Möllmann Date: Wed Oct 18 09:24:45 2023 +0200 Gud LLDB completions (bug#66604) * etc/emacs_lldb.py: Remove xcomplete. * lisp/progmodes/gud.el: Implement lldb command completions. * src/.lldbinit: Remove settings done in Gud. diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index f2c7a7987c7..fa8d95d7b5b 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -203,35 +203,6 @@ def xdebug_print(debugger, command, result, internal_dict): """Print Lisp_Objects using safe_debug_print()""" debugger.HandleCommand(f"expr safe_debug_print({command})") -# According to SBCommanInterpreter.cpp, the return value of -# HandleCompletions is as follows: -# -# Index 1 to the end contain all the completions. -# -# At index 0: -# -# If all completions have a common prefix, this is the shortest -# completion, with the common prefix removed from it. -# -# If it is the completion for a whole word, a space is added at the -# end. -# -# So, the prefix is what could be added to make the command partially -# complete. -# -# If there is no common prefix, index 0 has an empty string "". - -def xcomplete(debugger, command, result, internal_dict): - """Print completions for COMMAND.""" - interpreter = debugger.GetCommandInterpreter() - string_list = lldb.SBStringList() - interpreter.HandleCompletion(command, len(command), len(command), - -1, string_list) - list = "" - for i in range(string_list.GetSize()): - list += '"' + string_list.GetStringAtIndex(i) + '" ' - result.AppendMessage("(" + list + ")") - ######################################################################## # Formatters @@ -336,7 +307,6 @@ def enable_type_category(debugger, category): def __lldb_init_module(debugger, internal_dict): define_command(debugger, xbacktrace) define_command(debugger, xdebug_print) - define_command(debugger, xcomplete) define_type_summary(debugger, "Lisp_Object", type_summary_Lisp_Object) define_type_synthetic(debugger, "Lisp_Object", Lisp_Object_Provider) enable_type_category(debugger, "Emacs") diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index ea5a3580629..86836e153e5 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3850,7 +3850,7 @@ gud-tooltip-tips ;; 'gud-lldb-history' and 'gud-gud-lldb-command-name' are required -;; because gud-symbol uses their values if they are present. Their +;; because 'gud-symbol' uses their values if they are present. Their ;; names are deduced from the minor-mode name. (defvar gud-lldb-history nil) @@ -3859,7 +3859,7 @@ gud-gud-lldb-command-name :type 'string) (defun gud-lldb-marker-filter (string) - "Deduce interesting stuff from output STRING." + "Deduce interesting stuff from process output STRING." (cond (;; Process 72668 stopped ;; * thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 1.1 ;; frame #0: ...) at emacs.c:1310:9 [opt] @@ -3879,6 +3879,96 @@ gud-lldb-marker-filter (setq gud-overlay-arrow-position nil))) string) +;; According to SBCommanInterpreter.cpp, the return value of +;; HandleCompletions is as follows: +;; +;; Index 1 to the end contain all the completions. +;; +;; At index 0: +;; +;; If all completions have a common prefix, this is the shortest +;; completion, with the common prefix removed from it. +;; +;; If it is the completion for a whole word, a space is added at the +;; end. +;; +;; So, the prefix is what could be added to make the command partially +;; complete. +;; +;; If there is no common prefix, index 0 has an empty string "". + +(defun gud-lldb-fetch-completions (context command) + "Return the data to complete the LLDB command before point. +This is what the Python function we installed at initialzation +time returns, as a Lisp list." + (let* ((process (get-buffer-process gud-comint-buffer)) + (to-complete (concat context command)) + (output-buffer (get-buffer-create "*lldb-completions*"))) + ;; Send the completion command with output to our buffer + (with-current-buffer output-buffer + (erase-buffer)) + (comint-redirect-send-command-to-process + (format "script --language python -- gud_complete('%s')" + to-complete) + output-buffer process nil t) + ;; Wait for output + (unwind-protect + (while (not comint-redirect-completed) + (accept-process-output process)) + (comint-redirect-cleanup)) + ;; Process the completion output. + (with-current-buffer output-buffer + (goto-char (point-min)) + (when (search-forward "gud-completions:" nil t) + (read (current-buffer)))))) + +(defun gud-lldb-completions (context command) + "Completion table for LLDB commands." + (let ((completions (gud-lldb-fetch-completions context command))) + ;; If this is a cmpletion for w whole word, return a completion + ;; list that contains that word only, with a space appended. + (if (string-suffix-p " " (car completions)) + (list (concat (cadr completions) " ")) + (cdr completions)))) + +(defun gud-lldb-completion-at-point () + "Return the data to complete the LLDB command before point." + (let* ((end (point)) + (line-start (comint-line-beginning-position)) + (start (save-excursion + (skip-chars-backward "^ " line-start) + (point))) + (context (buffer-substring line-start start))) + (list (copy-marker start t) + end + (completion-table-dynamic + (apply-partially #'gud-lldb-completions context))))) + +(defvar gud-lldb-def-python-completion-function + " +def gud_complete(s): + interpreter = lldb.debugger.GetCommandInterpreter() + string_list = lldb.SBStringList() + interpreter.HandleCompletion(s, len(s), len(s), -1, string_list) + print('gud-completions: (') + for i in range(string_list.GetSize()): + print(f'\"{string_list.GetStringAtIndex(i)}\" ') + print(')') +" + "LLDB command to define a Python function for completion.") + +(defun gud-lldb-send-python (python) + (gud-basic-call "script --language python --") + (mapc #'gud-basic-call (split-string python "\n")) + (gud-basic-call "exit()")) + +(defun gud-lldb-initialize () + "Initialize the LLDB process as needed for this debug session." + (gud-lldb-send-python gud-lldb-def-python-completion-function) + (gud-basic-call "settings set stop-line-count-before 0") + (gud-basic-call "settings set stop-line-count-after 0") + (gud-basic-call "script --language python -- print('Gud initialized')")) + ;;;###autoload (defun lldb (command-line) "Run lldb passing it COMMAND-LINE as arguments. @@ -3979,11 +4069,17 @@ lldb nil "Run the program.") + (add-hook 'completion-at-point-functions + #'gud-lldb-completion-at-point + nil 'local) + (keymap-local-set "" #'completion-at-point) + (gud-set-repeat-map-property 'gud-gdb-repeat-map) (setq comint-prompt-regexp (rx line-start "(lldb)" (0+ blank))) + (setq comint-process-echoes t) (setq paragraph-start comint-prompt-regexp) (setq gud-running nil) - (setq gud-filter-pending-text nil) + (gud-lldb-initialize) (run-hooks 'lldb-mode-hook)) (provide 'gud) diff --git a/src/.lldbinit b/src/.lldbinit index 430c48f91f0..a5789f49122 100644 --- a/src/.lldbinit +++ b/src/.lldbinit @@ -33,8 +33,4 @@ command script import emacs_lldb # Print with children provider, depth 2. command alias xprint frame variable -P 2 -# This is for M-x lldb: don't show source lines when stopping. -settings set stop-line-count-before 0 -settings set stop-line-count-after 0 - # end. commit 646ecec0ec97cbe6bb7efc1a553d37c403851680 Author: Harald Jörg Date: Wed Oct 18 16:25:56 2023 +0200 ; cperl-mode.el: Fix indentation issues after a format declaration. * lisp/progmodes/cperl-mode.el (cperl-sniff-for-indent): Recognize the end of a format declaration as a statement boundary. This fixes indentation if several format declarations immediately follow each other. (cperl-find-pods-heres): use the correct capture group for the name of an unterminated format declaration. Fix an out of boundary error when a format declaration is typed at the end of a buffer (Bug#66139). diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 6ef552137a7..d525b069407 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2853,6 +2853,7 @@ cperl-sniff-for-indent ;; in which case this line is the first argument decl. (skip-chars-forward " \t") (cperl-backward-to-noncomment (or old-indent (point-min))) + ;; Determine whether point is between statements (setq state (or (bobp) (eq (point) old-indent) ; old-indent was at comment @@ -2871,7 +2872,8 @@ cperl-sniff-for-indent (looking-at (rx (sequence (0+ blank) (eval cperl--label-rx)))))) - (get-text-property (point) 'first-format-line))) + (get-text-property (1- (point)) 'first-format-line) + (equal (get-text-property (point) 'syntax-type) 'format))) ;; Look at previous line that's at column 0 ;; to determine whether we are in top-level decls @@ -4201,9 +4203,8 @@ cperl-find-pods-heres ;; 1+6=7 extra () before this: ;;"^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" (setq b (point) - name (if (match-beginning 8) ; 7 + 1 - (buffer-substring (match-beginning 8) ; 7 + 1 - (match-end 8)) ; 7 + 1 + name (if (match-beginning 9) ; 7 + 2 + (match-string-no-properties 9) ; 7 + 2 "") tb (match-beginning 0)) (setq argument nil) @@ -4236,10 +4237,10 @@ cperl-find-pods-heres (if (looking-at "^\\.$") ; ";" is not supported yet (progn ;; Highlight the ending delimiter - (cperl-postpone-fontification (point) (+ (point) 2) + (cperl-postpone-fontification (point) (+ (point) 1) 'face font-lock-string-face) - (cperl-commentify (point) (+ (point) 2) nil) - (cperl-put-do-not-fontify (point) (+ (point) 2) t)) + (cperl-commentify (point) (+ (point) 1) nil) + (cperl-put-do-not-fontify (point) (+ (point) 1) t)) (setq warning-message (format "End of format `%s' not found." name)) (or (car err-l) (setcar err-l b))) commit b4b4b5f43158a4281d583a6dc573465533f4bf48 Author: F. Jason Park Date: Mon Feb 14 10:28:01 2022 -0800 Improve SOCKS error handling and support version 4a * doc/misc/url.texi: Mention version 4a in SOCKS portion of "Gateways in general" node. * etc/NEWS: Mention version 4a support in new `socks' section. * lisp/net/socks.el (socks-server): Add new Custom choice `4a' for version field. This change does not further overload the field in terms of expected type because `socks-send-command' and `socks-filter' already accommodate the symbol `http'. (socks--errors-4): Add new constant containing error messages for version 4. The semantics are faithful to the de facto spec, but the exact wording is slightly adapted. (socks-filter): Allow for a null "type" field on error with version 5. Previously, certain errors would not propagate because a wrong-type signal would get in the way. (socks-send-command): Massage existing version 4 protocol parsing to accommodate 4a, and add error handling for version 4. Use variable `socks-username' for v4 variable-length ID field instead of calling `user-full-name', which has potential privacy implications. * test/lisp/net/socks-tests.el (socks-tests-v4-basic): Don't mock `user-full-name' because `socks-send-command' no longer calls it to determine the ID. (socks-tests-v4a-basic, socks-tests-v4a-error): Add a couple tests for SOCKS version 4a. (Bug#53941) diff --git a/doc/misc/url.texi b/doc/misc/url.texi index e6636e32507..6517f858324 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -1083,16 +1083,18 @@ Gateways in general @defopt socks-server This specifies the default server, it takes the form @w{@code{("Default server" @var{server} @var{port} @var{version})}} -where @var{version} can be either 4 or 5. +where @var{version} can be 4, 4a, or 5. @end defopt @defvar socks-password If this is @code{nil} then you will be asked for the password, otherwise it will be used as the password for authenticating you to -the @sc{socks} server. +the @sc{socks} server. You can often set this to @code{""} for +servers on your local network. @end defvar @defvar socks-username This is the username to use when authenticating yourself to the -@sc{socks} server. By default this is your login name. +@sc{socks} server. By default, this is your login name. In versions +4 and 4a, ERC uses this for the @samp{ID} field. @end defvar @defvar socks-timeout This controls how long, in seconds, to wait for responses from the diff --git a/etc/NEWS b/etc/NEWS index c8c37f43284..129017f7dbe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -871,6 +871,13 @@ neither of which have been supported by Emacs since version 23.1. The user option 'url-gateway-nslookup-program' and the function 'url-gateway-nslookup-host' are consequently also obsolete. +** socks + ++++ +*** SOCKS supports version 4a. +The 'socks-server' option accepts '4a' as a value for its version +field. + ** Edmacro +++ diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 968a28d2be8..e572e5c9bdf 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -162,6 +162,7 @@ socks-server (radio-button-choice :tag "SOCKS Version" :format "%t: %v" (const :tag "SOCKS v4 " :format "%t" :value 4) + (const :tag "SOCKS v4a" :format "%t" :value 4a) (const :tag "SOCKS v5" :format "%t" :value 5)))) @@ -202,6 +203,12 @@ socks-errors "Command not supported" "Address type not supported")) +(defconst socks--errors-4 + '("Granted" + "Rejected or failed" + "Cannot connect to identd on the client" + "Client and identd report differing user IDs")) + ;; The socks v5 address types (defconst socks-address-type-v4 1) (defconst socks-address-type-name 3) @@ -309,7 +316,8 @@ socks-filter ((pred (= socks-address-type-name)) (if (< (length string) 5) 255 - (+ 1 (aref string 4))))))) + (+ 1 (aref string 4)))) + (0 0)))) (if (< (length string) desired-len) nil ; Need to spin some more (process-put proc 'socks-state socks-state-connected) @@ -399,6 +407,7 @@ socks-send-command (format "%c%s" (length address) address)) (t (error "Unknown address type: %d" atype)))) + trailing request version) (or (process-get proc 'socks) (error "socks-send-command called on non-SOCKS connection %S" proc)) @@ -415,6 +424,12 @@ socks-send-command (t (error "Unsupported address type for HTTP: %d" atype))) port))) + ((and (eq version '4a) + (setf addr "\0\0\0\1" + trailing (concat address "\0") + version 4 ; become version 4 + (process-get proc 'socks-server-protocol) 4) + nil)) ; fall through ((equal version 4) (setq request (concat (unibyte-string @@ -423,8 +438,9 @@ socks-send-command (ash port -8) ; port, high byte (logand port #xff)) ; port, low byte addr ; address - (user-full-name) ; username - "\0"))) ; terminate username + socks-username ; username + "\0" ; terminate username + trailing))) ; optional host to look up ((equal version 5) (setq request (concat (unibyte-string @@ -445,7 +461,13 @@ socks-send-command nil ; Sweet sweet success! (delete-process proc) (error "SOCKS: %s" - (nth (or (process-get proc 'socks-reply) 1) socks-errors))) + (let ((err (process-get proc 'socks-reply))) + (if (eql version 5) + (nth (or err 1) socks-errors) + ;; The defined error codes for v4 range from + ;; 90-93, but we store them in a simple list. + (nth (pcase err (90 0) (92 2) (93 3) (_ 1)) + socks--errors-4))))) proc)) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 0890ace826f..1a4bac37bf9 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -197,6 +197,7 @@ socks-tests-v4-basic "Show correct preparation of SOCKS4 connect command (Bug#46342)." (let ((socks-server '("server" "127.0.0.1" t 4)) (url-user-agent "Test/4-basic") + (socks-username "foo") (socks-tests-canned-server-patterns `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0]) ,socks-tests--hello-world-http-request-pattern)) @@ -205,11 +206,35 @@ socks-tests-v4-basic (cl-letf (((symbol-function 'socks-nslookup-host) (lambda (host) (should (equal host "example.com")) - (list 93 184 216 34))) - ((symbol-function 'user-full-name) - (lambda (&optional _) "foo"))) + (list 93 184 216 34)))) (socks-tests-perform-hello-world-http-request))))) +(ert-deftest socks-tests-v4a-basic () + "Show correct preparation of SOCKS4a connect command." + (let ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-username "foo") + (url-user-agent "Test/4a-basic") + (socks-tests-canned-server-patterns + `(([4 1 0 80 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 90 0 0 0 0 0 0]) + ,socks-tests--hello-world-http-request-pattern))) + (ert-info ("Make HTTP request over SOCKS4A") + (socks-tests-perform-hello-world-http-request)))) + +(ert-deftest socks-tests-v4a-error () + "Show error signaled when destination address rejected." + (let ((socks-server '("server" "127.0.0.1" t 4a)) + (url-user-agent "Test/4a-basic") + (socks-username "") + (socks-tests-canned-server-patterns + `(([4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 91 0 0 0 0 0 0]) + ,socks-tests--hello-world-http-request-pattern))) + (ert-info ("Make HTTP request over SOCKS4A") + (let ((err (should-error + (socks-tests-perform-hello-world-http-request)))) + (should (equal err '(error "SOCKS: Rejected or failed"))))))) + ;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate ;; against curl 7.71 with the following options: ;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com commit 2061bf0645e1f577c380ec81805e463f3c6fec7c Author: F. Jason Park Date: Mon Feb 14 10:28:01 2022 -0800 Don't hard code server ports in SOCKS tests * test/lisp/net/socks-tests.el (socks-tests-canned-server-create, socks-tests-filter-response-parsing-v4): Fix bug in process filter to prevent prepared outgoing responses from being implicitly encoded as UTF-8. Fix similar mistake in v4 filter test. (socks-tests-v4-basic, socks-tests-v5-auth-user-pass, socks-tests-v5-auth-user-pass-blank, socks-tests-v5-auth-none): Allow system to choose port instead of hard-coding it. (socks-tests-perform-hello-world-http-request): Add optional `method' parameter to specify a gateway method. (socks-tests-v5-auth-none): Move body to helper function of the same name. (socks-override-functions): New test ensuring top-level advice around `open-networks-stream' still supported. (Bug#53941) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 958e2ff44a8..0890ace826f 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -63,21 +63,21 @@ socks-tests-filter-response-parsing-v4 (process-put proc 'socks-state socks-state-waiting) (process-put proc 'socks-server-protocol 4) (ert-info ("Receive initial incomplete segment") - (socks-filter proc (concat [0 90 0 0 93 184 216])) - ;; From example.com: OK status ^ ^ msg start + (socks-filter proc (unibyte-string 0 90 0 0 93 184 216)) + ;; From example.com: OK status ^ ^ msg start (ert-info ("State still set to waiting") (should (eq (process-get proc 'socks-state) socks-state-waiting))) (ert-info ("Response field is nil because processing incomplete") (should-not (process-get proc 'socks-response))) (ert-info ("Scratch field holds stashed partial payload") - (should (string= (concat [0 90 0 0 93 184 216]) + (should (string= (unibyte-string 0 90 0 0 93 184 216) (process-get proc 'socks-scratch))))) (ert-info ("Last part arrives") (socks-filter proc "\42") ; ?\" 34 (ert-info ("State transitions to complete (length check passes)") (should (eq (process-get proc 'socks-state) socks-state-connected))) (ert-info ("Scratch and response fields hold stash w. last chunk") - (should (string= (concat [0 90 0 0 93 184 216 34]) + (should (string= (unibyte-string 0 90 0 0 93 184 216 34) (process-get proc 'socks-response))) (should (string= (process-get proc 'socks-response) (process-get proc 'socks-scratch))))) @@ -133,17 +133,19 @@ socks-tests-canned-server-patterns (defun socks-tests-canned-server-create () "Create and return a fake SOCKS server." (let* ((port (nth 2 socks-server)) - (name (format "socks-server:%d" port)) + (name (format "socks-server:%s" + (if (numberp port) port (ert-test-name (ert-running-test))))) (pats socks-tests-canned-server-patterns) (filt (lambda (proc line) (pcase-let ((`(,pat . ,resp) (pop pats))) (unless (or (and (vectorp pat) (equal pat (vconcat line))) - (string-match-p pat line)) + (and (stringp pat) (string-match-p pat line))) (error "Unknown request: %s" line)) + (setq resp (apply #'unibyte-string (append resp nil))) (let ((print-escape-control-characters t)) (message "[%s] <- %s" name (prin1-to-string line)) (message "[%s] -> %s" name (prin1-to-string resp))) - (process-send-string proc (concat resp))))) + (process-send-string proc resp)))) (serv (make-network-process :server 1 :buffer (get-buffer-create name) :filter filt @@ -151,8 +153,10 @@ socks-tests-canned-server-create :family 'ipv4 :host 'local :coding 'binary - :service port))) + :service (or port t)))) (set-process-query-on-exit-flag serv nil) + (unless (numberp (nth 2 socks-server)) + (setf (nth 2 socks-server) (process-contact serv :service))) serv)) (defvar socks-tests--hello-world-http-request-pattern @@ -161,9 +165,9 @@ socks-tests--hello-world-http-request-pattern "Content-Length: 13\r\n\r\n" "Hello World!\n"))) -(defun socks-tests-perform-hello-world-http-request () +(defun socks-tests-perform-hello-world-http-request (&optional method) "Start canned server, validate hello-world response, and finalize." - (let* ((url-gateway-method 'socks) + (let* ((url-gateway-method (or method 'socks)) (url (url-generic-parse-url "http://example.com")) (server (socks-tests-canned-server-create)) ;; @@ -191,7 +195,7 @@ socks-tests-perform-hello-world-http-request (ert-deftest socks-tests-v4-basic () "Show correct preparation of SOCKS4 connect command (Bug#46342)." - (let ((socks-server '("server" "127.0.0.1" 10079 4)) + (let ((socks-server '("server" "127.0.0.1" t 4)) (url-user-agent "Test/4-basic") (socks-tests-canned-server-patterns `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0]) @@ -213,7 +217,7 @@ socks-tests-v4-basic (ert-deftest socks-tests-v5-auth-user-pass () "Verify correct handling of SOCKS5 user/pass authentication." (should (assq 2 socks-authentication-methods)) - (let ((socks-server '("server" "127.0.0.1" 10080 5)) + (let ((socks-server '("server" "127.0.0.1" t 5)) (socks-username "foo") (socks-password "bar") (url-user-agent "Test/auth-user-pass") @@ -247,7 +251,7 @@ socks-tests-v5-auth-user-pass (ert-deftest socks-tests-v5-auth-user-pass-blank () "Verify correct SOCKS5 user/pass authentication with empty pass." (should (assq 2 socks-authentication-methods)) - (let ((socks-server '("server" "127.0.0.1" 10081 5)) + (let ((socks-server '("server" "127.0.0.1" t 5)) (socks-username "foo") ; defaults to (user-login-name) (socks-password "") ; simulate user hitting enter when prompted (url-user-agent "Test/auth-user-pass-blank") @@ -264,9 +268,9 @@ socks-tests-v5-auth-user-pass-blank ;; against curl 7.71 with the following options: ;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com -(ert-deftest socks-tests-v5-auth-none () +(defun socks-tests-v5-auth-none (method) "Verify correct handling of SOCKS5 when auth method 0 requested." - (let ((socks-server '("server" "127.0.0.1" 10082 5)) + (let ((socks-server '("server" "127.0.0.1" t 5)) (socks-authentication-methods (append socks-authentication-methods nil)) (url-user-agent "Test/auth-none") @@ -278,7 +282,24 @@ socks-tests-v5-auth-none (socks-unregister-authentication-method 2) (should-not (assq 2 socks-authentication-methods)) (ert-info ("Make HTTP request over SOCKS5 with no auth method") - (socks-tests-perform-hello-world-http-request))) + (socks-tests-perform-hello-world-http-request method))) (should (assq 2 socks-authentication-methods))) +(ert-deftest socks-tests-v5-auth-none () + (socks-tests-v5-auth-none 'socks)) + +;; This simulates the top-level advice around `open-network-stream' +;; that's applied when loading the library with a non-nil +;; `socks-override-functions'. +(ert-deftest socks-override-functions () + (should-not socks-override-functions) + (should-not (advice-member-p #'socks--open-network-stream + 'open-network-stream)) + (advice-add 'open-network-stream :around #'socks--open-network-stream) + (unwind-protect (let ((socks-override-functions t)) + (socks-tests-v5-auth-none 'native)) + (advice-remove 'open-network-stream #'socks--open-network-stream)) + (should-not (advice-member-p #'socks--open-network-stream + 'open-network-stream))) + ;;; socks-tests.el ends here commit e93d99a4a0ce578249304dce350465c580a49892 Author: João Távora Date: Wed Oct 18 05:48:49 2023 -0500 Eglot: respect completion sort order dictated by the server Don't use flex style to do any completion sorting. Previously, it was thought that the 'flex' completion style was only kicking in to do (approximate) fontification of the completions returned by the server, but it was found that it was also doing some its own sorting in certain situation of non-empty matching patterns. Replaced it with a new eglot--dumb-flex style which does only fontification. Github-reference: https://github.com/joaotavora/eglot/discussions/1306 * lisp/progmodes/eglot.el (eglot-completion-at-point): Rework. (eglot--dumb-flex, eglot--dumb-allc): New helpers. (completion-category-defaults): Rework Eglot-specific category. (completion-styles-alist): Add Eglot-specific style. * etc/EGLOT-NEWS: Mention change. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index f5f78ccd483..2f54dc43cbf 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -43,6 +43,12 @@ For 'newline' commands, Eglot sometimes sent the wrong character code to the server. Also made this feature less chatty in the mode-line and messages buffer. +** Fixed completion sorting + +In some situations, Eglot was not respecting the completion sort order +decided by the language server, falling back on the sort order +determined by the 'flex' completion style instead. See github#1306. + ** Improve mouse invocation of code actions When invoking code actions by middle clicking with the mouse on diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index e511df01850..7d83bcdd7ac 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -504,10 +504,6 @@ eglot-withhold-process-id "If non-nil, Eglot will not send the Emacs process id to the language server. This can be useful when using docker to run a language server.") -;; Customizable via `completion-category-overrides'. -(when (assoc 'flex completion-styles-alist) - (add-to-list 'completion-category-defaults '(eglot (styles flex basic)))) - ;;; Constants ;;; @@ -3036,11 +3032,32 @@ eglot--capf-session (defun eglot--capf-session-flush (&optional _) (setq eglot--capf-session :none)) +(defun eglot--dumb-flex (pat comp ignorecase) + "Return destructively fontified COMP iff PAT matches it." + (cl-loop with lcomp = (length comp) + with case-fold-search = ignorecase + initially (remove-list-of-text-properties 0 lcomp '(face) comp) + for x across pat + for i = (cl-loop for j from (if i (1+ i) 0) below lcomp + when (char-equal x (aref comp j)) return j) + unless i do (cl-return nil) + ;; FIXME: could do much better here and coalesce intervals + do (add-face-text-property i (1+ i) 'completions-common-part + nil comp) + finally (cl-return comp))) + +(defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t)) + +(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)) + (defun eglot-completion-at-point () "Eglot's `completion-at-point' function." ;; Commit logs for this function help understand what's going on. (when-let (completion-capability (eglot-server-capable :completionProvider)) (let* ((server (eglot--current-server-or-lose)) + (bounds (or (bounds-of-thing-at-point 'symbol) + (cons (point) (point)))) (sort-completions (lambda (completions) (cl-sort completions @@ -3049,10 +3066,9 @@ eglot-completion-at-point (plist-get (get-text-property 0 'eglot--lsp-item c) :sortText))))) - (metadata `(metadata (category . eglot) + (metadata `(metadata (category . eglot-capf) (display-sort-function . ,sort-completions))) (local-cache :none) - (bounds (bounds-of-thing-at-point 'symbol)) (orig-pos (point)) (resolved (make-hash-table)) (proxies @@ -3068,9 +3084,7 @@ eglot-completion-at-point (cachep (and (listp resp) items eglot-cache-session-completions (eq (plist-get resp :isIncomplete) :json-false))) - (bounds (or bounds - (cons (point) (point)))) - (proxies + (retval (mapcar (jsonrpc-lambda (&rest item &key label insertText insertTextFormat @@ -3093,8 +3107,8 @@ eglot-completion-at-point items))) ;; (trace-values "Requested" (length proxies) cachep bounds) (setq eglot--capf-session - (if cachep (list bounds proxies resolved orig-pos) :none)) - (setq local-cache proxies))))) + (if cachep (list bounds retval resolved orig-pos) :none)) + (setq local-cache retval))))) (resolve-maybe ;; Maybe completion/resolve JSON object `lsp-comp' into ;; another JSON object, if at all possible. Otherwise, @@ -3108,7 +3122,6 @@ eglot-completion-at-point (eglot--request server :completionItem/resolve lsp-comp :cancel-on-input t) lsp-comp)))))) - (unless bounds (setq bounds (cons (point) (point)))) (when (and (consp eglot--capf-session) (= (car bounds) (car (nth 0 eglot--capf-session))) (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) @@ -3120,24 +3133,26 @@ eglot-completion-at-point (list (car bounds) (cdr bounds) - (lambda (probe pred action) + (lambda (pattern pred action) (cond ((eq action 'metadata) metadata) ; metadata ((eq action 'lambda) ; test-completion - (test-completion probe (funcall proxies))) + (test-completion pattern (funcall proxies))) ((eq (car-safe action) 'boundaries) nil) ; boundaries ((null action) ; try-completion - (try-completion probe (funcall proxies))) + (try-completion pattern (funcall proxies))) ((eq action t) ; all-completions - (all-completions - "" - (funcall proxies) - (lambda (proxy) - (let* ((item (get-text-property 0 'eglot--lsp-item proxy)) - (filterText (plist-get item :filterText))) - (and (or (null pred) (funcall pred proxy)) - (string-prefix-p - probe (or filterText proxy) completion-ignore-case)))))))) + (let ((comps (funcall proxies))) + (dolist (c comps) (eglot--dumb-flex pattern c t)) + (all-completions + "" + comps + (lambda (proxy) + (let* ((item (get-text-property 0 'eglot--lsp-item proxy)) + (filterText (plist-get item :filterText))) + (and (or (null pred) (funcall pred proxy)) + (eglot--dumb-flex + pattern (or filterText proxy) completion-ignore-case))))))))) :annotation-function (lambda (proxy) (eglot--dbind ((CompletionItem) detail kind) commit 06fc5c24170b820939d3d51071b2957354edcb65 Author: Po Lu Date: Wed Oct 18 13:52:19 2023 +0800 Correctly bisect format 12 and 8 cmap tables * src/sfnt.c (sfnt_bsearch_above): Cease returning the last element if it is ordered below the key itself. (sfnt_lookup_glyph_8, sfnt_lookup_glyph_12): Verify whether the group returned is NULL. diff --git a/src/sfnt.c b/src/sfnt.c index 360b0cd2d4d..0648e12150c 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -1122,8 +1122,8 @@ sfnt_lookup_glyph_2 (sfnt_char character, : 0); } -/* Like `bsearch'. However, return the highest element above KEY if - it could not be found. */ +/* Like `bsearch', but return the element ordered exactly above KEY if + one exists and KEY itself cannot be located. */ static void * sfnt_bsearch_above (const void *key, const void *base, @@ -1146,12 +1146,18 @@ sfnt_bsearch_above (const void *key, const void *base, mid = low + (high - low) / 2; sample = bytes + mid * size; - if (compar (key, sample) > 0) + if ((*compar) (key, sample) > 0) low = mid + 1; else high = mid; } + sample = bytes + low * size; + + if (low == nmemb - 1 + && (*compar) (key, sample) > 0) + return NULL; + return (unsigned char *) bytes + low * size; } @@ -1287,7 +1293,7 @@ sfnt_lookup_glyph_8 (sfnt_char character, sizeof format8->groups[0], sfnt_compare_char); - if (group->start_char_code > character) + if (!group || group->start_char_code > character) /* No glyph matches this group. */ return 0; @@ -1336,7 +1342,7 @@ sfnt_lookup_glyph_12 (sfnt_char character, sizeof format12->groups[0], sfnt_compare_char); - if (group->start_char_code > character) + if (!group || group->start_char_code > character) /* No glyph matches this group. */ return 0; commit 516b490bb4fbc1828a50fd81e397f3feb614d0ad Author: Po Lu Date: Wed Oct 18 09:09:47 2023 +0800 Mollify compiler under Android builds without mmap * src/sfntfont.c (sfnt_close_tables, sfnt_open_tables) [!HAVE_MMAP]: Do not declare rc for munmap or mmap. diff --git a/src/sfntfont.c b/src/sfntfont.c index 3506742a92b..2c58de31a16 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -2784,7 +2784,9 @@ sfntfont_setup_interpreter (struct sfnt_font_info *info, static void sfnt_close_tables (struct sfnt_font_tables *tables) { +#ifdef HAVE_MMAP int rc; +#endif /* HAVE_MMAP */ xfree (tables->cmap); xfree (tables->hhea); @@ -2839,7 +2841,10 @@ sfnt_open_tables (struct sfnt_font_desc *desc) { struct sfnt_font_tables *tables; struct sfnt_offset_subtable *subtable; - int fd, i, rc; + int fd, i; +#ifdef HAVE_MMAP + int rc; +#endif /* HAVE_MMAP */ struct sfnt_cmap_encoding_subtable *subtables; struct sfnt_cmap_encoding_subtable_data **data; struct sfnt_cmap_format_14 *format14; commit 6254b23a38788e989e835b77071409dfdf2ec1a1 Author: Jim Porter Date: Tue Oct 17 11:59:13 2023 -0700 ; * lisp/eshell/esh-proc.el (eshell-process-wait-time): Add :version. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 639f4888eb0..3c946c22bdc 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -42,6 +42,7 @@ eshell-proc-load-hook (defcustom eshell-process-wait-time 0.05 "The number of seconds to delay waiting for a synchronous process." + :version "30.1" :type 'number) (defcustom eshell-process-wait-seconds 0 commit 40c9e9d2e6aa19e96572c8e9dd7119290be6a004 Author: Gerd Möllmann Date: Mon Oct 16 13:54:02 2023 +0200 Gud lldb support (bug#66575) * lisp/progmodes/gud.el (lldb): New command. * etc/NEWS: Mention M-x lldb. * src/.lldbinit: Show no souece lines on stop. * doc/emacs/building.texi: Mention LLDB. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 2a98bffdc2d..a2639ce6d3e 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -567,7 +567,7 @@ Debuggers The GUD (Grand Unified Debugger) library provides an Emacs interface to a wide variety of symbolic debuggers. It can run the GNU Debugger -(GDB), as well as DBX, SDB, XDB, Guile REPL debug commands, Perl's +(GDB), as well as LLDB, DBX, SDB, XDB, Guile REPL debug commands, Perl's debugging mode, the Python debugger PDB, and the Java Debugger JDB. Emacs provides a special interface to GDB, which uses extra Emacs @@ -609,6 +609,10 @@ Starting GUD The other commands in this list do the same, for other debugger programs. +@item M-x lldb +@findex lldb +Run the LLDB debugger. + @item M-x perldb @findex perldb Run the Perl interpreter in debug mode. diff --git a/etc/NEWS b/etc/NEWS index 02b794a2964..c8c37f43284 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -283,6 +283,15 @@ functions in CJK locales. * Changes in Specialized Modes and Packages in Emacs 30.1 ++++ +** New command 'lldb'. +Run the LLDB debugger, analogous to the 'gud-gdb' command. Note that +you might want to add these settings to your .lldbinit file, to reduce +the output in the LLDB output when stepping through source files. + + settings set stop-line-count-before 0 + settings set stop-line-count-after 0 + ** gdb-mi --- diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d4b954a7203..ea5a3580629 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -80,7 +80,7 @@ hl-line-sticky-flag (defgroup gud nil "The \"Grand Unified Debugger\" interface. -Supported debuggers include gdb, sdb, dbx, xdb, perldb, +Supported debuggers include gdb, lldb, sdb, dbx, xdb, perldb, pdb (Python), and jdb." :group 'processes :group 'tools) @@ -173,13 +173,13 @@ gud-text-menu-bar-map "" `(,(propertize "next" 'face 'font-lock-doc-face) . gud-next) "" `(menu-item ,(propertize "until" 'face 'font-lock-doc-face) gud-until - :visible (memq gud-minor-mode '(gdbmi gdb perldb))) + :visible (memq gud-minor-mode '(gdbmi gdb lldb perldb))) "" `(menu-item ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont :visible (not (eq gud-minor-mode 'gdbmi))) "" `(menu-item ,(propertize "run" 'face 'font-lock-doc-face) gud-run - :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) + :visible (memq gud-minor-mode '(gdbmi gdb lldb dbx jdb))) "" `(menu-bar-item ,(propertize " go " 'face 'font-lock-doc-face) gud-go :visible (and (eq gud-minor-mode 'gdbmi) @@ -231,13 +231,13 @@ gud-menu-map :enable (not gud-running)] ["Next Instruction" gud-nexti :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb dbx))] + :visible (memq gud-minor-mode '(gdbmi gdb lldb dbx))] ["Step Instruction" gud-stepi :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb dbx))] + :visible (memq gud-minor-mode '(gdbmi gdb lldb dbx))] ["Finish Function" gud-finish :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb guiler xdb jdb pdb))] + :visible (memq gud-minor-mode '(gdbmi gdb lldb guiler xdb jdb pdb))] ["Watch Expression" gud-watch :enable (not gud-running) :visible (eq gud-minor-mode 'gdbmi)] @@ -248,7 +248,7 @@ gud-menu-map "Dump object" "Print Dereference") :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb jdb))] + :visible (memq gud-minor-mode '(gdbmi gdb lldb jdb))] ["Print S-expression" gud-pp :enable (and (not gud-running) (bound-and-true-p gdb-active-process)) @@ -259,23 +259,23 @@ gud-menu-map (eq gud-minor-mode 'gdbmi))] ["Down Stack" gud-down :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb guiler dbx xdb jdb pdb))] + :visible (memq gud-minor-mode '(gdbmi gdb lldb guiler dbx xdb jdb pdb))] ["Up Stack" gud-up :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdb guiler dbx xdb jdb pdb))] + '(gdbmi gdb lldb guiler dbx xdb jdb pdb))] ["Set Breakpoint" gud-break :enable (or (not gud-running) gud-async-running) :visible (gud-tool-bar-item-visible-no-fringe)] ["Temporary Breakpoint" gud-tbreak :enable (or (not gud-running) gud-async-running) - :visible (memq gud-minor-mode '(gdbmi gdb sdb xdb))] + :visible (memq gud-minor-mode '(gdbmi gdb lldb sdb xdb))] ["Remove Breakpoint" gud-remove :enable (or (not gud-running) gud-async-running) :visible (gud-tool-bar-item-visible-no-fringe)] ["Continue to selection" gud-until :enable (not gud-running) - :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) + :visible (and (memq gud-minor-mode '(gdbmi gdb lldb perldb)) (gud-tool-bar-item-visible-no-fringe))] ["Stop" gud-stop-subjob :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) @@ -288,7 +288,7 @@ gud-menu-map (gdb-show-run-p))] ["Run" gud-run :enable (or (not gud-running) gud-async-running) - :visible (or (memq gud-minor-mode '(gdb dbx jdb)) + :visible (or (memq gud-minor-mode '(gdb lldb dbx jdb)) (and (eq gud-minor-mode 'gdbmi) (or (not (gdb-show-run-p)) (bound-and-true-p @@ -299,7 +299,7 @@ gud-menu-map (display-graphic-p) (fboundp 'x-show-tip)) :visible (memq gud-minor-mode - '(gdbmi guiler dbx sdb xdb pdb)) + '(gdbmi lldb guiler dbx sdb xdb pdb)) :button (:toggle . gud-tooltip-mode)] ["Info (debugger)" gud-goto-info])) @@ -973,6 +973,7 @@ gud-gdb-fetch-lines-filter (setq gud-gdb-fetch-lines-string string) ""))) + ;; gdb speedbar functions ;; Part of the macro expansion of dframe-with-attached-buffer. @@ -2702,10 +2703,12 @@ gud-delete-prompt-marker (define-derived-mode gud-mode comint-mode "Debugger" "Major mode for interacting with an inferior debugger process. - You start it up with one of the commands \\[gdb], \\[sdb], \\[dbx], -\\[perldb], \\[xdb], or \\[jdb]. Each entry point finishes by executing a -hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook', -`perldb-mode-hook', `xdb-mode-hook', or `jdb-mode-hook' respectively. + You start it up with one of the commands \\[gdb], \\[lldb], +\\[sdb], \\[dbx], \\[perldb], \\[xdb], or \\[jdb]. Each entry +point finishes by executing a hook; `gdb-mode-hook', +`lldb-mode-hook' `sdb-mode-hook', `dbx-mode-hook', +`perldb-mode-hook', `xdb-mode-hook', or `jdb-mode-hook' +respectively. After startup, the following commands are available in both the GUD interaction buffer and any source buffer GUD visits due to a breakpoint stop @@ -2735,11 +2738,11 @@ gud-mode except that the breakpoint is temporary; that is, it is removed when execution stops on it. -Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack -frame. \\[gud-down] drops back down through one. +Under gdb, lldb, dbx, and xdb, \\[gud-up] pops up through an +enclosing stack frame. \\[gud-down] drops back down through one. -If you are using gdb or xdb, \\[gud-finish] runs execution to the return from -the current function and stops. +If you are using gdb, lldb, or xdb, \\[gud-finish] runs execution +to the return from the current function and stops. All the keystrokes above are accessible in the GUD buffer with the prefix C-c, and in all buffers through the prefix C-x C-a. @@ -3767,13 +3770,17 @@ gud-tooltip-dereference ; gdb-mi.el gets around this problem. (defun gud-tooltip-process-output (process output) "Process debugger output and show it in a tooltip window." - (remove-function (process-filter process) #'gud-tooltip-process-output) - (tooltip-show (tooltip-strip-prompt process output) - (or gud-tooltip-echo-area (not tooltip-mode)))) + ;; First line is the print command itself. + (unless (string-search (gud-tooltip-print-command "") output) + (remove-function (process-filter process) + #'gud-tooltip-process-output) + (tooltip-show (tooltip-strip-prompt process output) + (or gud-tooltip-echo-area (not tooltip-mode))))) (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." (pcase gud-minor-mode + ('lldb (format "dwim-print -- %s" expr)) ('gdbmi (concat "-data-evaluate-expression \"" expr "\"")) ('guiler expr) ('dbx (concat "print " expr)) @@ -3835,11 +3842,150 @@ gud-tooltip-tips (gdb-input (concat cmd "\n") (lambda () (gdb-tooltip-print expr)))) + ;; Not gdbmi. (add-function :override (process-filter process) #'gud-tooltip-process-output) (gud-basic-call cmd)) expr)))))))) + +;; 'gud-lldb-history' and 'gud-gud-lldb-command-name' are required +;; because gud-symbol uses their values if they are present. Their +;; names are deduced from the minor-mode name. +(defvar gud-lldb-history nil) + +(defcustom gud-gud-lldb-command-name "lldb" + "Default command to run an executable under LLDB in text command mode." + :type 'string) + +(defun gud-lldb-marker-filter (string) + "Deduce interesting stuff from output STRING." + (cond (;; Process 72668 stopped + ;; * thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 1.1 + ;; frame #0: ...) at emacs.c:1310:9 [opt] + (string-match (rx (and line-start (0+ blank) "frame" + (0+ not-newline) " at " + (group (1+ (not ":"))) + ":" + (group (1+ digit)))) + string) + (setq gud-last-frame + (cons (match-string 1 string) + (string-to-number (match-string 2 string))))) + (;; Process 72874 exited with status = 9 (0x00000009) killed + (string-match (rx "Process " (1+ digit) " exited with status") + string) + (setq gud-last-last-frame nil) + (setq gud-overlay-arrow-position nil))) + string) + +;;;###autoload +(defun lldb (command-line) + "Run lldb passing it COMMAND-LINE as arguments. +If COMMAND-LINE names a program FILE to debug, lldb will run in +a buffer named *gud-FILE*, and the directory containing FILE +becomes the initial working directory and source-file directory +for your debugger. If you don't want `default-directory' to +change to the directory of FILE, specify FILE without leading +directories, in which case FILE should reside either in the +directory of the buffer from which this command is invoked, or +it can be found by searching PATH. + +If COMMAND-LINE requests that lldb attaches to a process PID, lldb +will run in *gud-PID*, otherwise it will run in *gud*; in these +cases the initial working directory is the `default-directory' of +the buffer in which this command was invoked." + (interactive (list (gud-query-cmdline 'lldb))) + + (when (and gud-comint-buffer + (buffer-name gud-comint-buffer) + (get-buffer-process gud-comint-buffer) + (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gud-lldb))) + (gdb-restore-windows) + ;; FIXME: Copied from gud-gdb, but what does that even say? + (error "Multiple debugging requires restarting in text command mode")) + + (gud-common-init command-line nil 'gud-lldb-marker-filter) + (setq-local gud-minor-mode 'lldb) + + (gud-def gud-break + "breakpoint set --joint-specifier %f:%l" + "\C-b" + "Set breakpoint at current line.") + (gud-def gud-tbreak + "_regexp-break %f:%l" + "\C-t" + "Set temporary breakpoint at current line.") + (gud-def gud-remove + "breakpoint clear --line %l --file %f" + "\C-d" + "Remove breakpoint at current line") + (gud-def gud-step "thread step-in --count %p" + "\C-s" + "Step one source line with display.") + (gud-def gud-stepi + "thread step-inst --count %p" + "\C-i" + "Step one instruction with display.") + (gud-def gud-next + "thread step-over --count %p" + "\C-n" + "Step one line (skip functions).") + (gud-def gud-nexti + "thread step-inst-over --count %p" + nil + "Step one instruction (skip functions).") + (gud-def gud-cont + "process continue --ignore-count %p" + "\C-r" + "Continue with display.") + (gud-def gud-finish + "thread step-out" + "\C-f" + "Finish executing current function.") + (gud-def gud-jump + (progn + (gud-call "_regexp-break %f:%l" arg) + (gud-call "_regexp-jump %f:%l")) + "\C-j" + "Set execution address to current line.") + (gud-def gud-up + "_regexp-up %p" + "<" + "Up N stack frames (numeric arg).") + (gud-def gud-down + "_regexp-down %p" + ">" + "Down N stack frames (numeric arg).") + (gud-def gud-print + "dwim-print %e" + "\C-p" + "Evaluate C expression at point.") + (gud-def gud-pstar + "dwim-print *%e" + nil + "Evaluate C dereferenced pointer expression at point.") + (gud-def gud-pv + "xprint %e" + "\C-v" + "Print value of lisp variable (for debugging Emacs only).") + (gud-def gud-until + "thread until %l" + "\C-u" + "Continue to current line.") + (gud-def gud-run + ;; Extension for process launch --tty? + "process launch -X true" + nil + "Run the program.") + + (gud-set-repeat-map-property 'gud-gdb-repeat-map) + (setq comint-prompt-regexp (rx line-start "(lldb)" (0+ blank))) + (setq paragraph-start comint-prompt-regexp) + (setq gud-running nil) + (setq gud-filter-pending-text nil) + (run-hooks 'lldb-mode-hook)) + (provide 'gud) ;;; gud.el ends here diff --git a/src/.lldbinit b/src/.lldbinit index a5789f49122..430c48f91f0 100644 --- a/src/.lldbinit +++ b/src/.lldbinit @@ -33,4 +33,8 @@ command script import emacs_lldb # Print with children provider, depth 2. command alias xprint frame variable -P 2 +# This is for M-x lldb: don't show source lines when stopping. +settings set stop-line-count-before 0 +settings set stop-line-count-after 0 + # end. commit 47adea3a902077d97f586257768f8540800d1a29 Author: Gerd Möllmann Date: Tue Oct 17 17:23:33 2023 +0200 Modify LLDB command xcomplete to return a Lisp list * etc/emacs_lldb.py (xcomplete): Return a Lisp list. Add a comment explaining the return value. diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index a4f066b79de..f2c7a7987c7 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -203,14 +203,34 @@ def xdebug_print(debugger, command, result, internal_dict): """Print Lisp_Objects using safe_debug_print()""" debugger.HandleCommand(f"expr safe_debug_print({command})") +# According to SBCommanInterpreter.cpp, the return value of +# HandleCompletions is as follows: +# +# Index 1 to the end contain all the completions. +# +# At index 0: +# +# If all completions have a common prefix, this is the shortest +# completion, with the common prefix removed from it. +# +# If it is the completion for a whole word, a space is added at the +# end. +# +# So, the prefix is what could be added to make the command partially +# complete. +# +# If there is no common prefix, index 0 has an empty string "". + def xcomplete(debugger, command, result, internal_dict): """Print completions for COMMAND.""" interpreter = debugger.GetCommandInterpreter() string_list = lldb.SBStringList() interpreter.HandleCompletion(command, len(command), len(command), -1, string_list) + list = "" for i in range(string_list.GetSize()): - result.AppendMessage(string_list.GetStringAtIndex(i)) + list += '"' + string_list.GetStringAtIndex(i) + '" ' + result.AppendMessage("(" + list + ")") ######################################################################## commit 8181563f8cbd203d1a1b08695e4ba647e63e7bb0 Author: Michael Albinus Date: Tue Oct 17 11:41:12 2023 +0200 Fix tramp-revert-buffer-with-sudo * lisp/net/tramp-cmds.el (tramp-revert-buffer-with-sudo): Use `buffer-file-name' instead of `buffer-name'. (Bug#66571) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 22fb7eee8f3..f56c93c370d 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -610,7 +610,7 @@ tramp-revert-buffer-with-sudo (interactive) (cond ((buffer-file-name) - (find-alternate-file (tramp-file-name-with-sudo (buffer-name)))) + (find-alternate-file (tramp-file-name-with-sudo (buffer-file-name)))) ((tramp-dired-buffer-p) (dired-unadvertise (expand-file-name default-directory)) (setq default-directory (tramp-file-name-with-sudo default-directory) commit d9e1605122b4ba70a55f7b168505b7d7f8d2bdd6 Author: Po Lu Date: Tue Oct 17 08:33:25 2023 +0800 Correctly register focus events concomitant with alpha changes * src/xterm.c (x_frame_highlight, x_frame_unhighlight): Skip changing the frame alpha when the frame is not eligible for focus state-specific alpha values; otherwise, the alpha might be reset by the time a alpha change wrought by a focus change arrives, impeding handle_one_xevent from subsequently restoring the initial value. (bug#66398) diff --git a/src/xterm.c b/src/xterm.c index 709705fc19e..6f335ea11da 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11487,7 +11487,9 @@ x_frame_highlight (struct frame *f) x_stop_ignoring_errors (dpyinfo); unblock_input (); gui_update_cursor (f, true); - x_set_frame_alpha (f); + + if (!FRAME_X_OUTPUT (f)->alpha_identical_p) + x_set_frame_alpha (f); } static void @@ -11511,7 +11513,15 @@ x_frame_unhighlight (struct frame *f) unblock_input (); gui_update_cursor (f, true); - x_set_frame_alpha (f); + + /* Eschew modifying the frame alpha when the alpha values for + focused and background frames are identical; otherwise, this will + upset the order in which changes to the alpha property + immediately subsequent to a focus change are propagated into a + frame's alpha property. (bug#66398) */ + + if (!FRAME_X_OUTPUT (f)->alpha_identical_p) + x_set_frame_alpha (f); } /* The focus has changed. Update the frames as necessary to reflect commit 0d536f27557843d0652267bc6c20bc1357f716a4 Author: Spencer Baugh Date: Fri Oct 13 08:35:58 2023 -0400 Use project-name in the project-kill-buffers prompt This is mildly prettier (bug#66518). * lisp/progmodes/project.el (project-kill-buffers): Use project-name. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index fd9c146a1fd..b9ecb770e60 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1620,7 +1620,7 @@ project-kill-buffers (yes-or-no-p (format "Kill %d buffers in %s? " (length bufs) - (project-root pr)))))) + (project-name pr)))))) (cond (no-confirm (mapc #'kill-buffer bufs)) ((null bufs) commit 0f9c3284c6008e2404aa0520837278ed08df910b Author: Jim Porter Date: Mon Oct 16 13:34:22 2023 -0700 ; 'eshell-kill-process-wait-time' can be a floating-point number * lisp/eshell/esh-proc.el (eshell-kill-process-wait-time): Update type. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index a91e0a16825..639f4888eb0 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -586,7 +586,7 @@ eshell-process-interact (defcustom eshell-kill-process-wait-time 5 "Seconds to wait between sending termination signals to a subprocess." - :type 'integer) + :type 'number) (defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL) "Signals used to kill processes when an Eshell buffer exits. commit 266ed1b847771bfb6c7fc974c53d820059b6e31d Author: Jim Porter Date: Mon Oct 16 13:21:07 2023 -0700 ; Use the "new" calling convention for 'sit-for' in Eshell * lisp/eshell/esh-proc.el (eshell-process-wait-seconds) (eshell-process-wait-milliseconds): Make obsolete in favor of... (eshell-process-wait-time): ... this, and... (eshell-wait-for-process): ... use it. * etc/NEWS: Announce this change (bug#66574). diff --git a/etc/NEWS b/etc/NEWS index 3bd47a0112b..02b794a2964 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1025,6 +1025,10 @@ Use 'define-minor-mode' and 'define-globalized-minor-mode' instead. ** The obsolete calling convention of 'sit-for' has been removed. That convention was: (sit-for SECONDS MILLISEC &optional NODISP) +** 'eshell-process-wait-{seconds,milliseconds}' options are now obsolete. +Instead, use 'eshell-process-wait-time', which supports floating-point +values. + * Lisp Changes in Emacs 30.1 diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index bc3776259a7..a91e0a16825 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -40,13 +40,21 @@ eshell-proc-load-hook :version "24.1" ; removed eshell-proc-initialize :type 'hook) +(defcustom eshell-process-wait-time 0.05 + "The number of seconds to delay waiting for a synchronous process." + :type 'number) + (defcustom eshell-process-wait-seconds 0 "The number of seconds to delay waiting for a synchronous process." :type 'integer) +(make-obsolete-variable 'eshell-process-wait-seconds + 'eshell-process-wait-time "30.1") (defcustom eshell-process-wait-milliseconds 50 "The number of milliseconds to delay waiting for a synchronous process." :type 'integer) +(make-obsolete-variable 'eshell-process-wait-milliseconds + 'eshell-process-wait-time "30.1") (defcustom eshell-done-messages-in-minibuffer t "If non-nil, subjob \"Done\" messages will display in minibuffer." @@ -171,8 +179,7 @@ eshell-wait-for-process (while (eshell-process-active-p proc) (when (input-pending-p) (discard-input)) - (sit-for eshell-process-wait-seconds - eshell-process-wait-milliseconds))))) + (sit-for eshell-process-wait-time))))) (defalias 'eshell/wait #'eshell-wait-for-process) commit 5827d179fb71e6fdcc63a17eb50305545ede2f37 Author: Juri Linkov Date: Mon Oct 16 20:14:18 2023 +0300 Refactor 'vc-default-mode-line-string' (bug#66464) * lisp/vc/vc-hooks.el (vc-mode-line-state): New function with code moved from 'vc-default-mode-line-string'. (vc-default-mode-line-string): Use 'vc-mode-line-state'. * lisp/vc/vc-git.el (vc-git-mode-line-string): Use 'vc-mode-line-state' instead of hacking the string returned from 'vc-default-mode-line-string'. * lisp/vc/vc-hg.el (vc-hg-mode-line-string): Use 'vc-mode-line-state' instead of duplicating code from 'vc-default-mode-line-string'. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 5c21a5b884e..9ec45c59893 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -416,15 +416,18 @@ vc-git--symbolic-ref (defun vc-git-mode-line-string (file) "Return a string for `vc-mode-line' to put in the mode line for FILE." - (let* ((rev (vc-working-revision file 'Git)) - (disp-rev (or (vc-git--symbolic-ref file) - (and rev (substring rev 0 7)))) - (def-ml (vc-default-mode-line-string 'Git file)) - (help-echo (get-text-property 0 'help-echo def-ml)) - (face (get-text-property 0 'face def-ml))) - (propertize (concat (substring def-ml 0 4) disp-rev) - 'face face - 'help-echo (concat help-echo "\nCurrent revision: " rev)))) + (pcase-let* ((backend-name "Git") + (state (vc-state file)) + (`(,state-echo ,face ,indicator) + (vc-mode-line-state state)) + (rev (vc-working-revision file 'Git)) + (disp-rev (or (vc-git--symbolic-ref file) + (and rev (substring rev 0 7)))) + (state-string (concat backend-name indicator disp-rev))) + (propertize state-string 'face face 'help-echo + (concat state-echo " under the " backend-name + " version control system" + "\nCurrent revision: " rev)))) (cl-defstruct (vc-git-extra-fileinfo (:copier nil) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index f2ee9ef35e4..89b2814a0a3 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -352,47 +352,22 @@ vc-hg--symbolic-revision (defun vc-hg-mode-line-string (file) "Hg-specific version of `vc-mode-line-string'." - (let* ((backend-name "Hg") - (truename (file-truename file)) - (state (vc-state truename)) - (state-echo nil) - (face nil) - (rev (and state - (let ((default-directory - (expand-file-name (vc-hg-root truename)))) - (vc-hg--symbolic-revision - "." - (and vc-hg-use-file-version-for-mode-line-version - truename))))) - (rev (or rev "???"))) - (propertize - (cond ((or (eq state 'up-to-date) - (eq state 'needs-update)) - (setq state-echo "Up to date file") - (setq face 'vc-up-to-date-state) - (concat backend-name "-" rev)) - ((eq state 'added) - (setq state-echo "Locally added file") - (setq face 'vc-locally-added-state) - (concat backend-name "@" rev)) - ((eq state 'conflict) - (setq state-echo "File contains conflicts after the last merge") - (setq face 'vc-conflict-state) - (concat backend-name "!" rev)) - ((eq state 'removed) - (setq state-echo "File removed from the VC system") - (setq face 'vc-removed-state) - (concat backend-name "!" rev)) - ((eq state 'missing) - (setq state-echo "File tracked by the VC system, but missing from the file system") - (setq face 'vc-missing-state) - (concat backend-name "?" rev)) - (t - (setq state-echo "Locally modified file") - (setq face 'vc-edited-state) - (concat backend-name ":" rev))) - 'face face - 'help-echo (concat state-echo " under the " backend-name + (pcase-let* ((backend-name "Hg") + (truename (file-truename file)) + (state (vc-state truename)) + (`(,state-echo ,face ,indicator) + (vc-mode-line-state state)) + (rev (and state + (let ((default-directory + (expand-file-name (vc-hg-root truename)))) + (vc-hg--symbolic-revision + "." + (and vc-hg-use-file-version-for-mode-line-version + truename))))) + (rev (or rev "???")) + (state-string (concat backend-name indicator rev))) + (propertize state-string 'face face 'help-echo + (concat state-echo " under the " backend-name " version control system")))) ;;; History functions diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index a4de0a6e791..c16fb63b2ff 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -705,6 +705,50 @@ vc-mode-line (force-mode-line-update) backend) +(defun vc-mode-line-state (state) + "Return a list of data to display on the mode line. +The argument STATE should contain the version control state returned +from `vc-state'. The returned list includes three elements: the echo +string, the face name, and the indicator that usually is one character." + (let (state-echo face indicator) + (cond ((or (eq state 'up-to-date) + (eq state 'needs-update)) + (setq state-echo "Up to date file") + (setq face 'vc-up-to-date-state) + (setq indicator "-")) + ((stringp state) + (setq state-echo (concat "File locked by" state)) + (setq face 'vc-locked-state) + (setq indicator (concat ":" state ":"))) + ((eq state 'added) + (setq state-echo "Locally added file") + (setq face 'vc-locally-added-state) + (setq indicator "@")) + ((eq state 'conflict) + (setq state-echo "File contains conflicts after the last merge") + (setq face 'vc-conflict-state) + (setq indicator "!")) + ((eq state 'removed) + (setq state-echo "File removed from the VC system") + (setq face 'vc-removed-state) + (setq indicator "!")) + ((eq state 'missing) + (setq state-echo "File tracked by the VC system, but missing from the file system") + (setq face 'vc-missing-state) + (setq indicator "?")) + ((eq state 'ignored) + (setq state-echo "File tracked by the VC system, but ignored") + (setq face 'vc-ignored-state) + (setq indicator "!")) + (t + ;; Not just for the 'edited state, but also a fallback + ;; for all other states. Think about different symbols + ;; for 'needs-update and 'needs-merge. + (setq state-echo "Locally modified file") + (setq face 'vc-edited-state) + (setq indicator ":"))) + (list state-echo face indicator))) + (defun vc-default-mode-line-string (backend file) "Return a string for `vc-mode-line' to put in the mode line for FILE. Format: @@ -717,51 +761,15 @@ vc-default-mode-line-string \"BACKEND?REV\" if the file is under VC, but is missing This function assumes that the file is registered." - (let* ((backend-name (symbol-name backend)) - (state (vc-state file backend)) - (state-echo nil) - (face nil) - (rev (vc-working-revision file backend))) - (propertize - (cond ((or (eq state 'up-to-date) - (eq state 'needs-update)) - (setq state-echo "Up to date file") - (setq face 'vc-up-to-date-state) - (concat backend-name "-" rev)) - ((stringp state) - (setq state-echo (concat "File locked by" state)) - (setq face 'vc-locked-state) - (concat backend-name ":" state ":" rev)) - ((eq state 'added) - (setq state-echo "Locally added file") - (setq face 'vc-locally-added-state) - (concat backend-name "@" rev)) - ((eq state 'conflict) - (setq state-echo "File contains conflicts after the last merge") - (setq face 'vc-conflict-state) - (concat backend-name "!" rev)) - ((eq state 'removed) - (setq state-echo "File removed from the VC system") - (setq face 'vc-removed-state) - (concat backend-name "!" rev)) - ((eq state 'missing) - (setq state-echo "File tracked by the VC system, but missing from the file system") - (setq face 'vc-missing-state) - (concat backend-name "?" rev)) - ((eq state 'ignored) - (setq state-echo "File tracked by the VC system, but ignored") - (setq face 'vc-ignored-state) - (concat backend-name "!" rev)) - (t - ;; Not just for the 'edited state, but also a fallback - ;; for all other states. Think about different symbols - ;; for 'needs-update and 'needs-merge. - (setq state-echo "Locally modified file") - (setq face 'vc-edited-state) - (concat backend-name ":" rev))) - 'face face - 'help-echo (concat state-echo " under the " backend-name - " version control system")))) + (pcase-let* ((backend-name (symbol-name backend)) + (state (vc-state file backend)) + (rev (vc-working-revision file backend)) + (`(,state-echo ,face ,indicator) + (vc-mode-line-state state)) + (state-string (concat backend-name indicator rev))) + (propertize state-string 'face face 'help-echo + (concat state-echo " under the " backend-name + " version control system")))) (defun vc-follow-link () "If current buffer visits a symbolic link, visit the real file. commit 484fc70a7acc5a958bfeefa4b83255680c7da175 Author: Eli Zaretskii Date: Mon Oct 16 14:17:57 2023 +0300 Fix "C-0 C-x C-s" with write-protected files * lisp/files.el (basic-save-buffer-2): Call 'set-file-modes' to try to make the file writable, even if 'set-file-extended-attributes' succeeded. (Bug#66546) diff --git a/lisp/files.el b/lisp/files.el index e1421b403bf..adfe8bd44b9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5933,9 +5933,10 @@ basic-save-buffer-2 buffer-file-name) t)) ;; If file not writable, see if we can make it writable - ;; temporarily while we write it. - ;; But no need to do so if we have just backed it up - ;; (setmodes is set) because that says we're superseding. + ;; temporarily while we write it (its original modes will be + ;; restored in 'basic-save-buffer'). But no need to do so if + ;; we have just backed it up (setmodes is set) because that + ;; says we're superseding. (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes @@ -5944,12 +5945,12 @@ basic-save-buffer-2 "Error getting extended attributes: %s" (file-extended-attributes buffer-file-name)) buffer-file-name)) - ;; If set-file-extended-attributes fails, fall back on - ;; set-file-modes. - (unless - (with-demoted-errors "Error setting attributes: %s" - (set-file-extended-attributes buffer-file-name - (nth 1 setmodes))) + ;; If set-file-extended-attributes fails to make the + ;; file writable, fall back on set-file-modes. + (with-demoted-errors "Error setting attributes: %s" + (set-file-extended-attributes buffer-file-name + (nth 1 setmodes))) + (unless (file-writable-p buffer-file-name) (set-file-modes buffer-file-name (logior (car setmodes) 128))))) (let (success) commit 194e219825c378a25b7a2dbda0c77215ac5ab302 Author: Michael Albinus Date: Mon Oct 16 12:41:32 2023 +0200 * doc/man/emacsclient.1: Add missing options. diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index 83c8a366f8b..acc2edd4609 100644 --- a/doc/man/emacsclient.1 +++ b/doc/man/emacsclient.1 @@ -1,5 +1,5 @@ .\" See section COPYING for conditions for redistribution. -.TH EMACSCLIENT 1 "2022-09-05" "GNU Emacs" "GNU" +.TH EMACSCLIENT 1 "2023-10-16" "GNU Emacs" "GNU" .\" NAME should be all caps, SECTION should be 1-8, maybe w/ subsection .\" other params are allowed: see man(7), man(1) .SH NAME @@ -94,13 +94,37 @@ Emacs. If combined with --eval, this option is ignored. How long to wait, in seconds, for Emacs to respond before giving up. The default is 0, which means to wait forever. .TP -.B \-nw, \-t, \-\-tty -Open a new Emacs frame on the current terminal. +.B \-\-parent-id=ID +Open an +.B emacsclient +frame as a client frame in the parent X window with id ID. +.TP +.B \-q, \-\-quiet +Do not let +.B emacsclient +display messages about waiting for Emacs or connecting to remote +server sockets. +.TP +.B \-u, \-\-suppress-output +Do not let +.B emacsclient +display results returned from the server. Mostly useful in +combination with --eval when the evaluation performed is for +side-effect rather than result. .TP .B \-s, \-\-socket-name=FILENAME Use socket named FILENAME for communication. This can also be specified via the EMACS_SOCKET_NAME environment variable. .TP +.B \-nw, \-t, \-\-tty +Open a new Emacs frame on the current terminal. +.TP +.B \-T, \-\-tramp-prefix=PREFIX +Set PREFIX to add to filenames for Emacs to locate files on remote +machines using TRAMP. This is mostly useful in combination with using +the Emacs server over TCP with --server-file. This can also be +specified via the EMACSCLIENT_TRAMP environment variable. +.TP .B \-V, \-\-version Print version information and exit. .TP commit c3038bf5e1d79c3dfa83717a5a61ecc86116f04a Author: Gerd Möllmann Date: Mon Oct 16 10:12:10 2023 +0200 ; LLDB support cleanup and extension diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index 24b127a1fb9..a4f066b79de 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -78,22 +78,22 @@ class Lisp_Object: # Object construction/initialization. def __init__(self, lisp_obj): - self.lisp_obj = lisp_obj - self.frame = lisp_obj.GetFrame() + self.tagged = lisp_obj + self.unsigned = None self.lisp_type = None self.pvec_type = None - self.value = None + self.untagged = None self.init_unsigned() self.init_lisp_types() self.init_values() def init_unsigned(self): - if self.lisp_obj.GetType().GetTypeClass() == lldb.eTypeClassStruct: + if self.tagged.GetType().GetTypeClass() == lldb.eTypeClassStruct: # Lisp_Object is actually a struct. - lisp_word = self.lisp_obj.GetValueForExpressionPath(".i") + lisp_word = self.tagged.GetValueForExpressionPath(".i") self.unsigned = lisp_word.GetValueAsUnsigned() else: - self.unsigned = self.lisp_obj.GetValueAsUnsigned() + self.unsigned = self.tagged.GetValueAsUnsigned() # Initialize self.lisp_type to the C Lisp_Type enumerator of the # Lisp_Object, as a string. Initialize self.pvec_type likewise to @@ -117,40 +117,38 @@ def init_lisp_types(self): f">> More_Lisp_Bits::PSEUDOVECTOR_AREA_BITS)") self.pvec_type = enumerator_name(typ) - # Initialize self.value according to lisp_type and pvec_type. + # Initialize self.untagged according to lisp_type and pvec_type. def init_values(self): if self.lisp_type == "Lisp_Symbol": offset = self.get_lisp_pointer("char").GetValueAsUnsigned() - self.value = self.eval(f"(struct Lisp_Symbol *)" + self.untagged = self.eval(f"(struct Lisp_Symbol *)" f" ((char *) &lispsym + {offset})", True) elif self.lisp_type == "Lisp_String": - self.value = self.get_lisp_pointer("struct Lisp_String", True) + self.untagged = self.get_lisp_pointer("struct Lisp_String", True) elif self.lisp_type == "Lisp_Vectorlike": c_type = Lisp_Object.pvec2type[self.pvec_type] - self.value = self.get_lisp_pointer(c_type, True) + self.untagged = self.get_lisp_pointer(c_type, True) elif self.lisp_type == "Lisp_Cons": - self.value = self.get_lisp_pointer("struct Lisp_Cons", True) + self.untagged = self.get_lisp_pointer("struct Lisp_Cons", True) elif self.lisp_type == "Lisp_Float": - self.value = self.get_lisp_pointer("struct Lisp_Float", True) + self.untagged = self.get_lisp_pointer("struct Lisp_Float", True) elif self.lisp_type in ("Lisp_Int0", "Lisp_Int1"): - self.value = self.eval(f"((EMACS_INT) {self.unsigned}) " - f">> (GCTYPEBITS - 1)", - True) + self.untagged = self.eval(f"((EMACS_INT) {self.unsigned}) " + f">> (GCTYPEBITS - 1)", True) + elif self.lisp_type == "Lisp_Type_Unused0": + self.untagged = self.unsigned else: - assert False, "Unknown Lisp type" - - # Create an SBValue for EXPR with name NAME. - def create_value(self, name, expr): - return self.lisp_obj.CreateValueFromExpression(name, expr) + assert False, f"Unknown Lisp type {self.lisp_type}" # Evaluate EXPR in the context of the current frame. def eval(self, expr, make_var=False): + frame = self.tagged.GetFrame() if make_var: - return self.frame.EvaluateExpression(expr) + return frame.EvaluateExpression(expr) options = lldb.SBExpressionOptions() options.SetSuppressPersistentResult(True) - return self.frame.EvaluateExpression(expr, options) + return frame.EvaluateExpression(expr, options) # Return an SBValue for this object denoting a pointer of type # TYP*. @@ -163,20 +161,20 @@ def get_lisp_pointer(self, typ, make_var=False): # Return None otherwise. def get_string_data(self): if self.lisp_type == "Lisp_String": - return self.value.GetValueForExpressionPath("->u.s.data") + return self.untagged.GetValueForExpressionPath("->u.s.data") return None # if this is a Lisp_Symbol, return an SBBalue for its name. # Return None otherwise. def get_symbol_name(self): if self.lisp_type == "Lisp_Symbol": - name = self.value.GetValueForExpressionPath("->u.s.name") + name = self.untagged.GetValueForExpressionPath("->u.s.name") return Lisp_Object(name).get_string_data() return None # Return a summary string for this object. def summary(self): - return str(self.value) + return str(self.untagged) ######################################################################## @@ -205,6 +203,15 @@ def xdebug_print(debugger, command, result, internal_dict): """Print Lisp_Objects using safe_debug_print()""" debugger.HandleCommand(f"expr safe_debug_print({command})") +def xcomplete(debugger, command, result, internal_dict): + """Print completions for COMMAND.""" + interpreter = debugger.GetCommandInterpreter() + string_list = lldb.SBStringList() + interpreter.HandleCompletion(command, len(command), len(command), + -1, string_list) + for i in range(string_list.GetSize()): + result.AppendMessage(string_list.GetStringAtIndex(i)) + ######################################################################## # Formatters @@ -213,40 +220,49 @@ def xdebug_print(debugger, command, result, internal_dict): def type_summary_Lisp_Object(obj, internal_dict): return Lisp_Object(obj).summary() -# Don't know at the moment how to use this outside of the LLDB gui -# command. And it's still incomplete. class Lisp_Object_Provider: + """Synthetic children provider for Lisp_Objects. + Supposedly only used by 'frame variable', where -P can be used + to specify a printing depth. """ def __init__(self, valobj, internal_dict): self.valobj = valobj - self.lisp_obj = Lisp_Object(valobj) - self.child = None + self.children = {} def update(self): - if self.lisp_obj.lisp_type == "Lisp_Symbol": - self.child = self.lisp_obj.get_symbol_name().Clone("name") - self.child.SetSyntheticChildGenerated(True) - elif self.lisp_obj.lisp_type == "Lisp_String": - self.child = self.lisp_obj.get_string_data().Clone("data") - self.child.SetSyntheticChildGenerated(True) - else: - self.child = self.lisp_obj.value.Clone("untagged") - self.child.SetSyntheticChildGenerated(True) - - def has_children(self): - return True + lisp_obj = Lisp_Object(self.valobj) + lisp_type = lisp_obj.lisp_type + try: + if lisp_type == "Lisp_Symbol": + child = lisp_obj.get_symbol_name() + self.children["name"] = child + elif lisp_type == "Lisp_String": + child = lisp_obj.get_string_data() + self.children["data"] = child + elif lisp_type == "Lisp_Cons": + car = lisp_obj.untagged.GetValueForExpressionPath("->u.s.car") + cdr = lisp_obj.untagged.GetValueForExpressionPath("->u.s.u.cdr") + self.children["car"] = car + self.children["cdr"] = cdr + else: + self.children["untagged"] = lisp_obj.untagged + except: + print(f"*** exception in child provider update for {lisp_type}") + pass def num_children(self): - return 1 + return len(self.children) def get_child_index(self, name): - return 0 + index = 0 + for child_name, child in self.children: + if child_name == name: + return index + index = index + 1 + return -1 - # This works insofar as struct frame * works, but it doesn't work - # Lisp_Symbol, for example. def get_child_at_index(self, index): - if index != 0: - return None - return self.child + key = list(self.children)[index] + return self.children[key] ######################################################################## @@ -300,6 +316,7 @@ def enable_type_category(debugger, category): def __lldb_init_module(debugger, internal_dict): define_command(debugger, xbacktrace) define_command(debugger, xdebug_print) + define_command(debugger, xcomplete) define_type_summary(debugger, "Lisp_Object", type_summary_Lisp_Object) define_type_synthetic(debugger, "Lisp_Object", Lisp_Object_Provider) enable_type_category(debugger, "Emacs") commit 2071904d5199c903c718d67fc9d47e6787f5114e Merge: 36656ff70e3 07c45f20fd3 Author: Michael Albinus Date: Mon Oct 16 09:02:39 2023 +0200 Merge from origin/emacs-29 07c45f20fd3 Fix test in files-tests 5d3f3288d22 ; * doc/emacs/search.texi (Regexp Backslash): Improve ind... 9525315c117 Add missing :version to two defcustoms 9044d4d94bb Fix a defcustom :type in eldoc.el 8141d73ea7f Document 'M-x align' in the Emacs manual commit 36656ff70e3d8971117b0d25b2afd2727b09b098 Author: Po Lu Date: Mon Oct 16 09:00:45 2023 +0800 Properly initialize argment list supplied to android_init_emacs * src/android.c (initEmacs): NULL-terminate c_argv. diff --git a/src/android.c b/src/android.c index 8c4748cccf6..9f0e966a602 100644 --- a/src/android.c +++ b/src/android.c @@ -1826,7 +1826,7 @@ NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv, android_java_env = env; nelements = (*env)->GetArrayLength (env, argv); - c_argv = alloca (sizeof *c_argv * nelements); + c_argv = alloca (sizeof *c_argv * (nelements + 1)); for (i = 0; i < nelements; ++i) { @@ -1844,6 +1844,8 @@ NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv, (*env)->ReleaseStringUTFChars (env, (jstring) argument, c_argument); } + c_argv[nelements] = NULL; + android_init_emacs_service (); android_init_emacs_pixmap (); android_init_graphics_point (); commit 4c9f9dbd5014eaade2c57b4a78b60528f08efed4 Author: Po Lu Date: Mon Oct 16 08:56:53 2023 +0800 Revert "Update etc/rgb.txt from X.Org upstream" This reverts commit 11f10dc0d0b4b1d6af828102421eac9f79e0fcba. * etc/rgb.txt: Restore X11R6.6 version, where non-portable color names are absent. diff --git a/etc/rgb.txt b/etc/rgb.txt index 2772ff238ff..64d885db01a 100644 --- a/etc/rgb.txt +++ b/etc/rgb.txt @@ -93,14 +93,6 @@ 119 136 153 LightSlateGrey 190 190 190 gray 190 190 190 grey -190 190 190 x11 gray -190 190 190 X11Gray -190 190 190 x11 grey -190 190 190 X11Grey -128 128 128 web gray -128 128 128 WebGray -128 128 128 web grey -128 128 128 WebGrey 211 211 211 light grey 211 211 211 LightGrey 211 211 211 light gray @@ -149,7 +141,6 @@ 72 209 204 MediumTurquoise 64 224 208 turquoise 0 255 255 cyan - 0 255 255 aqua 224 255 255 light cyan 224 255 255 LightCyan 95 158 160 cadet blue @@ -176,11 +167,6 @@ 124 252 0 lawn green 124 252 0 LawnGreen 0 255 0 green - 0 255 0 lime - 0 255 0 x11 green - 0 255 0 X11Green - 0 128 0 web green - 0 128 0 WebGreen 127 255 0 chartreuse 0 250 154 medium spring green 0 250 154 MediumSpringGreen @@ -204,7 +190,7 @@ 255 255 224 light yellow 255 255 224 LightYellow 255 255 0 yellow -255 215 0 gold +255 215 0 gold 238 221 130 light goldenrod 238 221 130 LightGoldenrod 218 165 32 goldenrod @@ -252,16 +238,11 @@ 219 112 147 pale violet red 219 112 147 PaleVioletRed 176 48 96 maroon -176 48 96 x11 maroon -176 48 96 X11Maroon -128 0 0 web maroon -128 0 0 WebMaroon 199 21 133 medium violet red 199 21 133 MediumVioletRed 208 32 144 violet red 208 32 144 VioletRed 255 0 255 magenta -255 0 255 fuchsia 238 130 238 violet 221 160 221 plum 218 112 214 orchid @@ -274,10 +255,6 @@ 138 43 226 blue violet 138 43 226 BlueViolet 160 32 240 purple -160 32 240 x11 purple -160 32 240 X11Purple -128 0 128 web purple -128 0 128 WebPurple 147 112 219 medium purple 147 112 219 MediumPurple 216 191 216 thistle @@ -304,7 +281,7 @@ 255 222 173 NavajoWhite1 238 207 161 NavajoWhite2 205 179 139 NavajoWhite3 -139 121 94 NavajoWhite4 +139 121 94 NavajoWhite4 255 250 205 LemonChiffon1 238 233 191 LemonChiffon2 205 201 165 LemonChiffon3 @@ -412,131 +389,131 @@ 84 255 159 SeaGreen1 78 238 148 SeaGreen2 67 205 128 SeaGreen3 - 46 139 87 SeaGreen4 + 46 139 87 SeaGreen4 154 255 154 PaleGreen1 144 238 144 PaleGreen2 124 205 124 PaleGreen3 - 84 139 84 PaleGreen4 + 84 139 84 PaleGreen4 0 255 127 SpringGreen1 0 238 118 SpringGreen2 0 205 102 SpringGreen3 - 0 139 69 SpringGreen4 - 0 255 0 green1 - 0 238 0 green2 - 0 205 0 green3 - 0 139 0 green4 -127 255 0 chartreuse1 -118 238 0 chartreuse2 -102 205 0 chartreuse3 - 69 139 0 chartreuse4 -192 255 62 OliveDrab1 -179 238 58 OliveDrab2 -154 205 50 OliveDrab3 -105 139 34 OliveDrab4 + 0 139 69 SpringGreen4 + 0 255 0 green1 + 0 238 0 green2 + 0 205 0 green3 + 0 139 0 green4 +127 255 0 chartreuse1 +118 238 0 chartreuse2 +102 205 0 chartreuse3 + 69 139 0 chartreuse4 +192 255 62 OliveDrab1 +179 238 58 OliveDrab2 +154 205 50 OliveDrab3 +105 139 34 OliveDrab4 202 255 112 DarkOliveGreen1 188 238 104 DarkOliveGreen2 -162 205 90 DarkOliveGreen3 -110 139 61 DarkOliveGreen4 +162 205 90 DarkOliveGreen3 +110 139 61 DarkOliveGreen4 255 246 143 khaki1 238 230 133 khaki2 205 198 115 khaki3 -139 134 78 khaki4 +139 134 78 khaki4 255 236 139 LightGoldenrod1 238 220 130 LightGoldenrod2 205 190 112 LightGoldenrod3 -139 129 76 LightGoldenrod4 +139 129 76 LightGoldenrod4 255 255 224 LightYellow1 238 238 209 LightYellow2 205 205 180 LightYellow3 139 139 122 LightYellow4 -255 255 0 yellow1 -238 238 0 yellow2 -205 205 0 yellow3 -139 139 0 yellow4 -255 215 0 gold1 -238 201 0 gold2 -205 173 0 gold3 -139 117 0 gold4 -255 193 37 goldenrod1 -238 180 34 goldenrod2 -205 155 29 goldenrod3 -139 105 20 goldenrod4 -255 185 15 DarkGoldenrod1 -238 173 14 DarkGoldenrod2 -205 149 12 DarkGoldenrod3 -139 101 8 DarkGoldenrod4 +255 255 0 yellow1 +238 238 0 yellow2 +205 205 0 yellow3 +139 139 0 yellow4 +255 215 0 gold1 +238 201 0 gold2 +205 173 0 gold3 +139 117 0 gold4 +255 193 37 goldenrod1 +238 180 34 goldenrod2 +205 155 29 goldenrod3 +139 105 20 goldenrod4 +255 185 15 DarkGoldenrod1 +238 173 14 DarkGoldenrod2 +205 149 12 DarkGoldenrod3 +139 101 8 DarkGoldenrod4 255 193 193 RosyBrown1 238 180 180 RosyBrown2 205 155 155 RosyBrown3 139 105 105 RosyBrown4 255 106 106 IndianRed1 -238 99 99 IndianRed2 -205 85 85 IndianRed3 -139 58 58 IndianRed4 -255 130 71 sienna1 -238 121 66 sienna2 -205 104 57 sienna3 -139 71 38 sienna4 +238 99 99 IndianRed2 +205 85 85 IndianRed3 +139 58 58 IndianRed4 +255 130 71 sienna1 +238 121 66 sienna2 +205 104 57 sienna3 +139 71 38 sienna4 255 211 155 burlywood1 238 197 145 burlywood2 205 170 125 burlywood3 -139 115 85 burlywood4 +139 115 85 burlywood4 255 231 186 wheat1 238 216 174 wheat2 205 186 150 wheat3 139 126 102 wheat4 -255 165 79 tan1 -238 154 73 tan2 -205 133 63 tan3 -139 90 43 tan4 -255 127 36 chocolate1 -238 118 33 chocolate2 -205 102 29 chocolate3 -139 69 19 chocolate4 -255 48 48 firebrick1 -238 44 44 firebrick2 -205 38 38 firebrick3 -139 26 26 firebrick4 -255 64 64 brown1 -238 59 59 brown2 -205 51 51 brown3 -139 35 35 brown4 +255 165 79 tan1 +238 154 73 tan2 +205 133 63 tan3 +139 90 43 tan4 +255 127 36 chocolate1 +238 118 33 chocolate2 +205 102 29 chocolate3 +139 69 19 chocolate4 +255 48 48 firebrick1 +238 44 44 firebrick2 +205 38 38 firebrick3 +139 26 26 firebrick4 +255 64 64 brown1 +238 59 59 brown2 +205 51 51 brown3 +139 35 35 brown4 255 140 105 salmon1 -238 130 98 salmon2 -205 112 84 salmon3 -139 76 57 salmon4 +238 130 98 salmon2 +205 112 84 salmon3 +139 76 57 salmon4 255 160 122 LightSalmon1 238 149 114 LightSalmon2 -205 129 98 LightSalmon3 -139 87 66 LightSalmon4 -255 165 0 orange1 -238 154 0 orange2 -205 133 0 orange3 -139 90 0 orange4 -255 127 0 DarkOrange1 -238 118 0 DarkOrange2 -205 102 0 DarkOrange3 -139 69 0 DarkOrange4 -255 114 86 coral1 -238 106 80 coral2 -205 91 69 coral3 -139 62 47 coral4 -255 99 71 tomato1 -238 92 66 tomato2 -205 79 57 tomato3 -139 54 38 tomato4 -255 69 0 OrangeRed1 -238 64 0 OrangeRed2 -205 55 0 OrangeRed3 -139 37 0 OrangeRed4 -255 0 0 red1 -238 0 0 red2 -205 0 0 red3 -139 0 0 red4 +205 129 98 LightSalmon3 +139 87 66 LightSalmon4 +255 165 0 orange1 +238 154 0 orange2 +205 133 0 orange3 +139 90 0 orange4 +255 127 0 DarkOrange1 +238 118 0 DarkOrange2 +205 102 0 DarkOrange3 +139 69 0 DarkOrange4 +255 114 86 coral1 +238 106 80 coral2 +205 91 69 coral3 +139 62 47 coral4 +255 99 71 tomato1 +238 92 66 tomato2 +205 79 57 tomato3 +139 54 38 tomato4 +255 69 0 OrangeRed1 +238 64 0 OrangeRed2 +205 55 0 OrangeRed3 +139 37 0 OrangeRed4 +255 0 0 red1 +238 0 0 red2 +205 0 0 red3 +139 0 0 red4 255 20 147 DeepPink1 238 18 137 DeepPink2 205 16 118 DeepPink3 -139 10 80 DeepPink4 +139 10 80 DeepPink4 255 110 180 HotPink1 238 106 167 HotPink2 205 96 144 HotPink3 @@ -552,15 +529,15 @@ 255 130 171 PaleVioletRed1 238 121 159 PaleVioletRed2 205 104 137 PaleVioletRed3 -139 71 93 PaleVioletRed4 +139 71 93 PaleVioletRed4 255 52 179 maroon1 238 48 167 maroon2 205 41 144 maroon3 -139 28 98 maroon4 +139 28 98 maroon4 255 62 150 VioletRed1 238 58 140 VioletRed2 205 50 120 VioletRed3 -139 34 82 VioletRed4 +139 34 82 VioletRed4 255 0 255 magenta1 238 0 238 magenta2 205 0 205 magenta3 @@ -601,218 +578,211 @@ 5 5 5 grey2 8 8 8 gray3 8 8 8 grey3 - 10 10 10 gray4 - 10 10 10 grey4 - 13 13 13 gray5 - 13 13 13 grey5 - 15 15 15 gray6 - 15 15 15 grey6 - 18 18 18 gray7 - 18 18 18 grey7 - 20 20 20 gray8 - 20 20 20 grey8 - 23 23 23 gray9 - 23 23 23 grey9 - 26 26 26 gray10 - 26 26 26 grey10 - 28 28 28 gray11 - 28 28 28 grey11 - 31 31 31 gray12 - 31 31 31 grey12 - 33 33 33 gray13 - 33 33 33 grey13 - 36 36 36 gray14 - 36 36 36 grey14 - 38 38 38 gray15 - 38 38 38 grey15 - 41 41 41 gray16 - 41 41 41 grey16 - 43 43 43 gray17 - 43 43 43 grey17 - 46 46 46 gray18 - 46 46 46 grey18 - 48 48 48 gray19 - 48 48 48 grey19 - 51 51 51 gray20 - 51 51 51 grey20 - 54 54 54 gray21 - 54 54 54 grey21 - 56 56 56 gray22 - 56 56 56 grey22 - 59 59 59 gray23 - 59 59 59 grey23 - 61 61 61 gray24 - 61 61 61 grey24 - 64 64 64 gray25 - 64 64 64 grey25 - 66 66 66 gray26 - 66 66 66 grey26 - 69 69 69 gray27 - 69 69 69 grey27 - 71 71 71 gray28 - 71 71 71 grey28 - 74 74 74 gray29 - 74 74 74 grey29 - 77 77 77 gray30 - 77 77 77 grey30 - 79 79 79 gray31 - 79 79 79 grey31 - 82 82 82 gray32 - 82 82 82 grey32 - 84 84 84 gray33 - 84 84 84 grey33 - 87 87 87 gray34 - 87 87 87 grey34 - 89 89 89 gray35 - 89 89 89 grey35 - 92 92 92 gray36 - 92 92 92 grey36 - 94 94 94 gray37 - 94 94 94 grey37 - 97 97 97 gray38 - 97 97 97 grey38 - 99 99 99 gray39 - 99 99 99 grey39 -102 102 102 gray40 -102 102 102 grey40 -105 105 105 gray41 -105 105 105 grey41 -107 107 107 gray42 -107 107 107 grey42 -110 110 110 gray43 -110 110 110 grey43 -112 112 112 gray44 -112 112 112 grey44 -115 115 115 gray45 -115 115 115 grey45 -117 117 117 gray46 -117 117 117 grey46 -120 120 120 gray47 -120 120 120 grey47 -122 122 122 gray48 -122 122 122 grey48 -125 125 125 gray49 -125 125 125 grey49 -127 127 127 gray50 -127 127 127 grey50 -130 130 130 gray51 -130 130 130 grey51 -133 133 133 gray52 -133 133 133 grey52 -135 135 135 gray53 -135 135 135 grey53 -138 138 138 gray54 -138 138 138 grey54 -140 140 140 gray55 -140 140 140 grey55 -143 143 143 gray56 -143 143 143 grey56 -145 145 145 gray57 -145 145 145 grey57 -148 148 148 gray58 -148 148 148 grey58 -150 150 150 gray59 -150 150 150 grey59 -153 153 153 gray60 -153 153 153 grey60 -156 156 156 gray61 -156 156 156 grey61 -158 158 158 gray62 -158 158 158 grey62 -161 161 161 gray63 -161 161 161 grey63 -163 163 163 gray64 -163 163 163 grey64 -166 166 166 gray65 -166 166 166 grey65 -168 168 168 gray66 -168 168 168 grey66 -171 171 171 gray67 -171 171 171 grey67 -173 173 173 gray68 -173 173 173 grey68 -176 176 176 gray69 -176 176 176 grey69 -179 179 179 gray70 -179 179 179 grey70 -181 181 181 gray71 -181 181 181 grey71 -184 184 184 gray72 -184 184 184 grey72 -186 186 186 gray73 -186 186 186 grey73 -189 189 189 gray74 -189 189 189 grey74 -191 191 191 gray75 -191 191 191 grey75 -194 194 194 gray76 -194 194 194 grey76 -196 196 196 gray77 -196 196 196 grey77 -199 199 199 gray78 -199 199 199 grey78 -201 201 201 gray79 -201 201 201 grey79 -204 204 204 gray80 -204 204 204 grey80 -207 207 207 gray81 -207 207 207 grey81 -209 209 209 gray82 -209 209 209 grey82 -212 212 212 gray83 -212 212 212 grey83 -214 214 214 gray84 -214 214 214 grey84 -217 217 217 gray85 -217 217 217 grey85 -219 219 219 gray86 -219 219 219 grey86 -222 222 222 gray87 -222 222 222 grey87 -224 224 224 gray88 -224 224 224 grey88 -227 227 227 gray89 -227 227 227 grey89 -229 229 229 gray90 -229 229 229 grey90 -232 232 232 gray91 -232 232 232 grey91 -235 235 235 gray92 -235 235 235 grey92 -237 237 237 gray93 -237 237 237 grey93 -240 240 240 gray94 -240 240 240 grey94 -242 242 242 gray95 -242 242 242 grey95 -245 245 245 gray96 -245 245 245 grey96 -247 247 247 gray97 -247 247 247 grey97 -250 250 250 gray98 -250 250 250 grey98 -252 252 252 gray99 -252 252 252 grey99 -255 255 255 gray100 -255 255 255 grey100 + 10 10 10 gray4 + 10 10 10 grey4 + 13 13 13 gray5 + 13 13 13 grey5 + 15 15 15 gray6 + 15 15 15 grey6 + 18 18 18 gray7 + 18 18 18 grey7 + 20 20 20 gray8 + 20 20 20 grey8 + 23 23 23 gray9 + 23 23 23 grey9 + 26 26 26 gray10 + 26 26 26 grey10 + 28 28 28 gray11 + 28 28 28 grey11 + 31 31 31 gray12 + 31 31 31 grey12 + 33 33 33 gray13 + 33 33 33 grey13 + 36 36 36 gray14 + 36 36 36 grey14 + 38 38 38 gray15 + 38 38 38 grey15 + 41 41 41 gray16 + 41 41 41 grey16 + 43 43 43 gray17 + 43 43 43 grey17 + 46 46 46 gray18 + 46 46 46 grey18 + 48 48 48 gray19 + 48 48 48 grey19 + 51 51 51 gray20 + 51 51 51 grey20 + 54 54 54 gray21 + 54 54 54 grey21 + 56 56 56 gray22 + 56 56 56 grey22 + 59 59 59 gray23 + 59 59 59 grey23 + 61 61 61 gray24 + 61 61 61 grey24 + 64 64 64 gray25 + 64 64 64 grey25 + 66 66 66 gray26 + 66 66 66 grey26 + 69 69 69 gray27 + 69 69 69 grey27 + 71 71 71 gray28 + 71 71 71 grey28 + 74 74 74 gray29 + 74 74 74 grey29 + 77 77 77 gray30 + 77 77 77 grey30 + 79 79 79 gray31 + 79 79 79 grey31 + 82 82 82 gray32 + 82 82 82 grey32 + 84 84 84 gray33 + 84 84 84 grey33 + 87 87 87 gray34 + 87 87 87 grey34 + 89 89 89 gray35 + 89 89 89 grey35 + 92 92 92 gray36 + 92 92 92 grey36 + 94 94 94 gray37 + 94 94 94 grey37 + 97 97 97 gray38 + 97 97 97 grey38 + 99 99 99 gray39 + 99 99 99 grey39 +102 102 102 gray40 +102 102 102 grey40 +105 105 105 gray41 +105 105 105 grey41 +107 107 107 gray42 +107 107 107 grey42 +110 110 110 gray43 +110 110 110 grey43 +112 112 112 gray44 +112 112 112 grey44 +115 115 115 gray45 +115 115 115 grey45 +117 117 117 gray46 +117 117 117 grey46 +120 120 120 gray47 +120 120 120 grey47 +122 122 122 gray48 +122 122 122 grey48 +125 125 125 gray49 +125 125 125 grey49 +127 127 127 gray50 +127 127 127 grey50 +130 130 130 gray51 +130 130 130 grey51 +133 133 133 gray52 +133 133 133 grey52 +135 135 135 gray53 +135 135 135 grey53 +138 138 138 gray54 +138 138 138 grey54 +140 140 140 gray55 +140 140 140 grey55 +143 143 143 gray56 +143 143 143 grey56 +145 145 145 gray57 +145 145 145 grey57 +148 148 148 gray58 +148 148 148 grey58 +150 150 150 gray59 +150 150 150 grey59 +153 153 153 gray60 +153 153 153 grey60 +156 156 156 gray61 +156 156 156 grey61 +158 158 158 gray62 +158 158 158 grey62 +161 161 161 gray63 +161 161 161 grey63 +163 163 163 gray64 +163 163 163 grey64 +166 166 166 gray65 +166 166 166 grey65 +168 168 168 gray66 +168 168 168 grey66 +171 171 171 gray67 +171 171 171 grey67 +173 173 173 gray68 +173 173 173 grey68 +176 176 176 gray69 +176 176 176 grey69 +179 179 179 gray70 +179 179 179 grey70 +181 181 181 gray71 +181 181 181 grey71 +184 184 184 gray72 +184 184 184 grey72 +186 186 186 gray73 +186 186 186 grey73 +189 189 189 gray74 +189 189 189 grey74 +191 191 191 gray75 +191 191 191 grey75 +194 194 194 gray76 +194 194 194 grey76 +196 196 196 gray77 +196 196 196 grey77 +199 199 199 gray78 +199 199 199 grey78 +201 201 201 gray79 +201 201 201 grey79 +204 204 204 gray80 +204 204 204 grey80 +207 207 207 gray81 +207 207 207 grey81 +209 209 209 gray82 +209 209 209 grey82 +212 212 212 gray83 +212 212 212 grey83 +214 214 214 gray84 +214 214 214 grey84 +217 217 217 gray85 +217 217 217 grey85 +219 219 219 gray86 +219 219 219 grey86 +222 222 222 gray87 +222 222 222 grey87 +224 224 224 gray88 +224 224 224 grey88 +227 227 227 gray89 +227 227 227 grey89 +229 229 229 gray90 +229 229 229 grey90 +232 232 232 gray91 +232 232 232 grey91 +235 235 235 gray92 +235 235 235 grey92 +237 237 237 gray93 +237 237 237 grey93 +240 240 240 gray94 +240 240 240 grey94 +242 242 242 gray95 +242 242 242 grey95 +245 245 245 gray96 +245 245 245 grey96 +247 247 247 gray97 +247 247 247 grey97 +250 250 250 gray98 +250 250 250 grey98 +252 252 252 gray99 +252 252 252 grey99 +255 255 255 gray100 +255 255 255 grey100 169 169 169 dark grey 169 169 169 DarkGrey 169 169 169 dark gray 169 169 169 DarkGray - 0 0 139 dark blue - 0 0 139 DarkBlue - 0 139 139 dark cyan - 0 139 139 DarkCyan +0 0 139 dark blue +0 0 139 DarkBlue +0 139 139 dark cyan +0 139 139 DarkCyan 139 0 139 dark magenta 139 0 139 DarkMagenta 139 0 0 dark red 139 0 0 DarkRed 144 238 144 light green 144 238 144 LightGreen -220 20 60 crimson - 75 0 130 indigo -128 128 0 olive -102 51 153 rebecca purple -102 51 153 RebeccaPurple -192 192 192 silver - 0 128 128 teal commit 3e232387356a9dbfd6f51cb33aa48c9dfc57c872 Author: Sam Steingold Date: Sun Oct 15 11:51:34 2023 -0400 Fixup for "no file modes on windows and dos" * lisp/ls-lisp.el (ls-lisp-format): Keep the first group of permissions even when `modes' is not in `ls-lisp-verbosity'. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 5b264554005..c576819c5d0 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -811,7 +811,7 @@ ls-lisp-format (fceiling (/ file-size 1024.0))))) (if (memq 'modes ls-lisp-verbosity) drwxrwxrwx ; modes string - (substring drwxrwxrwx 0 1)) ; "d" or "-" for directory vs file + (substring drwxrwxrwx 0 4)) ; "d" or "-" for directory vs file (if (memq 'links ls-lisp-verbosity) (format "%3d" (file-attribute-link-number file-attr))) ;; Numeric uid/gid are more confusing than helpful; commit a0cd986e67521b091057c5551d9893fdefe1636c Author: Alan Mackenzie Date: Sun Oct 15 10:54:23 2023 +0000 c-indent-new-comment-line: don't test for a macro in a comment This fixes bug#9860. * lisp/progmodes/cc-cmds (c-indent-new-comment-line): Test for a comment/string before testing for a macro, thus preventing a "macro" being spuriously recognized in a comment. This allows auto-fill-mode to work on a line beginning with # in a comment. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 15b103a081f..658892414bc 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -4909,7 +4909,8 @@ c-indent-new-comment-line (setq c-lit-limits (c-literal-limits nil nil t))) (unless c-lit-type (setq c-lit-type (c-literal-type c-lit-limits))) - (if (memq (cond ((c-query-and-set-macro-start) 'cpp) + (if (memq (cond ((memq c-lit-type '(c c++ string)) c-lit-type) + ((c-query-and-set-macro-start) 'cpp) ((null c-lit-type) 'code) (t c-lit-type)) c-ignore-auto-fill) commit 07c45f20fd3828548d5f0c110034e9857a94ccaf Author: Michael Albinus Date: Sun Oct 15 12:26:43 2023 +0200 Fix test in files-tests * test/lisp/files-tests.el (files-tests-file-name-non-special-expand-file-name-tilde): Fix test. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 8f6495a293c..78d469580ba 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -664,7 +664,8 @@ files-tests-file-name-non-special-expand-file-name (ert-deftest files-tests-file-name-non-special-expand-file-name-tilde () (let ((process-environment - (cons (format "HOME=%s" temporary-file-directory) process-environment)) + (cons (format "HOME=%s" (file-truename temporary-file-directory)) + process-environment)) abbreviated-home-dir) (files-tests--with-temp-non-special (tmpfile nospecial) (let (file-name-handler-alist) commit 5d3f3288d221c2e1bbe7c7d1464171ac0a4cfb05 Author: Eli Zaretskii Date: Sun Oct 15 12:37:25 2023 +0300 ; * doc/emacs/search.texi (Regexp Backslash): Improve indexing. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index e5542a0fcf3..66a55f09220 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1158,6 +1158,8 @@ Regexp Backslash Full backtracking capability exists to handle multiple uses of @samp{\|}. +@cindex sub-expressions, in regular expressions +@cindex grouping, in regular expressions @item \( @dots{} \) is a grouping construct that serves three purposes: commit 98748aa6e62488dd088e0ff0bd1d81d770c8abde Author: Gerd Möllmann Date: Sun Oct 15 09:40:24 2023 +0200 ; New command alias xprint for LLDB diff --git a/src/.lldbinit b/src/.lldbinit index f5fcdd7b597..a5789f49122 100644 --- a/src/.lldbinit +++ b/src/.lldbinit @@ -30,4 +30,7 @@ script -- sys.path.append('../etc') # Load our Python files command script import emacs_lldb +# Print with children provider, depth 2. +command alias xprint frame variable -P 2 + # end. commit 47ddff8ae89117192e5ddac89831c6d3f1c94b8c Author: Po Lu Date: Sun Oct 15 15:02:43 2023 +0800 ; Correct typos in android.texi * doc/emacs/android.texi (Android Environment): Correct typos. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index d4ce762e7a0..161712493a6 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -374,33 +374,32 @@ Android Environment @cindex call-process, Android @vindex android-use-exec-loader Android 10 and later also prohibit Emacs itself from running -executables inside the app data directory, obstensibly for security -reasons. On these systems, Emacs normally applies a workaround; +executables inside the app data directory, ostensibly out of security +concerns. On these systems, Emacs normally applies a workaround; however, this workaround requires running all sub-processes through another subprocess which implements an executable loader and applies -process tracing to all its children, which may prove to be problematic -for various different reasons. In that case, the workaround can be -disabled by changing the variable @code{android-use-exec-loader} to -@code{nil}. +process tracing to all its children, which may prove problematic for a +variety of reasons. In that case, the workaround can be disabled by +changing the variable @code{android-use-exec-loader} to @code{nil}. When this workaround is in effect, process IDs retrieved through the @code{process-id} function will be that of the executable loader process; its child will belong to the same process group as the -loader. As a result, @code{interrupt-process}, and other related +loader. Consequently, @code{interrupt-process}, and other related functions will work correctly, but using the process ID returned by @code{process-id} for other purposes will not. - One side effect of the mechanism by which process tracing is carried -out is that job control facilities inside inferior shells + One ramification of the mechanism by which process tracing is +carried out is that job control facilities inside inferior shells (@pxref{Interactive Shell}) will not be able to stop processes, and -sending the @code{SIGSTOP} signal to a subprocess created by Emacs -will appear to have no effect. +@code{SIGSTOP} signals to subprocesses created by Emacs will not take +effect. In addition, Android 12 also terminates subprocesses which are consuming CPU while Emacs itself is in the background. The system -determines which processes are consuming too much CPU in intervals of -five minutes, and terminates the process that has consumed the most -CPU time. +judges which processes are consuming too much CPU at intervals of five +minutes, and terminates the process that has consumed the most CPU +time. Android 12.1 and Android 13 provide an option to disable this behavior; to use it, enable ``USB debugging'' (@pxref{Android commit 93104cff532f932bcea65d02a59c916767a31645 Author: Po Lu Date: Sun Oct 15 13:10:34 2023 +0800 Correctly receive files through Android DND * java/org/gnu/emacs/EmacsService.java (getUsefulContentResolver) (getContentResolverContext): New functions which return a content resolver from an EmacsActivity, if at all possible. (openContentUri, checkContentUri): Probe or open URIs through such content resolvers. Probe URIs by opening them if merely testing permissions fails, for DND URIs do not make checkCallingUriPermission return true. * java/org/gnu/emacs/EmacsWindow.java (onDragEvent): Address potential crash. * src/androidvfs.c (android_check_content_access): Circumvent JNI dynamic method dispatch. (android_authority_name): Guarantee NAME is never a directory. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 6fa2ebb3fdb..1325cd85e9b 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -921,6 +921,48 @@ invocation of app_process (through android-emacs) can /* Content provider functions. */ + /* Return a ContentResolver capable of accessing as many files as + possible, namely the content resolver of the last selected + activity if available: only they posses the rights to access drag + and drop files. */ + + public ContentResolver + getUsefulContentResolver () + { + EmacsActivity activity; + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) + /* Since the system predates drag and drop, return this resolver + to avoid any unforseen difficulties. */ + return resolver; + + activity = EmacsActivity.lastFocusedActivity; + if (activity == null) + return resolver; + + return activity.getContentResolver (); + } + + /* Return a context whose ContentResolver is granted access to most + files, as in `getUsefulContentResolver'. */ + + public Context + getContentResolverContext () + { + EmacsActivity activity; + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) + /* Since the system predates drag and drop, return this resolver + to avoid any unforseen difficulties. */ + return this; + + activity = EmacsActivity.lastFocusedActivity; + if (activity == null) + return this; + + return activity; + } + /* Open a content URI described by the bytes BYTES, a non-terminated string; make it writable if WRITABLE, and readable if READABLE. Truncate the file if TRUNCATE. @@ -934,6 +976,9 @@ invocation of app_process (through android-emacs) can String name, mode; ParcelFileDescriptor fd; int i; + ContentResolver resolver; + + resolver = getUsefulContentResolver (); /* Figure out the file access mode. */ @@ -978,6 +1023,7 @@ invocation of app_process (through android-emacs) can } catch (Exception exception) { + exception.printStackTrace (); return -1; } } @@ -994,6 +1040,11 @@ invocation of app_process (through android-emacs) can ParcelFileDescriptor fd; Uri uri; int rc, flags; + Context context; + ContentResolver resolver; + ParcelFileDescriptor descriptor; + + context = getContentResolverContext (); uri = Uri.parse (name); flags = 0; @@ -1004,8 +1055,42 @@ invocation of app_process (through android-emacs) can if (writable) flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION; - rc = checkCallingUriPermission (uri, flags); - return rc == PackageManager.PERMISSION_GRANTED; + rc = context.checkCallingUriPermission (uri, flags); + + if (rc == PackageManager.PERMISSION_GRANTED) + return true; + + /* In the event checkCallingUriPermission fails and only read + permissions are being verified, attempt to query the URI. This + enables ascertaining whether drag and drop URIs can be + accessed, something otherwise not provided for. */ + + descriptor = null; + + try + { + resolver = context.getContentResolver (); + descriptor = resolver.openFileDescriptor (uri, "r"); + return true; + } + catch (Exception exception) + { + /* Ignored. */ + } + finally + { + try + { + if (descriptor != null) + descriptor.close (); + } + catch (IOException exception) + { + /* Ignored. */ + } + } + + return false; } /* Build a content file name for URI. diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 3d2d86624a7..386eaca8c41 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -1601,7 +1601,7 @@ else if (EmacsWindow.this.isMapped) { ClipData data; ClipDescription description; - int i, x, y; + int i, j, x, y, itemCount; String type; Uri uri; EmacsActivity activity; @@ -1626,11 +1626,12 @@ else if (EmacsWindow.this.isMapped) data = event.getClipData (); description = data.getDescription (); + itemCount = data.getItemCount (); /* If there are insufficient items within the clip data, return false. */ - if (data.getItemCount () < 1) + if (itemCount < 1) return false; /* Search for plain text data within the clipboard. */ @@ -1662,12 +1663,14 @@ else if (type.equals (ClipDescription.MIMETYPE_TEXT_URILIST)) { /* If the item dropped is a URI, send it to the main thread. */ + uri = data.getItemAt (0).getUri (); /* Attempt to acquire permissions for this URI; failing which, insert it as text instead. */ - if (uri.getScheme () != null + if (uri != null + && uri.getScheme () != null && uri.getScheme ().equals ("content") && (activity = EmacsActivity.lastFocusedActivity) != null) { diff --git a/src/androidvfs.c b/src/androidvfs.c index 94c5d35ed2c..f89a82cfcc6 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -2898,6 +2898,7 @@ android_check_content_access (const char *uri, int mode) { jobject string; jboolean rc, read, write; + jmethodID method; string = (*android_java_env)->NewStringUTF (android_java_env, uri); android_exception_check (); @@ -2907,11 +2908,13 @@ android_check_content_access (const char *uri, int mode) read = (bool) (mode & R_OK || (mode == F_OK)); write = (bool) (mode & W_OK); + method = service_class.check_content_uri; - rc = (*android_java_env)->CallBooleanMethod (android_java_env, - emacs_service, - service_class.check_content_uri, - string, read, write); + rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env, + emacs_service, + service_class.class, + method, string, read, + write); android_exception_check_1 (string); ANDROID_DELETE_LOCAL_REF (string); return rc; @@ -3013,6 +3016,15 @@ android_authority_name (struct android_vnode *vnode, char *name, if (*name == '/') name++, length -= 1; + /* If the provided URI is a directory, return NULL and set errno + to ENOTDIR. Content files are never directories. */ + + if (name[length - 1] == '/') + { + errno = ENOTDIR; + return NULL; + } + /* NAME must be a valid JNI string, so that it can be encoded properly. */ commit a3fd382f3fe803e0b61c5353e9b5bdaf4d1e564e Author: Mauro Aranda Date: Thu Oct 12 09:41:58 2023 -0300 Fix searching for tags in compressed files * lisp/progmodes/etags.el (etags--ensure-file): New function. (etags--all-files): Make sure files in TAGS can be visited, even if the files are compressed. (Bug#2807) (etags--xref-find-definitions): Report to xref a file that we are sure it exists. (Bug#44494) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index cb95f29b5fe..d48dcc6659d 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1729,6 +1729,21 @@ tags-next-file (fileloop-next-file novisit) (switch-to-buffer (current-buffer))) +(defun etags--ensure-file (file) + "Ensure FILE can be visited. + +FILE should be an expanded file name. +This function tries to locate FILE, possibly adding it a suffix +present in `tags-compression-info-list'. If the file can't be found, +signals an error. +Else, returns the filename that can be visited for sure." + (let ((f (locate-file file nil (if auto-compression-mode + tags-compression-info-list + '(""))))) + (unless f + (signal 'file-missing (list "Cannot locate file in TAGS" file))) + f)) + (defun tags--all-files () (save-excursion (let ((cbuf (current-buffer)) @@ -1750,7 +1765,7 @@ tags--all-files ;; list later returned by (tags-table-files). (setf (if tail (cdr tail) files) (mapcar #'expand-file-name (tags-table-files))))) - files))) + (mapcar #'etags--ensure-file files)))) (make-obsolete-variable 'tags-loop-operate 'fileloop-initialize "27.1") (defvar tags-loop-operate nil @@ -2137,7 +2152,7 @@ etags--xref-find-definitions (beginning-of-line) (pcase-let* ((tag-info (etags-snarf-tag)) (`(,hint ,line . _) tag-info)) - (let* ((file (file-of-tag)) + (let* ((file (etags--ensure-file (file-of-tag))) (mark-key (cons file line))) (unless (gethash mark-key marks) (let ((loc (xref-make-etags-location commit 90b4a7acb5332ed490cb2b456cfe8c11af8c9d4f Author: Stefan Kangas Date: Sun Oct 15 00:34:02 2023 +0200 Update publicsuffix.txt from upstream * etc/publicsuffix.txt: Update from https://publicsuffix.org/list/public_suffix_list.dat dated 2023-10-01 03:58:26 UTC. diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index 9d0dfc04ea9..456b8aeaf0b 100644 --- a/etc/publicsuffix.txt +++ b/etc/publicsuffix.txt @@ -1051,8 +1051,7 @@ fm // fo : https://en.wikipedia.org/wiki/.fo fo -// fr : http://www.afnic.fr/ -// domaines descriptifs : https://www.afnic.fr/medias/documents/Cadre_legal/Afnic_Naming_Policy_12122016_VEN.pdf +// fr : https://www.afnic.fr/ https://www.afnic.fr/wp-media/uploads/2022/12/afnic-naming-policy-2023-01-01.pdf fr asso.fr com.fr @@ -1060,22 +1059,11 @@ gouv.fr nom.fr prd.fr tm.fr -// domaines sectoriels : https://www.afnic.fr/en/products-and-services/the-fr-tld/sector-based-fr-domains-4.html -aeroport.fr -avocat.fr +// Other SLDs now selfmanaged out of AFNIC range. Former "domaines sectoriels", still registration suffixes avoues.fr cci.fr -chambagri.fr -chirurgiens-dentistes.fr -experts-comptables.fr -geometre-expert.fr greta.fr huissier-justice.fr -medecin.fr -notaires.fr -pharmacien.fr -port.fr -veterinaire.fr // ga : https://en.wikipedia.org/wiki/.ga ga @@ -4070,555 +4058,8 @@ ac.mu co.mu or.mu -// museum : http://about.museum/naming/ -// http://index.museum/ +// museum : https://welcome.museum/wp-content/uploads/2018/05/20180525-Registration-Policy-MUSEUM-EN_VF-2.pdf https://welcome.museum/buy-your-dot-museum-2/ museum -academy.museum -agriculture.museum -air.museum -airguard.museum -alabama.museum -alaska.museum -amber.museum -ambulance.museum -american.museum -americana.museum -americanantiques.museum -americanart.museum -amsterdam.museum -and.museum -annefrank.museum -anthro.museum -anthropology.museum -antiques.museum -aquarium.museum -arboretum.museum -archaeological.museum -archaeology.museum -architecture.museum -art.museum -artanddesign.museum -artcenter.museum -artdeco.museum -arteducation.museum -artgallery.museum -arts.museum -artsandcrafts.museum -asmatart.museum -assassination.museum -assisi.museum -association.museum -astronomy.museum -atlanta.museum -austin.museum -australia.museum -automotive.museum -aviation.museum -axis.museum -badajoz.museum -baghdad.museum -bahn.museum -bale.museum -baltimore.museum -barcelona.museum -baseball.museum -basel.museum -baths.museum -bauern.museum -beauxarts.museum -beeldengeluid.museum -bellevue.museum -bergbau.museum -berkeley.museum -berlin.museum -bern.museum -bible.museum -bilbao.museum -bill.museum -birdart.museum -birthplace.museum -bonn.museum -boston.museum -botanical.museum -botanicalgarden.museum -botanicgarden.museum -botany.museum -brandywinevalley.museum -brasil.museum -bristol.museum -british.museum -britishcolumbia.museum -broadcast.museum -brunel.museum -brussel.museum -brussels.museum -bruxelles.museum -building.museum -burghof.museum -bus.museum -bushey.museum -cadaques.museum -california.museum -cambridge.museum -can.museum -canada.museum -capebreton.museum -carrier.museum -cartoonart.museum -casadelamoneda.museum -castle.museum -castres.museum -celtic.museum -center.museum -chattanooga.museum -cheltenham.museum -chesapeakebay.museum -chicago.museum -children.museum -childrens.museum -childrensgarden.museum -chiropractic.museum -chocolate.museum -christiansburg.museum -cincinnati.museum -cinema.museum -circus.museum -civilisation.museum -civilization.museum -civilwar.museum -clinton.museum -clock.museum -coal.museum -coastaldefence.museum -cody.museum -coldwar.museum -collection.museum -colonialwilliamsburg.museum -coloradoplateau.museum -columbia.museum -columbus.museum -communication.museum -communications.museum -community.museum -computer.museum -computerhistory.museum -comunicações.museum -contemporary.museum -contemporaryart.museum -convent.museum -copenhagen.museum -corporation.museum -correios-e-telecomunicações.museum -corvette.museum -costume.museum -countryestate.museum -county.museum -crafts.museum -cranbrook.museum -creation.museum -cultural.museum -culturalcenter.museum -culture.museum -cyber.museum -cymru.museum -dali.museum -dallas.museum -database.museum -ddr.museum -decorativearts.museum -delaware.museum -delmenhorst.museum -denmark.museum -depot.museum -design.museum -detroit.museum -dinosaur.museum -discovery.museum -dolls.museum -donostia.museum -durham.museum -eastafrica.museum -eastcoast.museum -education.museum -educational.museum -egyptian.museum -eisenbahn.museum -elburg.museum -elvendrell.museum -embroidery.museum -encyclopedic.museum -england.museum -entomology.museum -environment.museum -environmentalconservation.museum -epilepsy.museum -essex.museum -estate.museum -ethnology.museum -exeter.museum -exhibition.museum -family.museum -farm.museum -farmequipment.museum -farmers.museum -farmstead.museum -field.museum -figueres.museum -filatelia.museum -film.museum -fineart.museum -finearts.museum -finland.museum -flanders.museum -florida.museum -force.museum -fortmissoula.museum -fortworth.museum -foundation.museum -francaise.museum -frankfurt.museum -franziskaner.museum -freemasonry.museum -freiburg.museum -fribourg.museum -frog.museum -fundacio.museum -furniture.museum -gallery.museum -garden.museum -gateway.museum -geelvinck.museum -gemological.museum -geology.museum -georgia.museum -giessen.museum -glas.museum -glass.museum -gorge.museum -grandrapids.museum -graz.museum -guernsey.museum -halloffame.museum -hamburg.museum -handson.museum -harvestcelebration.museum -hawaii.museum -health.museum -heimatunduhren.museum -hellas.museum -helsinki.museum -hembygdsforbund.museum -heritage.museum -histoire.museum -historical.museum -historicalsociety.museum -historichouses.museum -historisch.museum -historisches.museum -history.museum -historyofscience.museum -horology.museum -house.museum -humanities.museum -illustration.museum -imageandsound.museum -indian.museum -indiana.museum -indianapolis.museum -indianmarket.museum -intelligence.museum -interactive.museum -iraq.museum -iron.museum -isleofman.museum -jamison.museum -jefferson.museum -jerusalem.museum -jewelry.museum -jewish.museum -jewishart.museum -jfk.museum -journalism.museum -judaica.museum -judygarland.museum -juedisches.museum -juif.museum -karate.museum -karikatur.museum -kids.museum -koebenhavn.museum -koeln.museum -kunst.museum -kunstsammlung.museum -kunstunddesign.museum -labor.museum -labour.museum -lajolla.museum -lancashire.museum -landes.museum -lans.museum -läns.museum -larsson.museum -lewismiller.museum -lincoln.museum -linz.museum -living.museum -livinghistory.museum -localhistory.museum -london.museum -losangeles.museum -louvre.museum -loyalist.museum -lucerne.museum -luxembourg.museum -luzern.museum -mad.museum -madrid.museum -mallorca.museum -manchester.museum -mansion.museum -mansions.museum -manx.museum -marburg.museum -maritime.museum -maritimo.museum -maryland.museum -marylhurst.museum -media.museum -medical.museum -medizinhistorisches.museum -meeres.museum -memorial.museum -mesaverde.museum -michigan.museum -midatlantic.museum -military.museum -mill.museum -miners.museum -mining.museum -minnesota.museum -missile.museum -missoula.museum -modern.museum -moma.museum -money.museum -monmouth.museum -monticello.museum -montreal.museum -moscow.museum -motorcycle.museum -muenchen.museum -muenster.museum -mulhouse.museum -muncie.museum -museet.museum -museumcenter.museum -museumvereniging.museum -music.museum -national.museum -nationalfirearms.museum -nationalheritage.museum -nativeamerican.museum -naturalhistory.museum -naturalhistorymuseum.museum -naturalsciences.museum -nature.museum -naturhistorisches.museum -natuurwetenschappen.museum -naumburg.museum -naval.museum -nebraska.museum -neues.museum -newhampshire.museum -newjersey.museum -newmexico.museum -newport.museum -newspaper.museum -newyork.museum -niepce.museum -norfolk.museum -north.museum -nrw.museum -nyc.museum -nyny.museum -oceanographic.museum -oceanographique.museum -omaha.museum -online.museum -ontario.museum -openair.museum -oregon.museum -oregontrail.museum -otago.museum -oxford.museum -pacific.museum -paderborn.museum -palace.museum -paleo.museum -palmsprings.museum -panama.museum -paris.museum -pasadena.museum -pharmacy.museum -philadelphia.museum -philadelphiaarea.museum -philately.museum -phoenix.museum -photography.museum -pilots.museum -pittsburgh.museum -planetarium.museum -plantation.museum -plants.museum -plaza.museum -portal.museum -portland.museum -portlligat.museum -posts-and-telecommunications.museum -preservation.museum -presidio.museum -press.museum -project.museum -public.museum -pubol.museum -quebec.museum -railroad.museum -railway.museum -research.museum -resistance.museum -riodejaneiro.museum -rochester.museum -rockart.museum -roma.museum -russia.museum -saintlouis.museum -salem.museum -salvadordali.museum -salzburg.museum -sandiego.museum -sanfrancisco.museum -santabarbara.museum -santacruz.museum -santafe.museum -saskatchewan.museum -satx.museum -savannahga.museum -schlesisches.museum -schoenbrunn.museum -schokoladen.museum -school.museum -schweiz.museum -science.museum -scienceandhistory.museum -scienceandindustry.museum -sciencecenter.museum -sciencecenters.museum -science-fiction.museum -sciencehistory.museum -sciences.museum -sciencesnaturelles.museum -scotland.museum -seaport.museum -settlement.museum -settlers.museum -shell.museum -sherbrooke.museum -sibenik.museum -silk.museum -ski.museum -skole.museum -society.museum -sologne.museum -soundandvision.museum -southcarolina.museum -southwest.museum -space.museum -spy.museum -square.museum -stadt.museum -stalbans.museum -starnberg.museum -state.museum -stateofdelaware.museum -station.museum -steam.museum -steiermark.museum -stjohn.museum -stockholm.museum -stpetersburg.museum -stuttgart.museum -suisse.museum -surgeonshall.museum -surrey.museum -svizzera.museum -sweden.museum -sydney.museum -tank.museum -tcm.museum -technology.museum -telekommunikation.museum -television.museum -texas.museum -textile.museum -theater.museum -time.museum -timekeeping.museum -topology.museum -torino.museum -touch.museum -town.museum -transport.museum -tree.museum -trolley.museum -trust.museum -trustee.museum -uhren.museum -ulm.museum -undersea.museum -university.museum -usa.museum -usantiques.museum -usarts.museum -uscountryestate.museum -usculture.museum -usdecorativearts.museum -usgarden.museum -ushistory.museum -ushuaia.museum -uslivinghistory.museum -utah.museum -uvic.museum -valley.museum -vantaa.museum -versailles.museum -viking.museum -village.museum -virginia.museum -virtual.museum -virtuel.museum -vlaanderen.museum -volkenkunde.museum -wales.museum -wallonie.museum -war.museum -washingtondc.museum -watchandclock.museum -watch-and-clock.museum -western.museum -westfalen.museum -whaling.museum -wildlife.museum -williamsburg.museum -windmill.museum -workshop.museum -york.museum -yorkshire.museum -yosemite.museum -youth.museum -zoological.museum -zoology.museum -ירושלים.museum -иком.museum // mv : https://en.wikipedia.org/wiki/.mv // "mv" included because, contra Wikipedia, google.mv exists. @@ -5694,52 +5135,60 @@ turystyka.pl // Government domains gov.pl ap.gov.pl +griw.gov.pl ic.gov.pl is.gov.pl -us.gov.pl kmpsp.gov.pl +konsulat.gov.pl kppsp.gov.pl -kwpsp.gov.pl -psp.gov.pl -wskr.gov.pl kwp.gov.pl +kwpsp.gov.pl +mup.gov.pl mw.gov.pl -ug.gov.pl -um.gov.pl -umig.gov.pl -ugim.gov.pl -upow.gov.pl -uw.gov.pl -starostwo.gov.pl +oia.gov.pl +oirm.gov.pl +oke.gov.pl +oow.gov.pl +oschr.gov.pl +oum.gov.pl pa.gov.pl +pinb.gov.pl +piw.gov.pl po.gov.pl +pr.gov.pl +psp.gov.pl psse.gov.pl pup.gov.pl rzgw.gov.pl sa.gov.pl +sdn.gov.pl +sko.gov.pl so.gov.pl sr.gov.pl -wsa.gov.pl -sko.gov.pl +starostwo.gov.pl +ug.gov.pl +ugim.gov.pl +um.gov.pl +umig.gov.pl +upow.gov.pl +uppo.gov.pl +us.gov.pl +uw.gov.pl uzs.gov.pl +wif.gov.pl wiih.gov.pl winb.gov.pl -pinb.gov.pl wios.gov.pl witd.gov.pl -wzmiuw.gov.pl -piw.gov.pl wiw.gov.pl -griw.gov.pl -wif.gov.pl -oum.gov.pl -sdn.gov.pl -zp.gov.pl -uppo.gov.pl -mup.gov.pl +wkz.gov.pl +wsa.gov.pl +wskr.gov.pl +wsse.gov.pl wuoz.gov.pl -konsulat.gov.pl -oirm.gov.pl +wzmiuw.gov.pl +zp.gov.pl +zpisdn.gov.pl // pl regional domains (http://www.dns.pl/english/index.html) augustow.pl babia-gora.pl @@ -5861,7 +5310,7 @@ zarow.pl zgora.pl zgorzelec.pl -// pm : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf +// pm : https://www.afnic.fr/wp-media/uploads/2022/12/afnic-naming-policy-2023-01-01.pdf pm // pn : http://www.government.pn/PnRegistry/policies.htm @@ -5959,7 +5408,7 @@ net.qa org.qa sch.qa -// re : http://www.afnic.re/obtenir/chartes/nommage-re/annexe-descriptifs +// re : https://www.afnic.fr/wp-media/uploads/2022/12/afnic-naming-policy-2023-01-01.pdf re asso.re com.re @@ -6216,7 +5665,7 @@ td // http://www.telnic.org/ tel -// tf : https://en.wikipedia.org/wiki/.tf +// tf : https://www.afnic.fr/wp-media/uploads/2022/12/afnic-naming-policy-2023-01-01.pdf tf // tg : https://en.wikipedia.org/wiki/.tg @@ -6424,6 +5873,7 @@ kiev.ua kirovograd.ua km.ua kr.ua +kropyvnytskyi.ua krym.ua ks.ua kv.ua @@ -6431,6 +5881,7 @@ kyiv.ua lg.ua lt.ua lugansk.ua +luhansk.ua lutsk.ua lv.ua lviv.ua @@ -6454,11 +5905,13 @@ te.ua ternopil.ua uz.ua uzhgorod.ua +uzhhorod.ua vinnica.ua vinnytsia.ua vn.ua volyn.ua yalta.ua +zakarpattia.ua zaporizhzhe.ua zaporizhzhia.ua zhitomir.ua @@ -6570,7 +6023,6 @@ k12.ca.us k12.co.us k12.ct.us k12.dc.us -k12.de.us k12.fl.us k12.ga.us k12.gu.us @@ -6812,20 +6264,89 @@ k12.vi net.vi org.vi -// vn : https://www.dot.vn/vnnic/vnnic/domainregistration.jsp +// vn : https://www.vnnic.vn/en/domain/cctld-vn +// https://vnnic.vn/sites/default/files/tailieu/vn.cctld.domains.txt vn +ac.vn +ai.vn +biz.vn com.vn -net.vn -org.vn edu.vn gov.vn -int.vn -ac.vn -biz.vn +health.vn +id.vn info.vn +int.vn +io.vn name.vn +net.vn +org.vn pro.vn -health.vn + +// vn geographical names +angiang.vn +bacgiang.vn +backan.vn +baclieu.vn +bacninh.vn +baria-vungtau.vn +bentre.vn +binhdinh.vn +binhduong.vn +binhphuoc.vn +binhthuan.vn +camau.vn +cantho.vn +caobang.vn +daklak.vn +daknong.vn +danang.vn +dienbien.vn +dongnai.vn +dongthap.vn +gialai.vn +hagiang.vn +haiduong.vn +haiphong.vn +hanam.vn +hanoi.vn +hatinh.vn +haugiang.vn +hoabinh.vn +hungyen.vn +khanhhoa.vn +kiengiang.vn +kontum.vn +laichau.vn +lamdong.vn +langson.vn +laocai.vn +longan.vn +namdinh.vn +nghean.vn +ninhbinh.vn +ninhthuan.vn +phutho.vn +phuyen.vn +quangbinh.vn +quangnam.vn +quangngai.vn +quangninh.vn +quangtri.vn +soctrang.vn +sonla.vn +tayninh.vn +thaibinh.vn +thainguyen.vn +thanhhoa.vn +thanhphohochiminh.vn +thuathienhue.vn +tiengiang.vn +travinh.vn +tuyenquang.vn +vinhlong.vn +vinhphuc.vn +yenbai.vn // vu : https://en.wikipedia.org/wiki/.vu // http://www.vunic.vu/ @@ -6835,7 +6356,7 @@ edu.vu net.vu org.vu -// wf : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf +// wf : https://www.afnic.fr/wp-media/uploads/2022/12/afnic-naming-policy-2023-01-01.pdf wf // ws : https://en.wikipedia.org/wiki/.ws @@ -6847,7 +6368,7 @@ org.ws gov.ws edu.ws -// yt : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf +// yt : https://www.afnic.fr/wp-media/uploads/2022/12/afnic-naming-policy-2023-01-01.pdf yt // IDN ccTLDs @@ -7189,3447 +6710,4534 @@ org.zw // newGTLDs -// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2023-03-18T15:13:13Z +// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2023-09-30T15:11:25Z // This list is auto-generated, don't edit it manually. -// aaa : 2015-02-26 American Automobile Association, Inc. +// aaa : American Automobile Association, Inc. +// https://www.iana.org/domains/root/db/aaa.html aaa -// aarp : 2015-05-21 AARP +// aarp : AARP +// https://www.iana.org/domains/root/db/aarp.html aarp -// abarth : 2015-07-30 Fiat Chrysler Automobiles N.V. -abarth - -// abb : 2014-10-24 ABB Ltd +// abb : ABB Ltd +// https://www.iana.org/domains/root/db/abb.html abb -// abbott : 2014-07-24 Abbott Laboratories, Inc. +// abbott : Abbott Laboratories, Inc. +// https://www.iana.org/domains/root/db/abbott.html abbott -// abbvie : 2015-07-30 AbbVie Inc. +// abbvie : AbbVie Inc. +// https://www.iana.org/domains/root/db/abbvie.html abbvie -// abc : 2015-07-30 Disney Enterprises, Inc. +// abc : Disney Enterprises, Inc. +// https://www.iana.org/domains/root/db/abc.html abc -// able : 2015-06-25 Able Inc. +// able : Able Inc. +// https://www.iana.org/domains/root/db/able.html able -// abogado : 2014-04-24 Registry Services, LLC +// abogado : Registry Services, LLC +// https://www.iana.org/domains/root/db/abogado.html abogado -// abudhabi : 2015-07-30 Abu Dhabi Systems and Information Centre +// abudhabi : Abu Dhabi Systems and Information Centre +// https://www.iana.org/domains/root/db/abudhabi.html abudhabi -// academy : 2013-11-07 Binky Moon, LLC +// academy : Binky Moon, LLC +// https://www.iana.org/domains/root/db/academy.html academy -// accenture : 2014-08-15 Accenture plc +// accenture : Accenture plc +// https://www.iana.org/domains/root/db/accenture.html accenture -// accountant : 2014-11-20 dot Accountant Limited +// accountant : dot Accountant Limited +// https://www.iana.org/domains/root/db/accountant.html accountant -// accountants : 2014-03-20 Binky Moon, LLC +// accountants : Binky Moon, LLC +// https://www.iana.org/domains/root/db/accountants.html accountants -// aco : 2015-01-08 ACO Severin Ahlmann GmbH & Co. KG +// aco : ACO Severin Ahlmann GmbH & Co. KG +// https://www.iana.org/domains/root/db/aco.html aco -// actor : 2013-12-12 Dog Beach, LLC +// actor : Dog Beach, LLC +// https://www.iana.org/domains/root/db/actor.html actor -// ads : 2014-12-04 Charleston Road Registry Inc. +// ads : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/ads.html ads -// adult : 2014-10-16 ICM Registry AD LLC +// adult : ICM Registry AD LLC +// https://www.iana.org/domains/root/db/adult.html adult -// aeg : 2015-03-19 Aktiebolaget Electrolux +// aeg : Aktiebolaget Electrolux +// https://www.iana.org/domains/root/db/aeg.html aeg -// aetna : 2015-05-21 Aetna Life Insurance Company +// aetna : Aetna Life Insurance Company +// https://www.iana.org/domains/root/db/aetna.html aetna -// afl : 2014-10-02 Australian Football League +// afl : Australian Football League +// https://www.iana.org/domains/root/db/afl.html afl -// africa : 2014-03-24 ZA Central Registry NPC trading as Registry.Africa +// africa : ZA Central Registry NPC trading as Registry.Africa +// https://www.iana.org/domains/root/db/africa.html africa -// agakhan : 2015-04-23 Fondation Aga Khan (Aga Khan Foundation) +// agakhan : Fondation Aga Khan (Aga Khan Foundation) +// https://www.iana.org/domains/root/db/agakhan.html agakhan -// agency : 2013-11-14 Binky Moon, LLC +// agency : Binky Moon, LLC +// https://www.iana.org/domains/root/db/agency.html agency -// aig : 2014-12-18 American International Group, Inc. +// aig : American International Group, Inc. +// https://www.iana.org/domains/root/db/aig.html aig -// airbus : 2015-07-30 Airbus S.A.S. +// airbus : Airbus S.A.S. +// https://www.iana.org/domains/root/db/airbus.html airbus -// airforce : 2014-03-06 Dog Beach, LLC +// airforce : Dog Beach, LLC +// https://www.iana.org/domains/root/db/airforce.html airforce -// airtel : 2014-10-24 Bharti Airtel Limited +// airtel : Bharti Airtel Limited +// https://www.iana.org/domains/root/db/airtel.html airtel -// akdn : 2015-04-23 Fondation Aga Khan (Aga Khan Foundation) +// akdn : Fondation Aga Khan (Aga Khan Foundation) +// https://www.iana.org/domains/root/db/akdn.html akdn -// alfaromeo : 2015-07-31 Fiat Chrysler Automobiles N.V. -alfaromeo - -// alibaba : 2015-01-15 Alibaba Group Holding Limited +// alibaba : Alibaba Group Holding Limited +// https://www.iana.org/domains/root/db/alibaba.html alibaba -// alipay : 2015-01-15 Alibaba Group Holding Limited +// alipay : Alibaba Group Holding Limited +// https://www.iana.org/domains/root/db/alipay.html alipay -// allfinanz : 2014-07-03 Allfinanz Deutsche Vermögensberatung Aktiengesellschaft +// allfinanz : Allfinanz Deutsche Vermögensberatung Aktiengesellschaft +// https://www.iana.org/domains/root/db/allfinanz.html allfinanz -// allstate : 2015-07-31 Allstate Fire and Casualty Insurance Company +// allstate : Allstate Fire and Casualty Insurance Company +// https://www.iana.org/domains/root/db/allstate.html allstate -// ally : 2015-06-18 Ally Financial Inc. +// ally : Ally Financial Inc. +// https://www.iana.org/domains/root/db/ally.html ally -// alsace : 2014-07-02 Region Grand Est +// alsace : Region Grand Est +// https://www.iana.org/domains/root/db/alsace.html alsace -// alstom : 2015-07-30 ALSTOM +// alstom : ALSTOM +// https://www.iana.org/domains/root/db/alstom.html alstom -// amazon : 2019-12-19 Amazon Registry Services, Inc. +// amazon : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/amazon.html amazon -// americanexpress : 2015-07-31 American Express Travel Related Services Company, Inc. +// americanexpress : American Express Travel Related Services Company, Inc. +// https://www.iana.org/domains/root/db/americanexpress.html americanexpress -// americanfamily : 2015-07-23 AmFam, Inc. +// americanfamily : AmFam, Inc. +// https://www.iana.org/domains/root/db/americanfamily.html americanfamily -// amex : 2015-07-31 American Express Travel Related Services Company, Inc. +// amex : American Express Travel Related Services Company, Inc. +// https://www.iana.org/domains/root/db/amex.html amex -// amfam : 2015-07-23 AmFam, Inc. +// amfam : AmFam, Inc. +// https://www.iana.org/domains/root/db/amfam.html amfam -// amica : 2015-05-28 Amica Mutual Insurance Company +// amica : Amica Mutual Insurance Company +// https://www.iana.org/domains/root/db/amica.html amica -// amsterdam : 2014-07-24 Gemeente Amsterdam +// amsterdam : Gemeente Amsterdam +// https://www.iana.org/domains/root/db/amsterdam.html amsterdam -// analytics : 2014-12-18 Campus IP LLC +// analytics : Campus IP LLC +// https://www.iana.org/domains/root/db/analytics.html analytics -// android : 2014-08-07 Charleston Road Registry Inc. +// android : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/android.html android -// anquan : 2015-01-08 Beijing Qihu Keji Co., Ltd. +// anquan : Beijing Qihu Keji Co., Ltd. +// https://www.iana.org/domains/root/db/anquan.html anquan -// anz : 2015-07-31 Australia and New Zealand Banking Group Limited +// anz : Australia and New Zealand Banking Group Limited +// https://www.iana.org/domains/root/db/anz.html anz -// aol : 2015-09-17 Oath Inc. +// aol : Oath Inc. +// https://www.iana.org/domains/root/db/aol.html aol -// apartments : 2014-12-11 Binky Moon, LLC +// apartments : Binky Moon, LLC +// https://www.iana.org/domains/root/db/apartments.html apartments -// app : 2015-05-14 Charleston Road Registry Inc. +// app : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/app.html app -// apple : 2015-05-14 Apple Inc. +// apple : Apple Inc. +// https://www.iana.org/domains/root/db/apple.html apple -// aquarelle : 2014-07-24 Aquarelle.com +// aquarelle : Aquarelle.com +// https://www.iana.org/domains/root/db/aquarelle.html aquarelle -// arab : 2015-11-12 League of Arab States +// arab : League of Arab States +// https://www.iana.org/domains/root/db/arab.html arab -// aramco : 2014-11-20 Aramco Services Company +// aramco : Aramco Services Company +// https://www.iana.org/domains/root/db/aramco.html aramco -// archi : 2014-02-06 Identity Digital Limited +// archi : Identity Digital Limited +// https://www.iana.org/domains/root/db/archi.html archi -// army : 2014-03-06 Dog Beach, LLC +// army : Dog Beach, LLC +// https://www.iana.org/domains/root/db/army.html army -// art : 2016-03-24 UK Creative Ideas Limited +// art : UK Creative Ideas Limited +// https://www.iana.org/domains/root/db/art.html art -// arte : 2014-12-11 Association Relative à la Télévision Européenne G.E.I.E. +// arte : Association Relative à la Télévision Européenne G.E.I.E. +// https://www.iana.org/domains/root/db/arte.html arte -// asda : 2015-07-31 Wal-Mart Stores, Inc. +// asda : Wal-Mart Stores, Inc. +// https://www.iana.org/domains/root/db/asda.html asda -// associates : 2014-03-06 Binky Moon, LLC +// associates : Binky Moon, LLC +// https://www.iana.org/domains/root/db/associates.html associates -// athleta : 2015-07-30 The Gap, Inc. +// athleta : The Gap, Inc. +// https://www.iana.org/domains/root/db/athleta.html athleta -// attorney : 2014-03-20 Dog Beach, LLC +// attorney : Dog Beach, LLC +// https://www.iana.org/domains/root/db/attorney.html attorney -// auction : 2014-03-20 Dog Beach, LLC +// auction : Dog Beach, LLC +// https://www.iana.org/domains/root/db/auction.html auction -// audi : 2015-05-21 AUDI Aktiengesellschaft +// audi : AUDI Aktiengesellschaft +// https://www.iana.org/domains/root/db/audi.html audi -// audible : 2015-06-25 Amazon Registry Services, Inc. +// audible : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/audible.html audible -// audio : 2014-03-20 XYZ.COM LLC +// audio : XYZ.COM LLC +// https://www.iana.org/domains/root/db/audio.html audio -// auspost : 2015-08-13 Australian Postal Corporation +// auspost : Australian Postal Corporation +// https://www.iana.org/domains/root/db/auspost.html auspost -// author : 2014-12-18 Amazon Registry Services, Inc. +// author : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/author.html author -// auto : 2014-11-13 XYZ.COM LLC +// auto : XYZ.COM LLC +// https://www.iana.org/domains/root/db/auto.html auto -// autos : 2014-01-09 XYZ.COM LLC +// autos : XYZ.COM LLC +// https://www.iana.org/domains/root/db/autos.html autos -// avianca : 2015-01-08 Avianca Inc. +// avianca : Avianca Inc. +// https://www.iana.org/domains/root/db/avianca.html avianca -// aws : 2015-06-25 AWS Registry LLC +// aws : AWS Registry LLC +// https://www.iana.org/domains/root/db/aws.html aws -// axa : 2013-12-19 AXA Group Operations SAS +// axa : AXA Group Operations SAS +// https://www.iana.org/domains/root/db/axa.html axa -// azure : 2014-12-18 Microsoft Corporation +// azure : Microsoft Corporation +// https://www.iana.org/domains/root/db/azure.html azure -// baby : 2015-04-09 XYZ.COM LLC +// baby : XYZ.COM LLC +// https://www.iana.org/domains/root/db/baby.html baby -// baidu : 2015-01-08 Baidu, Inc. +// baidu : Baidu, Inc. +// https://www.iana.org/domains/root/db/baidu.html baidu -// banamex : 2015-07-30 Citigroup Inc. +// banamex : Citigroup Inc. +// https://www.iana.org/domains/root/db/banamex.html banamex -// bananarepublic : 2015-07-31 The Gap, Inc. +// bananarepublic : The Gap, Inc. +// https://www.iana.org/domains/root/db/bananarepublic.html bananarepublic -// band : 2014-06-12 Dog Beach, LLC +// band : Dog Beach, LLC +// https://www.iana.org/domains/root/db/band.html band -// bank : 2014-09-25 fTLD Registry Services LLC +// bank : fTLD Registry Services LLC +// https://www.iana.org/domains/root/db/bank.html bank -// bar : 2013-12-12 Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable +// bar : Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable +// https://www.iana.org/domains/root/db/bar.html bar -// barcelona : 2014-07-24 Municipi de Barcelona +// barcelona : Municipi de Barcelona +// https://www.iana.org/domains/root/db/barcelona.html barcelona -// barclaycard : 2014-11-20 Barclays Bank PLC +// barclaycard : Barclays Bank PLC +// https://www.iana.org/domains/root/db/barclaycard.html barclaycard -// barclays : 2014-11-20 Barclays Bank PLC +// barclays : Barclays Bank PLC +// https://www.iana.org/domains/root/db/barclays.html barclays -// barefoot : 2015-06-11 Gallo Vineyards, Inc. +// barefoot : Gallo Vineyards, Inc. +// https://www.iana.org/domains/root/db/barefoot.html barefoot -// bargains : 2013-11-14 Binky Moon, LLC +// bargains : Binky Moon, LLC +// https://www.iana.org/domains/root/db/bargains.html bargains -// baseball : 2015-10-29 MLB Advanced Media DH, LLC +// baseball : MLB Advanced Media DH, LLC +// https://www.iana.org/domains/root/db/baseball.html baseball -// basketball : 2015-08-20 Fédération Internationale de Basketball (FIBA) +// basketball : Fédération Internationale de Basketball (FIBA) +// https://www.iana.org/domains/root/db/basketball.html basketball -// bauhaus : 2014-04-17 Werkhaus GmbH +// bauhaus : Werkhaus GmbH +// https://www.iana.org/domains/root/db/bauhaus.html bauhaus -// bayern : 2014-01-23 Bayern Connect GmbH +// bayern : Bayern Connect GmbH +// https://www.iana.org/domains/root/db/bayern.html bayern -// bbc : 2014-12-18 British Broadcasting Corporation +// bbc : British Broadcasting Corporation +// https://www.iana.org/domains/root/db/bbc.html bbc -// bbt : 2015-07-23 BB&T Corporation +// bbt : BB&T Corporation +// https://www.iana.org/domains/root/db/bbt.html bbt -// bbva : 2014-10-02 BANCO BILBAO VIZCAYA ARGENTARIA, S.A. +// bbva : BANCO BILBAO VIZCAYA ARGENTARIA, S.A. +// https://www.iana.org/domains/root/db/bbva.html bbva -// bcg : 2015-04-02 The Boston Consulting Group, Inc. +// bcg : The Boston Consulting Group, Inc. +// https://www.iana.org/domains/root/db/bcg.html bcg -// bcn : 2014-07-24 Municipi de Barcelona +// bcn : Municipi de Barcelona +// https://www.iana.org/domains/root/db/bcn.html bcn -// beats : 2015-05-14 Beats Electronics, LLC +// beats : Beats Electronics, LLC +// https://www.iana.org/domains/root/db/beats.html beats -// beauty : 2015-12-03 XYZ.COM LLC +// beauty : XYZ.COM LLC +// https://www.iana.org/domains/root/db/beauty.html beauty -// beer : 2014-01-09 Registry Services, LLC +// beer : Registry Services, LLC +// https://www.iana.org/domains/root/db/beer.html beer -// bentley : 2014-12-18 Bentley Motors Limited +// bentley : Bentley Motors Limited +// https://www.iana.org/domains/root/db/bentley.html bentley -// berlin : 2013-10-31 dotBERLIN GmbH & Co. KG +// berlin : dotBERLIN GmbH & Co. KG +// https://www.iana.org/domains/root/db/berlin.html berlin -// best : 2013-12-19 BestTLD Pty Ltd +// best : BestTLD Pty Ltd +// https://www.iana.org/domains/root/db/best.html best -// bestbuy : 2015-07-31 BBY Solutions, Inc. +// bestbuy : BBY Solutions, Inc. +// https://www.iana.org/domains/root/db/bestbuy.html bestbuy -// bet : 2015-05-07 Identity Digital Limited +// bet : Identity Digital Limited +// https://www.iana.org/domains/root/db/bet.html bet -// bharti : 2014-01-09 Bharti Enterprises (Holding) Private Limited +// bharti : Bharti Enterprises (Holding) Private Limited +// https://www.iana.org/domains/root/db/bharti.html bharti -// bible : 2014-06-19 American Bible Society +// bible : American Bible Society +// https://www.iana.org/domains/root/db/bible.html bible -// bid : 2013-12-19 dot Bid Limited +// bid : dot Bid Limited +// https://www.iana.org/domains/root/db/bid.html bid -// bike : 2013-08-27 Binky Moon, LLC +// bike : Binky Moon, LLC +// https://www.iana.org/domains/root/db/bike.html bike -// bing : 2014-12-18 Microsoft Corporation +// bing : Microsoft Corporation +// https://www.iana.org/domains/root/db/bing.html bing -// bingo : 2014-12-04 Binky Moon, LLC +// bingo : Binky Moon, LLC +// https://www.iana.org/domains/root/db/bingo.html bingo -// bio : 2014-03-06 Identity Digital Limited +// bio : Identity Digital Limited +// https://www.iana.org/domains/root/db/bio.html bio -// black : 2014-01-16 Identity Digital Limited +// black : Identity Digital Limited +// https://www.iana.org/domains/root/db/black.html black -// blackfriday : 2014-01-16 Registry Services, LLC +// blackfriday : Registry Services, LLC +// https://www.iana.org/domains/root/db/blackfriday.html blackfriday -// blockbuster : 2015-07-30 Dish DBS Corporation +// blockbuster : Dish DBS Corporation +// https://www.iana.org/domains/root/db/blockbuster.html blockbuster -// blog : 2015-05-14 Knock Knock WHOIS There, LLC +// blog : Knock Knock WHOIS There, LLC +// https://www.iana.org/domains/root/db/blog.html blog -// bloomberg : 2014-07-17 Bloomberg IP Holdings LLC +// bloomberg : Bloomberg IP Holdings LLC +// https://www.iana.org/domains/root/db/bloomberg.html bloomberg -// blue : 2013-11-07 Identity Digital Limited +// blue : Identity Digital Limited +// https://www.iana.org/domains/root/db/blue.html blue -// bms : 2014-10-30 Bristol-Myers Squibb Company +// bms : Bristol-Myers Squibb Company +// https://www.iana.org/domains/root/db/bms.html bms -// bmw : 2014-01-09 Bayerische Motoren Werke Aktiengesellschaft +// bmw : Bayerische Motoren Werke Aktiengesellschaft +// https://www.iana.org/domains/root/db/bmw.html bmw -// bnpparibas : 2014-05-29 BNP Paribas +// bnpparibas : BNP Paribas +// https://www.iana.org/domains/root/db/bnpparibas.html bnpparibas -// boats : 2014-12-04 XYZ.COM LLC +// boats : XYZ.COM LLC +// https://www.iana.org/domains/root/db/boats.html boats -// boehringer : 2015-07-09 Boehringer Ingelheim International GmbH +// boehringer : Boehringer Ingelheim International GmbH +// https://www.iana.org/domains/root/db/boehringer.html boehringer -// bofa : 2015-07-31 Bank of America Corporation +// bofa : Bank of America Corporation +// https://www.iana.org/domains/root/db/bofa.html bofa -// bom : 2014-10-16 Núcleo de Informação e Coordenação do Ponto BR - NIC.br +// bom : Núcleo de Informação e Coordenação do Ponto BR - NIC.br +// https://www.iana.org/domains/root/db/bom.html bom -// bond : 2014-06-05 ShortDot SA +// bond : ShortDot SA +// https://www.iana.org/domains/root/db/bond.html bond -// boo : 2014-01-30 Charleston Road Registry Inc. +// boo : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/boo.html boo -// book : 2015-08-27 Amazon Registry Services, Inc. +// book : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/book.html book -// booking : 2015-07-16 Booking.com B.V. +// booking : Booking.com B.V. +// https://www.iana.org/domains/root/db/booking.html booking -// bosch : 2015-06-18 Robert Bosch GMBH +// bosch : Robert Bosch GMBH +// https://www.iana.org/domains/root/db/bosch.html bosch -// bostik : 2015-05-28 Bostik SA +// bostik : Bostik SA +// https://www.iana.org/domains/root/db/bostik.html bostik -// boston : 2015-12-10 Registry Services, LLC +// boston : Registry Services, LLC +// https://www.iana.org/domains/root/db/boston.html boston -// bot : 2014-12-18 Amazon Registry Services, Inc. +// bot : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/bot.html bot -// boutique : 2013-11-14 Binky Moon, LLC +// boutique : Binky Moon, LLC +// https://www.iana.org/domains/root/db/boutique.html boutique -// box : 2015-11-12 Intercap Registry Inc. +// box : Intercap Registry Inc. +// https://www.iana.org/domains/root/db/box.html box -// bradesco : 2014-12-18 Banco Bradesco S.A. +// bradesco : Banco Bradesco S.A. +// https://www.iana.org/domains/root/db/bradesco.html bradesco -// bridgestone : 2014-12-18 Bridgestone Corporation +// bridgestone : Bridgestone Corporation +// https://www.iana.org/domains/root/db/bridgestone.html bridgestone -// broadway : 2014-12-22 Celebrate Broadway, Inc. +// broadway : Celebrate Broadway, Inc. +// https://www.iana.org/domains/root/db/broadway.html broadway -// broker : 2014-12-11 Dog Beach, LLC +// broker : Dog Beach, LLC +// https://www.iana.org/domains/root/db/broker.html broker -// brother : 2015-01-29 Brother Industries, Ltd. +// brother : Brother Industries, Ltd. +// https://www.iana.org/domains/root/db/brother.html brother -// brussels : 2014-02-06 DNS.be vzw +// brussels : DNS.be vzw +// https://www.iana.org/domains/root/db/brussels.html brussels -// build : 2013-11-07 Plan Bee LLC +// build : Plan Bee LLC +// https://www.iana.org/domains/root/db/build.html build -// builders : 2013-11-07 Binky Moon, LLC +// builders : Binky Moon, LLC +// https://www.iana.org/domains/root/db/builders.html builders -// business : 2013-11-07 Binky Moon, LLC +// business : Binky Moon, LLC +// https://www.iana.org/domains/root/db/business.html business -// buy : 2014-12-18 Amazon Registry Services, Inc. +// buy : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/buy.html buy -// buzz : 2013-10-02 DOTSTRATEGY CO. +// buzz : DOTSTRATEGY CO. +// https://www.iana.org/domains/root/db/buzz.html buzz -// bzh : 2014-02-27 Association www.bzh +// bzh : Association www.bzh +// https://www.iana.org/domains/root/db/bzh.html bzh -// cab : 2013-10-24 Binky Moon, LLC +// cab : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cab.html cab -// cafe : 2015-02-11 Binky Moon, LLC +// cafe : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cafe.html cafe -// cal : 2014-07-24 Charleston Road Registry Inc. +// cal : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/cal.html cal -// call : 2014-12-18 Amazon Registry Services, Inc. +// call : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/call.html call -// calvinklein : 2015-07-30 PVH gTLD Holdings LLC +// calvinklein : PVH gTLD Holdings LLC +// https://www.iana.org/domains/root/db/calvinklein.html calvinklein -// cam : 2016-04-21 Cam Connecting SARL +// cam : Cam Connecting SARL +// https://www.iana.org/domains/root/db/cam.html cam -// camera : 2013-08-27 Binky Moon, LLC +// camera : Binky Moon, LLC +// https://www.iana.org/domains/root/db/camera.html camera -// camp : 2013-11-07 Binky Moon, LLC +// camp : Binky Moon, LLC +// https://www.iana.org/domains/root/db/camp.html camp -// canon : 2014-09-12 Canon Inc. +// canon : Canon Inc. +// https://www.iana.org/domains/root/db/canon.html canon -// capetown : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry +// capetown : ZA Central Registry NPC trading as ZA Central Registry +// https://www.iana.org/domains/root/db/capetown.html capetown -// capital : 2014-03-06 Binky Moon, LLC +// capital : Binky Moon, LLC +// https://www.iana.org/domains/root/db/capital.html capital -// capitalone : 2015-08-06 Capital One Financial Corporation +// capitalone : Capital One Financial Corporation +// https://www.iana.org/domains/root/db/capitalone.html capitalone -// car : 2015-01-22 XYZ.COM LLC +// car : XYZ.COM LLC +// https://www.iana.org/domains/root/db/car.html car -// caravan : 2013-12-12 Caravan International, Inc. +// caravan : Caravan International, Inc. +// https://www.iana.org/domains/root/db/caravan.html caravan -// cards : 2013-12-05 Binky Moon, LLC +// cards : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cards.html cards -// care : 2014-03-06 Binky Moon, LLC +// care : Binky Moon, LLC +// https://www.iana.org/domains/root/db/care.html care -// career : 2013-10-09 dotCareer LLC +// career : dotCareer LLC +// https://www.iana.org/domains/root/db/career.html career -// careers : 2013-10-02 Binky Moon, LLC +// careers : Binky Moon, LLC +// https://www.iana.org/domains/root/db/careers.html careers -// cars : 2014-11-13 XYZ.COM LLC +// cars : XYZ.COM LLC +// https://www.iana.org/domains/root/db/cars.html cars -// casa : 2013-11-21 Registry Services, LLC +// casa : Registry Services, LLC +// https://www.iana.org/domains/root/db/casa.html casa -// case : 2015-09-03 Digity, LLC +// case : Digity, LLC +// https://www.iana.org/domains/root/db/case.html case -// cash : 2014-03-06 Binky Moon, LLC +// cash : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cash.html cash -// casino : 2014-12-18 Binky Moon, LLC +// casino : Binky Moon, LLC +// https://www.iana.org/domains/root/db/casino.html casino -// catering : 2013-12-05 Binky Moon, LLC +// catering : Binky Moon, LLC +// https://www.iana.org/domains/root/db/catering.html catering -// catholic : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// catholic : Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// https://www.iana.org/domains/root/db/catholic.html catholic -// cba : 2014-06-26 COMMONWEALTH BANK OF AUSTRALIA +// cba : COMMONWEALTH BANK OF AUSTRALIA +// https://www.iana.org/domains/root/db/cba.html cba -// cbn : 2014-08-22 The Christian Broadcasting Network, Inc. +// cbn : The Christian Broadcasting Network, Inc. +// https://www.iana.org/domains/root/db/cbn.html cbn -// cbre : 2015-07-02 CBRE, Inc. +// cbre : CBRE, Inc. +// https://www.iana.org/domains/root/db/cbre.html cbre -// cbs : 2015-08-06 CBS Domains Inc. +// cbs : CBS Domains Inc. +// https://www.iana.org/domains/root/db/cbs.html cbs -// center : 2013-11-07 Binky Moon, LLC +// center : Binky Moon, LLC +// https://www.iana.org/domains/root/db/center.html center -// ceo : 2013-11-07 CEOTLD Pty Ltd +// ceo : XYZ.COM LLC +// https://www.iana.org/domains/root/db/ceo.html ceo -// cern : 2014-06-05 European Organization for Nuclear Research ("CERN") +// cern : European Organization for Nuclear Research ("CERN") +// https://www.iana.org/domains/root/db/cern.html cern -// cfa : 2014-08-28 CFA Institute +// cfa : CFA Institute +// https://www.iana.org/domains/root/db/cfa.html cfa -// cfd : 2014-12-11 ShortDot SA +// cfd : ShortDot SA +// https://www.iana.org/domains/root/db/cfd.html cfd -// chanel : 2015-04-09 Chanel International B.V. +// chanel : Chanel International B.V. +// https://www.iana.org/domains/root/db/chanel.html chanel -// channel : 2014-05-08 Charleston Road Registry Inc. +// channel : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/channel.html channel -// charity : 2018-04-11 Public Interest Registry +// charity : Public Interest Registry +// https://www.iana.org/domains/root/db/charity.html charity -// chase : 2015-04-30 JPMorgan Chase Bank, National Association +// chase : JPMorgan Chase Bank, National Association +// https://www.iana.org/domains/root/db/chase.html chase -// chat : 2014-12-04 Binky Moon, LLC +// chat : Binky Moon, LLC +// https://www.iana.org/domains/root/db/chat.html chat -// cheap : 2013-11-14 Binky Moon, LLC +// cheap : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cheap.html cheap -// chintai : 2015-06-11 CHINTAI Corporation +// chintai : CHINTAI Corporation +// https://www.iana.org/domains/root/db/chintai.html chintai -// christmas : 2013-11-21 XYZ.COM LLC +// christmas : XYZ.COM LLC +// https://www.iana.org/domains/root/db/christmas.html christmas -// chrome : 2014-07-24 Charleston Road Registry Inc. +// chrome : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/chrome.html chrome -// church : 2014-02-06 Binky Moon, LLC +// church : Binky Moon, LLC +// https://www.iana.org/domains/root/db/church.html church -// cipriani : 2015-02-19 Hotel Cipriani Srl +// cipriani : Hotel Cipriani Srl +// https://www.iana.org/domains/root/db/cipriani.html cipriani -// circle : 2014-12-18 Amazon Registry Services, Inc. +// circle : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/circle.html circle -// cisco : 2014-12-22 Cisco Technology, Inc. +// cisco : Cisco Technology, Inc. +// https://www.iana.org/domains/root/db/cisco.html cisco -// citadel : 2015-07-23 Citadel Domain LLC +// citadel : Citadel Domain LLC +// https://www.iana.org/domains/root/db/citadel.html citadel -// citi : 2015-07-30 Citigroup Inc. +// citi : Citigroup Inc. +// https://www.iana.org/domains/root/db/citi.html citi -// citic : 2014-01-09 CITIC Group Corporation +// citic : CITIC Group Corporation +// https://www.iana.org/domains/root/db/citic.html citic -// city : 2014-05-29 Binky Moon, LLC +// city : Binky Moon, LLC +// https://www.iana.org/domains/root/db/city.html city -// cityeats : 2014-12-11 Lifestyle Domain Holdings, Inc. +// cityeats : Lifestyle Domain Holdings, Inc. +// https://www.iana.org/domains/root/db/cityeats.html cityeats -// claims : 2014-03-20 Binky Moon, LLC +// claims : Binky Moon, LLC +// https://www.iana.org/domains/root/db/claims.html claims -// cleaning : 2013-12-05 Binky Moon, LLC +// cleaning : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cleaning.html cleaning -// click : 2014-06-05 Internet Naming Company LLC +// click : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/click.html click -// clinic : 2014-03-20 Binky Moon, LLC +// clinic : Binky Moon, LLC +// https://www.iana.org/domains/root/db/clinic.html clinic -// clinique : 2015-10-01 The Estée Lauder Companies Inc. +// clinique : The Estée Lauder Companies Inc. +// https://www.iana.org/domains/root/db/clinique.html clinique -// clothing : 2013-08-27 Binky Moon, LLC +// clothing : Binky Moon, LLC +// https://www.iana.org/domains/root/db/clothing.html clothing -// cloud : 2015-04-16 Aruba PEC S.p.A. +// cloud : Aruba PEC S.p.A. +// https://www.iana.org/domains/root/db/cloud.html cloud -// club : 2013-11-08 Registry Services, LLC +// club : Registry Services, LLC +// https://www.iana.org/domains/root/db/club.html club -// clubmed : 2015-06-25 Club Méditerranée S.A. +// clubmed : Club Méditerranée S.A. +// https://www.iana.org/domains/root/db/clubmed.html clubmed -// coach : 2014-10-09 Binky Moon, LLC +// coach : Binky Moon, LLC +// https://www.iana.org/domains/root/db/coach.html coach -// codes : 2013-10-31 Binky Moon, LLC +// codes : Binky Moon, LLC +// https://www.iana.org/domains/root/db/codes.html codes -// coffee : 2013-10-17 Binky Moon, LLC +// coffee : Binky Moon, LLC +// https://www.iana.org/domains/root/db/coffee.html coffee -// college : 2014-01-16 XYZ.COM LLC +// college : XYZ.COM LLC +// https://www.iana.org/domains/root/db/college.html college -// cologne : 2014-02-05 dotKoeln GmbH +// cologne : dotKoeln GmbH +// https://www.iana.org/domains/root/db/cologne.html cologne -// comcast : 2015-07-23 Comcast IP Holdings I, LLC +// comcast : Comcast IP Holdings I, LLC +// https://www.iana.org/domains/root/db/comcast.html comcast -// commbank : 2014-06-26 COMMONWEALTH BANK OF AUSTRALIA +// commbank : COMMONWEALTH BANK OF AUSTRALIA +// https://www.iana.org/domains/root/db/commbank.html commbank -// community : 2013-12-05 Binky Moon, LLC +// community : Binky Moon, LLC +// https://www.iana.org/domains/root/db/community.html community -// company : 2013-11-07 Binky Moon, LLC +// company : Binky Moon, LLC +// https://www.iana.org/domains/root/db/company.html company -// compare : 2015-10-08 Registry Services, LLC +// compare : Registry Services, LLC +// https://www.iana.org/domains/root/db/compare.html compare -// computer : 2013-10-24 Binky Moon, LLC +// computer : Binky Moon, LLC +// https://www.iana.org/domains/root/db/computer.html computer -// comsec : 2015-01-08 VeriSign, Inc. +// comsec : VeriSign, Inc. +// https://www.iana.org/domains/root/db/comsec.html comsec -// condos : 2013-12-05 Binky Moon, LLC +// condos : Binky Moon, LLC +// https://www.iana.org/domains/root/db/condos.html condos -// construction : 2013-09-16 Binky Moon, LLC +// construction : Binky Moon, LLC +// https://www.iana.org/domains/root/db/construction.html construction -// consulting : 2013-12-05 Dog Beach, LLC +// consulting : Dog Beach, LLC +// https://www.iana.org/domains/root/db/consulting.html consulting -// contact : 2015-01-08 Dog Beach, LLC +// contact : Dog Beach, LLC +// https://www.iana.org/domains/root/db/contact.html contact -// contractors : 2013-09-10 Binky Moon, LLC +// contractors : Binky Moon, LLC +// https://www.iana.org/domains/root/db/contractors.html contractors -// cooking : 2013-11-21 Registry Services, LLC +// cooking : Registry Services, LLC +// https://www.iana.org/domains/root/db/cooking.html cooking -// cookingchannel : 2015-07-02 Lifestyle Domain Holdings, Inc. -cookingchannel - -// cool : 2013-11-14 Binky Moon, LLC +// cool : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cool.html cool -// corsica : 2014-09-25 Collectivité de Corse +// corsica : Collectivité de Corse +// https://www.iana.org/domains/root/db/corsica.html corsica -// country : 2013-12-19 Internet Naming Company LLC +// country : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/country.html country -// coupon : 2015-02-26 Amazon Registry Services, Inc. +// coupon : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/coupon.html coupon -// coupons : 2015-03-26 Binky Moon, LLC +// coupons : Binky Moon, LLC +// https://www.iana.org/domains/root/db/coupons.html coupons -// courses : 2014-12-04 Registry Services, LLC +// courses : Registry Services, LLC +// https://www.iana.org/domains/root/db/courses.html courses -// cpa : 2019-06-10 American Institute of Certified Public Accountants +// cpa : American Institute of Certified Public Accountants +// https://www.iana.org/domains/root/db/cpa.html cpa -// credit : 2014-03-20 Binky Moon, LLC +// credit : Binky Moon, LLC +// https://www.iana.org/domains/root/db/credit.html credit -// creditcard : 2014-03-20 Binky Moon, LLC +// creditcard : Binky Moon, LLC +// https://www.iana.org/domains/root/db/creditcard.html creditcard -// creditunion : 2015-01-22 DotCooperation LLC +// creditunion : DotCooperation LLC +// https://www.iana.org/domains/root/db/creditunion.html creditunion -// cricket : 2014-10-09 dot Cricket Limited +// cricket : dot Cricket Limited +// https://www.iana.org/domains/root/db/cricket.html cricket -// crown : 2014-10-24 Crown Equipment Corporation +// crown : Crown Equipment Corporation +// https://www.iana.org/domains/root/db/crown.html crown -// crs : 2014-04-03 Federated Co-operatives Limited +// crs : Federated Co-operatives Limited +// https://www.iana.org/domains/root/db/crs.html crs -// cruise : 2015-12-10 Viking River Cruises (Bermuda) Ltd. +// cruise : Viking River Cruises (Bermuda) Ltd. +// https://www.iana.org/domains/root/db/cruise.html cruise -// cruises : 2013-12-05 Binky Moon, LLC +// cruises : Binky Moon, LLC +// https://www.iana.org/domains/root/db/cruises.html cruises -// cuisinella : 2014-04-03 SCHMIDT GROUPE S.A.S. +// cuisinella : SCHMIDT GROUPE S.A.S. +// https://www.iana.org/domains/root/db/cuisinella.html cuisinella -// cymru : 2014-05-08 Nominet UK +// cymru : Nominet UK +// https://www.iana.org/domains/root/db/cymru.html cymru -// cyou : 2015-01-22 ShortDot SA +// cyou : ShortDot SA +// https://www.iana.org/domains/root/db/cyou.html cyou -// dabur : 2014-02-06 Dabur India Limited +// dabur : Dabur India Limited +// https://www.iana.org/domains/root/db/dabur.html dabur -// dad : 2014-01-23 Charleston Road Registry Inc. +// dad : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/dad.html dad -// dance : 2013-10-24 Dog Beach, LLC +// dance : Dog Beach, LLC +// https://www.iana.org/domains/root/db/dance.html dance -// data : 2016-06-02 Dish DBS Corporation +// data : Dish DBS Corporation +// https://www.iana.org/domains/root/db/data.html data -// date : 2014-11-20 dot Date Limited +// date : dot Date Limited +// https://www.iana.org/domains/root/db/date.html date -// dating : 2013-12-05 Binky Moon, LLC +// dating : Binky Moon, LLC +// https://www.iana.org/domains/root/db/dating.html dating -// datsun : 2014-03-27 NISSAN MOTOR CO., LTD. +// datsun : NISSAN MOTOR CO., LTD. +// https://www.iana.org/domains/root/db/datsun.html datsun -// day : 2014-01-30 Charleston Road Registry Inc. +// day : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/day.html day -// dclk : 2014-11-20 Charleston Road Registry Inc. +// dclk : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/dclk.html dclk -// dds : 2015-05-07 Registry Services, LLC +// dds : Registry Services, LLC +// https://www.iana.org/domains/root/db/dds.html dds -// deal : 2015-06-25 Amazon Registry Services, Inc. +// deal : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/deal.html deal -// dealer : 2014-12-22 Intercap Registry Inc. +// dealer : Intercap Registry Inc. +// https://www.iana.org/domains/root/db/dealer.html dealer -// deals : 2014-05-22 Binky Moon, LLC +// deals : Binky Moon, LLC +// https://www.iana.org/domains/root/db/deals.html deals -// degree : 2014-03-06 Dog Beach, LLC +// degree : Dog Beach, LLC +// https://www.iana.org/domains/root/db/degree.html degree -// delivery : 2014-09-11 Binky Moon, LLC +// delivery : Binky Moon, LLC +// https://www.iana.org/domains/root/db/delivery.html delivery -// dell : 2014-10-24 Dell Inc. +// dell : Dell Inc. +// https://www.iana.org/domains/root/db/dell.html dell -// deloitte : 2015-07-31 Deloitte Touche Tohmatsu +// deloitte : Deloitte Touche Tohmatsu +// https://www.iana.org/domains/root/db/deloitte.html deloitte -// delta : 2015-02-19 Delta Air Lines, Inc. +// delta : Delta Air Lines, Inc. +// https://www.iana.org/domains/root/db/delta.html delta -// democrat : 2013-10-24 Dog Beach, LLC +// democrat : Dog Beach, LLC +// https://www.iana.org/domains/root/db/democrat.html democrat -// dental : 2014-03-20 Binky Moon, LLC +// dental : Binky Moon, LLC +// https://www.iana.org/domains/root/db/dental.html dental -// dentist : 2014-03-20 Dog Beach, LLC +// dentist : Dog Beach, LLC +// https://www.iana.org/domains/root/db/dentist.html dentist -// desi : 2013-11-14 Desi Networks LLC +// desi : Desi Networks LLC +// https://www.iana.org/domains/root/db/desi.html desi -// design : 2014-11-07 Registry Services, LLC +// design : Registry Services, LLC +// https://www.iana.org/domains/root/db/design.html design -// dev : 2014-10-16 Charleston Road Registry Inc. +// dev : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/dev.html dev -// dhl : 2015-07-23 Deutsche Post AG +// dhl : Deutsche Post AG +// https://www.iana.org/domains/root/db/dhl.html dhl -// diamonds : 2013-09-22 Binky Moon, LLC +// diamonds : Binky Moon, LLC +// https://www.iana.org/domains/root/db/diamonds.html diamonds -// diet : 2014-06-26 XYZ.COM LLC +// diet : XYZ.COM LLC +// https://www.iana.org/domains/root/db/diet.html diet -// digital : 2014-03-06 Binky Moon, LLC +// digital : Binky Moon, LLC +// https://www.iana.org/domains/root/db/digital.html digital -// direct : 2014-04-10 Binky Moon, LLC +// direct : Binky Moon, LLC +// https://www.iana.org/domains/root/db/direct.html direct -// directory : 2013-09-20 Binky Moon, LLC +// directory : Binky Moon, LLC +// https://www.iana.org/domains/root/db/directory.html directory -// discount : 2014-03-06 Binky Moon, LLC +// discount : Binky Moon, LLC +// https://www.iana.org/domains/root/db/discount.html discount -// discover : 2015-07-23 Discover Financial Services +// discover : Discover Financial Services +// https://www.iana.org/domains/root/db/discover.html discover -// dish : 2015-07-30 Dish DBS Corporation +// dish : Dish DBS Corporation +// https://www.iana.org/domains/root/db/dish.html dish -// diy : 2015-11-05 Lifestyle Domain Holdings, Inc. +// diy : Lifestyle Domain Holdings, Inc. +// https://www.iana.org/domains/root/db/diy.html diy -// dnp : 2013-12-13 Dai Nippon Printing Co., Ltd. +// dnp : Dai Nippon Printing Co., Ltd. +// https://www.iana.org/domains/root/db/dnp.html dnp -// docs : 2014-10-16 Charleston Road Registry Inc. +// docs : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/docs.html docs -// doctor : 2016-06-02 Binky Moon, LLC +// doctor : Binky Moon, LLC +// https://www.iana.org/domains/root/db/doctor.html doctor -// dog : 2014-12-04 Binky Moon, LLC +// dog : Binky Moon, LLC +// https://www.iana.org/domains/root/db/dog.html dog -// domains : 2013-10-17 Binky Moon, LLC +// domains : Binky Moon, LLC +// https://www.iana.org/domains/root/db/domains.html domains -// dot : 2015-05-21 Dish DBS Corporation +// dot : Dish DBS Corporation +// https://www.iana.org/domains/root/db/dot.html dot -// download : 2014-11-20 dot Support Limited +// download : dot Support Limited +// https://www.iana.org/domains/root/db/download.html download -// drive : 2015-03-05 Charleston Road Registry Inc. +// drive : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/drive.html drive -// dtv : 2015-06-04 Dish DBS Corporation +// dtv : Dish DBS Corporation +// https://www.iana.org/domains/root/db/dtv.html dtv -// dubai : 2015-01-01 Dubai Smart Government Department +// dubai : Dubai Smart Government Department +// https://www.iana.org/domains/root/db/dubai.html dubai -// dunlop : 2015-07-02 The Goodyear Tire & Rubber Company +// dunlop : The Goodyear Tire & Rubber Company +// https://www.iana.org/domains/root/db/dunlop.html dunlop -// dupont : 2015-06-25 DuPont Specialty Products USA, LLC +// dupont : DuPont Specialty Products USA, LLC +// https://www.iana.org/domains/root/db/dupont.html dupont -// durban : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry +// durban : ZA Central Registry NPC trading as ZA Central Registry +// https://www.iana.org/domains/root/db/durban.html durban -// dvag : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG +// dvag : Deutsche Vermögensberatung Aktiengesellschaft DVAG +// https://www.iana.org/domains/root/db/dvag.html dvag -// dvr : 2016-05-26 DISH Technologies L.L.C. +// dvr : DISH Technologies L.L.C. +// https://www.iana.org/domains/root/db/dvr.html dvr -// earth : 2014-12-04 Interlink Systems Innovation Institute K.K. +// earth : Interlink Systems Innovation Institute K.K. +// https://www.iana.org/domains/root/db/earth.html earth -// eat : 2014-01-23 Charleston Road Registry Inc. +// eat : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/eat.html eat -// eco : 2016-07-08 Big Room Inc. +// eco : Big Room Inc. +// https://www.iana.org/domains/root/db/eco.html eco -// edeka : 2014-12-18 EDEKA Verband kaufmännischer Genossenschaften e.V. +// edeka : EDEKA Verband kaufmännischer Genossenschaften e.V. +// https://www.iana.org/domains/root/db/edeka.html edeka -// education : 2013-11-07 Binky Moon, LLC +// education : Binky Moon, LLC +// https://www.iana.org/domains/root/db/education.html education -// email : 2013-10-31 Binky Moon, LLC +// email : Binky Moon, LLC +// https://www.iana.org/domains/root/db/email.html email -// emerck : 2014-04-03 Merck KGaA +// emerck : Merck KGaA +// https://www.iana.org/domains/root/db/emerck.html emerck -// energy : 2014-09-11 Binky Moon, LLC +// energy : Binky Moon, LLC +// https://www.iana.org/domains/root/db/energy.html energy -// engineer : 2014-03-06 Dog Beach, LLC +// engineer : Dog Beach, LLC +// https://www.iana.org/domains/root/db/engineer.html engineer -// engineering : 2014-03-06 Binky Moon, LLC +// engineering : Binky Moon, LLC +// https://www.iana.org/domains/root/db/engineering.html engineering -// enterprises : 2013-09-20 Binky Moon, LLC +// enterprises : Binky Moon, LLC +// https://www.iana.org/domains/root/db/enterprises.html enterprises -// epson : 2014-12-04 Seiko Epson Corporation +// epson : Seiko Epson Corporation +// https://www.iana.org/domains/root/db/epson.html epson -// equipment : 2013-08-27 Binky Moon, LLC +// equipment : Binky Moon, LLC +// https://www.iana.org/domains/root/db/equipment.html equipment -// ericsson : 2015-07-09 Telefonaktiebolaget L M Ericsson +// ericsson : Telefonaktiebolaget L M Ericsson +// https://www.iana.org/domains/root/db/ericsson.html ericsson -// erni : 2014-04-03 ERNI Group Holding AG +// erni : ERNI Group Holding AG +// https://www.iana.org/domains/root/db/erni.html erni -// esq : 2014-05-08 Charleston Road Registry Inc. +// esq : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/esq.html esq -// estate : 2013-08-27 Binky Moon, LLC +// estate : Binky Moon, LLC +// https://www.iana.org/domains/root/db/estate.html estate -// etisalat : 2015-09-03 Emirates Telecommunications Corporation (trading as Etisalat) +// etisalat : Emirates Telecommunications Corporation (trading as Etisalat) +// https://www.iana.org/domains/root/db/etisalat.html etisalat -// eurovision : 2014-04-24 European Broadcasting Union (EBU) +// eurovision : European Broadcasting Union (EBU) +// https://www.iana.org/domains/root/db/eurovision.html eurovision -// eus : 2013-12-12 Puntueus Fundazioa +// eus : Puntueus Fundazioa +// https://www.iana.org/domains/root/db/eus.html eus -// events : 2013-12-05 Binky Moon, LLC +// events : Binky Moon, LLC +// https://www.iana.org/domains/root/db/events.html events -// exchange : 2014-03-06 Binky Moon, LLC +// exchange : Binky Moon, LLC +// https://www.iana.org/domains/root/db/exchange.html exchange -// expert : 2013-11-21 Binky Moon, LLC +// expert : Binky Moon, LLC +// https://www.iana.org/domains/root/db/expert.html expert -// exposed : 2013-12-05 Binky Moon, LLC +// exposed : Binky Moon, LLC +// https://www.iana.org/domains/root/db/exposed.html exposed -// express : 2015-02-11 Binky Moon, LLC +// express : Binky Moon, LLC +// https://www.iana.org/domains/root/db/express.html express -// extraspace : 2015-05-14 Extra Space Storage LLC +// extraspace : Extra Space Storage LLC +// https://www.iana.org/domains/root/db/extraspace.html extraspace -// fage : 2014-12-18 Fage International S.A. +// fage : Fage International S.A. +// https://www.iana.org/domains/root/db/fage.html fage -// fail : 2014-03-06 Binky Moon, LLC +// fail : Binky Moon, LLC +// https://www.iana.org/domains/root/db/fail.html fail -// fairwinds : 2014-11-13 FairWinds Partners, LLC +// fairwinds : FairWinds Partners, LLC +// https://www.iana.org/domains/root/db/fairwinds.html fairwinds -// faith : 2014-11-20 dot Faith Limited +// faith : dot Faith Limited +// https://www.iana.org/domains/root/db/faith.html faith -// family : 2015-04-02 Dog Beach, LLC +// family : Dog Beach, LLC +// https://www.iana.org/domains/root/db/family.html family -// fan : 2014-03-06 Dog Beach, LLC +// fan : Dog Beach, LLC +// https://www.iana.org/domains/root/db/fan.html fan -// fans : 2014-11-07 ZDNS International Limited +// fans : ZDNS International Limited +// https://www.iana.org/domains/root/db/fans.html fans -// farm : 2013-11-07 Binky Moon, LLC +// farm : Binky Moon, LLC +// https://www.iana.org/domains/root/db/farm.html farm -// farmers : 2015-07-09 Farmers Insurance Exchange +// farmers : Farmers Insurance Exchange +// https://www.iana.org/domains/root/db/farmers.html farmers -// fashion : 2014-07-03 Registry Services, LLC +// fashion : Registry Services, LLC +// https://www.iana.org/domains/root/db/fashion.html fashion -// fast : 2014-12-18 Amazon Registry Services, Inc. +// fast : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/fast.html fast -// fedex : 2015-08-06 Federal Express Corporation +// fedex : Federal Express Corporation +// https://www.iana.org/domains/root/db/fedex.html fedex -// feedback : 2013-12-19 Top Level Spectrum, Inc. +// feedback : Top Level Spectrum, Inc. +// https://www.iana.org/domains/root/db/feedback.html feedback -// ferrari : 2015-07-31 Fiat Chrysler Automobiles N.V. +// ferrari : Fiat Chrysler Automobiles N.V. +// https://www.iana.org/domains/root/db/ferrari.html ferrari -// ferrero : 2014-12-18 Ferrero Trading Lux S.A. +// ferrero : Ferrero Trading Lux S.A. +// https://www.iana.org/domains/root/db/ferrero.html ferrero -// fiat : 2015-07-31 Fiat Chrysler Automobiles N.V. -fiat - -// fidelity : 2015-07-30 Fidelity Brokerage Services LLC +// fidelity : Fidelity Brokerage Services LLC +// https://www.iana.org/domains/root/db/fidelity.html fidelity -// fido : 2015-08-06 Rogers Communications Canada Inc. +// fido : Rogers Communications Canada Inc. +// https://www.iana.org/domains/root/db/fido.html fido -// film : 2015-01-08 Motion Picture Domain Registry Pty Ltd +// film : Motion Picture Domain Registry Pty Ltd +// https://www.iana.org/domains/root/db/film.html film -// final : 2014-10-16 Núcleo de Informação e Coordenação do Ponto BR - NIC.br +// final : Núcleo de Informação e Coordenação do Ponto BR - NIC.br +// https://www.iana.org/domains/root/db/final.html final -// finance : 2014-03-20 Binky Moon, LLC +// finance : Binky Moon, LLC +// https://www.iana.org/domains/root/db/finance.html finance -// financial : 2014-03-06 Binky Moon, LLC +// financial : Binky Moon, LLC +// https://www.iana.org/domains/root/db/financial.html financial -// fire : 2015-06-25 Amazon Registry Services, Inc. +// fire : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/fire.html fire -// firestone : 2014-12-18 Bridgestone Licensing Services, Inc +// firestone : Bridgestone Licensing Services, Inc +// https://www.iana.org/domains/root/db/firestone.html firestone -// firmdale : 2014-03-27 Firmdale Holdings Limited +// firmdale : Firmdale Holdings Limited +// https://www.iana.org/domains/root/db/firmdale.html firmdale -// fish : 2013-12-12 Binky Moon, LLC +// fish : Binky Moon, LLC +// https://www.iana.org/domains/root/db/fish.html fish -// fishing : 2013-11-21 Registry Services, LLC +// fishing : Registry Services, LLC +// https://www.iana.org/domains/root/db/fishing.html fishing -// fit : 2014-11-07 Registry Services, LLC +// fit : Registry Services, LLC +// https://www.iana.org/domains/root/db/fit.html fit -// fitness : 2014-03-06 Binky Moon, LLC +// fitness : Binky Moon, LLC +// https://www.iana.org/domains/root/db/fitness.html fitness -// flickr : 2015-04-02 Flickr, Inc. +// flickr : Flickr, Inc. +// https://www.iana.org/domains/root/db/flickr.html flickr -// flights : 2013-12-05 Binky Moon, LLC +// flights : Binky Moon, LLC +// https://www.iana.org/domains/root/db/flights.html flights -// flir : 2015-07-23 FLIR Systems, Inc. +// flir : FLIR Systems, Inc. +// https://www.iana.org/domains/root/db/flir.html flir -// florist : 2013-11-07 Binky Moon, LLC +// florist : Binky Moon, LLC +// https://www.iana.org/domains/root/db/florist.html florist -// flowers : 2014-10-09 XYZ.COM LLC +// flowers : XYZ.COM LLC +// https://www.iana.org/domains/root/db/flowers.html flowers -// fly : 2014-05-08 Charleston Road Registry Inc. +// fly : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/fly.html fly -// foo : 2014-01-23 Charleston Road Registry Inc. +// foo : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/foo.html foo -// food : 2016-04-21 Lifestyle Domain Holdings, Inc. +// food : Lifestyle Domain Holdings, Inc. +// https://www.iana.org/domains/root/db/food.html food -// foodnetwork : 2015-07-02 Lifestyle Domain Holdings, Inc. -foodnetwork - -// football : 2014-12-18 Binky Moon, LLC +// football : Binky Moon, LLC +// https://www.iana.org/domains/root/db/football.html football -// ford : 2014-11-13 Ford Motor Company +// ford : Ford Motor Company +// https://www.iana.org/domains/root/db/ford.html ford -// forex : 2014-12-11 Dog Beach, LLC +// forex : Dog Beach, LLC +// https://www.iana.org/domains/root/db/forex.html forex -// forsale : 2014-05-22 Dog Beach, LLC +// forsale : Dog Beach, LLC +// https://www.iana.org/domains/root/db/forsale.html forsale -// forum : 2015-04-02 Fegistry, LLC +// forum : Fegistry, LLC +// https://www.iana.org/domains/root/db/forum.html forum -// foundation : 2013-12-05 Public Interest Registry +// foundation : Public Interest Registry +// https://www.iana.org/domains/root/db/foundation.html foundation -// fox : 2015-09-11 FOX Registry, LLC +// fox : FOX Registry, LLC +// https://www.iana.org/domains/root/db/fox.html fox -// free : 2015-12-10 Amazon Registry Services, Inc. +// free : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/free.html free -// fresenius : 2015-07-30 Fresenius Immobilien-Verwaltungs-GmbH +// fresenius : Fresenius Immobilien-Verwaltungs-GmbH +// https://www.iana.org/domains/root/db/fresenius.html fresenius -// frl : 2014-05-15 FRLregistry B.V. +// frl : FRLregistry B.V. +// https://www.iana.org/domains/root/db/frl.html frl -// frogans : 2013-12-19 OP3FT +// frogans : OP3FT +// https://www.iana.org/domains/root/db/frogans.html frogans -// frontdoor : 2015-07-02 Lifestyle Domain Holdings, Inc. +// frontdoor : Lifestyle Domain Holdings, Inc. +// https://www.iana.org/domains/root/db/frontdoor.html frontdoor -// frontier : 2015-02-05 Frontier Communications Corporation +// frontier : Frontier Communications Corporation +// https://www.iana.org/domains/root/db/frontier.html frontier -// ftr : 2015-07-16 Frontier Communications Corporation +// ftr : Frontier Communications Corporation +// https://www.iana.org/domains/root/db/ftr.html ftr -// fujitsu : 2015-07-30 Fujitsu Limited +// fujitsu : Fujitsu Limited +// https://www.iana.org/domains/root/db/fujitsu.html fujitsu -// fun : 2016-01-14 Radix FZC +// fun : Radix FZC DMCC +// https://www.iana.org/domains/root/db/fun.html fun -// fund : 2014-03-20 Binky Moon, LLC +// fund : Binky Moon, LLC +// https://www.iana.org/domains/root/db/fund.html fund -// furniture : 2014-03-20 Binky Moon, LLC +// furniture : Binky Moon, LLC +// https://www.iana.org/domains/root/db/furniture.html furniture -// futbol : 2013-09-20 Dog Beach, LLC +// futbol : Dog Beach, LLC +// https://www.iana.org/domains/root/db/futbol.html futbol -// fyi : 2015-04-02 Binky Moon, LLC +// fyi : Binky Moon, LLC +// https://www.iana.org/domains/root/db/fyi.html fyi -// gal : 2013-11-07 Asociación puntoGAL +// gal : Asociación puntoGAL +// https://www.iana.org/domains/root/db/gal.html gal -// gallery : 2013-09-13 Binky Moon, LLC +// gallery : Binky Moon, LLC +// https://www.iana.org/domains/root/db/gallery.html gallery -// gallo : 2015-06-11 Gallo Vineyards, Inc. +// gallo : Gallo Vineyards, Inc. +// https://www.iana.org/domains/root/db/gallo.html gallo -// gallup : 2015-02-19 Gallup, Inc. +// gallup : Gallup, Inc. +// https://www.iana.org/domains/root/db/gallup.html gallup -// game : 2015-05-28 XYZ.COM LLC +// game : XYZ.COM LLC +// https://www.iana.org/domains/root/db/game.html game -// games : 2015-05-28 Dog Beach, LLC +// games : Dog Beach, LLC +// https://www.iana.org/domains/root/db/games.html games -// gap : 2015-07-31 The Gap, Inc. +// gap : The Gap, Inc. +// https://www.iana.org/domains/root/db/gap.html gap -// garden : 2014-06-26 Registry Services, LLC +// garden : Registry Services, LLC +// https://www.iana.org/domains/root/db/garden.html garden -// gay : 2019-05-23 Top Level Design, LLC +// gay : Registry Services, LLC +// https://www.iana.org/domains/root/db/gay.html gay -// gbiz : 2014-07-17 Charleston Road Registry Inc. +// gbiz : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/gbiz.html gbiz -// gdn : 2014-07-31 Joint Stock Company "Navigation-information systems" +// gdn : Joint Stock Company "Navigation-information systems" +// https://www.iana.org/domains/root/db/gdn.html gdn -// gea : 2014-12-04 GEA Group Aktiengesellschaft +// gea : GEA Group Aktiengesellschaft +// https://www.iana.org/domains/root/db/gea.html gea -// gent : 2014-01-23 Easyhost BV +// gent : Easyhost BV +// https://www.iana.org/domains/root/db/gent.html gent -// genting : 2015-03-12 Resorts World Inc Pte. Ltd. +// genting : Resorts World Inc Pte. Ltd. +// https://www.iana.org/domains/root/db/genting.html genting -// george : 2015-07-31 Wal-Mart Stores, Inc. +// george : Wal-Mart Stores, Inc. +// https://www.iana.org/domains/root/db/george.html george -// ggee : 2014-01-09 GMO Internet, Inc. +// ggee : GMO Internet, Inc. +// https://www.iana.org/domains/root/db/ggee.html ggee -// gift : 2013-10-17 DotGift, LLC +// gift : DotGift, LLC +// https://www.iana.org/domains/root/db/gift.html gift -// gifts : 2014-07-03 Binky Moon, LLC +// gifts : Binky Moon, LLC +// https://www.iana.org/domains/root/db/gifts.html gifts -// gives : 2014-03-06 Public Interest Registry +// gives : Public Interest Registry +// https://www.iana.org/domains/root/db/gives.html gives -// giving : 2014-11-13 Public Interest Registry +// giving : Public Interest Registry +// https://www.iana.org/domains/root/db/giving.html giving -// glass : 2013-11-07 Binky Moon, LLC +// glass : Binky Moon, LLC +// https://www.iana.org/domains/root/db/glass.html glass -// gle : 2014-07-24 Charleston Road Registry Inc. +// gle : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/gle.html gle -// global : 2014-04-17 Identity Digital Limited +// global : Identity Digital Limited +// https://www.iana.org/domains/root/db/global.html global -// globo : 2013-12-19 Globo Comunicação e Participações S.A +// globo : Globo Comunicação e Participações S.A +// https://www.iana.org/domains/root/db/globo.html globo -// gmail : 2014-05-01 Charleston Road Registry Inc. +// gmail : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/gmail.html gmail -// gmbh : 2016-01-29 Binky Moon, LLC +// gmbh : Binky Moon, LLC +// https://www.iana.org/domains/root/db/gmbh.html gmbh -// gmo : 2014-01-09 GMO Internet, Inc. +// gmo : GMO Internet, Inc. +// https://www.iana.org/domains/root/db/gmo.html gmo -// gmx : 2014-04-24 1&1 Mail & Media GmbH +// gmx : 1&1 Mail & Media GmbH +// https://www.iana.org/domains/root/db/gmx.html gmx -// godaddy : 2015-07-23 Go Daddy East, LLC +// godaddy : Go Daddy East, LLC +// https://www.iana.org/domains/root/db/godaddy.html godaddy -// gold : 2015-01-22 Binky Moon, LLC +// gold : Binky Moon, LLC +// https://www.iana.org/domains/root/db/gold.html gold -// goldpoint : 2014-11-20 YODOBASHI CAMERA CO.,LTD. +// goldpoint : YODOBASHI CAMERA CO.,LTD. +// https://www.iana.org/domains/root/db/goldpoint.html goldpoint -// golf : 2014-12-18 Binky Moon, LLC +// golf : Binky Moon, LLC +// https://www.iana.org/domains/root/db/golf.html golf -// goo : 2014-12-18 NTT Resonant Inc. +// goo : NTT Resonant Inc. +// https://www.iana.org/domains/root/db/goo.html goo -// goodyear : 2015-07-02 The Goodyear Tire & Rubber Company +// goodyear : The Goodyear Tire & Rubber Company +// https://www.iana.org/domains/root/db/goodyear.html goodyear -// goog : 2014-11-20 Charleston Road Registry Inc. +// goog : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/goog.html goog -// google : 2014-07-24 Charleston Road Registry Inc. +// google : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/google.html google -// gop : 2014-01-16 Republican State Leadership Committee, Inc. +// gop : Republican State Leadership Committee, Inc. +// https://www.iana.org/domains/root/db/gop.html gop -// got : 2014-12-18 Amazon Registry Services, Inc. +// got : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/got.html got -// grainger : 2015-05-07 Grainger Registry Services, LLC +// grainger : Grainger Registry Services, LLC +// https://www.iana.org/domains/root/db/grainger.html grainger -// graphics : 2013-09-13 Binky Moon, LLC +// graphics : Binky Moon, LLC +// https://www.iana.org/domains/root/db/graphics.html graphics -// gratis : 2014-03-20 Binky Moon, LLC +// gratis : Binky Moon, LLC +// https://www.iana.org/domains/root/db/gratis.html gratis -// green : 2014-05-08 Identity Digital Limited +// green : Identity Digital Limited +// https://www.iana.org/domains/root/db/green.html green -// gripe : 2014-03-06 Binky Moon, LLC +// gripe : Binky Moon, LLC +// https://www.iana.org/domains/root/db/gripe.html gripe -// grocery : 2016-06-16 Wal-Mart Stores, Inc. +// grocery : Wal-Mart Stores, Inc. +// https://www.iana.org/domains/root/db/grocery.html grocery -// group : 2014-08-15 Binky Moon, LLC +// group : Binky Moon, LLC +// https://www.iana.org/domains/root/db/group.html group -// guardian : 2015-07-30 The Guardian Life Insurance Company of America +// guardian : The Guardian Life Insurance Company of America +// https://www.iana.org/domains/root/db/guardian.html guardian -// gucci : 2014-11-13 Guccio Gucci S.p.a. +// gucci : Guccio Gucci S.p.a. +// https://www.iana.org/domains/root/db/gucci.html gucci -// guge : 2014-08-28 Charleston Road Registry Inc. +// guge : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/guge.html guge -// guide : 2013-09-13 Binky Moon, LLC +// guide : Binky Moon, LLC +// https://www.iana.org/domains/root/db/guide.html guide -// guitars : 2013-11-14 XYZ.COM LLC +// guitars : XYZ.COM LLC +// https://www.iana.org/domains/root/db/guitars.html guitars -// guru : 2013-08-27 Binky Moon, LLC +// guru : Binky Moon, LLC +// https://www.iana.org/domains/root/db/guru.html guru -// hair : 2015-12-03 XYZ.COM LLC +// hair : XYZ.COM LLC +// https://www.iana.org/domains/root/db/hair.html hair -// hamburg : 2014-02-20 Hamburg Top-Level-Domain GmbH +// hamburg : Hamburg Top-Level-Domain GmbH +// https://www.iana.org/domains/root/db/hamburg.html hamburg -// hangout : 2014-11-13 Charleston Road Registry Inc. +// hangout : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/hangout.html hangout -// haus : 2013-12-05 Dog Beach, LLC +// haus : Dog Beach, LLC +// https://www.iana.org/domains/root/db/haus.html haus -// hbo : 2015-07-30 HBO Registry Services, Inc. +// hbo : HBO Registry Services, Inc. +// https://www.iana.org/domains/root/db/hbo.html hbo -// hdfc : 2015-07-30 HOUSING DEVELOPMENT FINANCE CORPORATION LIMITED +// hdfc : HOUSING DEVELOPMENT FINANCE CORPORATION LIMITED +// https://www.iana.org/domains/root/db/hdfc.html hdfc -// hdfcbank : 2015-02-12 HDFC Bank Limited +// hdfcbank : HDFC Bank Limited +// https://www.iana.org/domains/root/db/hdfcbank.html hdfcbank -// health : 2015-02-11 DotHealth, LLC +// health : Registry Services, LLC +// https://www.iana.org/domains/root/db/health.html health -// healthcare : 2014-06-12 Binky Moon, LLC +// healthcare : Binky Moon, LLC +// https://www.iana.org/domains/root/db/healthcare.html healthcare -// help : 2014-06-26 Innovation service Limited +// help : Innovation service Limited +// https://www.iana.org/domains/root/db/help.html help -// helsinki : 2015-02-05 City of Helsinki +// helsinki : City of Helsinki +// https://www.iana.org/domains/root/db/helsinki.html helsinki -// here : 2014-02-06 Charleston Road Registry Inc. +// here : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/here.html here -// hermes : 2014-07-10 HERMES INTERNATIONAL +// hermes : HERMES INTERNATIONAL +// https://www.iana.org/domains/root/db/hermes.html hermes -// hgtv : 2015-07-02 Lifestyle Domain Holdings, Inc. -hgtv - -// hiphop : 2014-03-06 Dot Hip Hop, LLC +// hiphop : Dot Hip Hop, LLC +// https://www.iana.org/domains/root/db/hiphop.html hiphop -// hisamitsu : 2015-07-16 Hisamitsu Pharmaceutical Co.,Inc. +// hisamitsu : Hisamitsu Pharmaceutical Co.,Inc. +// https://www.iana.org/domains/root/db/hisamitsu.html hisamitsu -// hitachi : 2014-10-31 Hitachi, Ltd. +// hitachi : Hitachi, Ltd. +// https://www.iana.org/domains/root/db/hitachi.html hitachi -// hiv : 2014-03-13 Internet Naming Company LLC +// hiv : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/hiv.html hiv -// hkt : 2015-05-14 PCCW-HKT DataCom Services Limited +// hkt : PCCW-HKT DataCom Services Limited +// https://www.iana.org/domains/root/db/hkt.html hkt -// hockey : 2015-03-19 Binky Moon, LLC +// hockey : Binky Moon, LLC +// https://www.iana.org/domains/root/db/hockey.html hockey -// holdings : 2013-08-27 Binky Moon, LLC +// holdings : Binky Moon, LLC +// https://www.iana.org/domains/root/db/holdings.html holdings -// holiday : 2013-11-07 Binky Moon, LLC +// holiday : Binky Moon, LLC +// https://www.iana.org/domains/root/db/holiday.html holiday -// homedepot : 2015-04-02 Home Depot Product Authority, LLC +// homedepot : Home Depot Product Authority, LLC +// https://www.iana.org/domains/root/db/homedepot.html homedepot -// homegoods : 2015-07-16 The TJX Companies, Inc. +// homegoods : The TJX Companies, Inc. +// https://www.iana.org/domains/root/db/homegoods.html homegoods -// homes : 2014-01-09 XYZ.COM LLC +// homes : XYZ.COM LLC +// https://www.iana.org/domains/root/db/homes.html homes -// homesense : 2015-07-16 The TJX Companies, Inc. +// homesense : The TJX Companies, Inc. +// https://www.iana.org/domains/root/db/homesense.html homesense -// honda : 2014-12-18 Honda Motor Co., Ltd. +// honda : Honda Motor Co., Ltd. +// https://www.iana.org/domains/root/db/honda.html honda -// horse : 2013-11-21 Registry Services, LLC +// horse : Registry Services, LLC +// https://www.iana.org/domains/root/db/horse.html horse -// hospital : 2016-10-20 Binky Moon, LLC +// hospital : Binky Moon, LLC +// https://www.iana.org/domains/root/db/hospital.html hospital -// host : 2014-04-17 Radix FZC +// host : Radix FZC DMCC +// https://www.iana.org/domains/root/db/host.html host -// hosting : 2014-05-29 XYZ.COM LLC +// hosting : XYZ.COM LLC +// https://www.iana.org/domains/root/db/hosting.html hosting -// hot : 2015-08-27 Amazon Registry Services, Inc. +// hot : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/hot.html hot -// hoteles : 2015-03-05 Travel Reservations SRL -hoteles - -// hotels : 2016-04-07 Booking.com B.V. +// hotels : Booking.com B.V. +// https://www.iana.org/domains/root/db/hotels.html hotels -// hotmail : 2014-12-18 Microsoft Corporation +// hotmail : Microsoft Corporation +// https://www.iana.org/domains/root/db/hotmail.html hotmail -// house : 2013-11-07 Binky Moon, LLC +// house : Binky Moon, LLC +// https://www.iana.org/domains/root/db/house.html house -// how : 2014-01-23 Charleston Road Registry Inc. +// how : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/how.html how -// hsbc : 2014-10-24 HSBC Global Services (UK) Limited +// hsbc : HSBC Global Services (UK) Limited +// https://www.iana.org/domains/root/db/hsbc.html hsbc -// hughes : 2015-07-30 Hughes Satellite Systems Corporation +// hughes : Hughes Satellite Systems Corporation +// https://www.iana.org/domains/root/db/hughes.html hughes -// hyatt : 2015-07-30 Hyatt GTLD, L.L.C. +// hyatt : Hyatt GTLD, L.L.C. +// https://www.iana.org/domains/root/db/hyatt.html hyatt -// hyundai : 2015-07-09 Hyundai Motor Company +// hyundai : Hyundai Motor Company +// https://www.iana.org/domains/root/db/hyundai.html hyundai -// ibm : 2014-07-31 International Business Machines Corporation +// ibm : International Business Machines Corporation +// https://www.iana.org/domains/root/db/ibm.html ibm -// icbc : 2015-02-19 Industrial and Commercial Bank of China Limited +// icbc : Industrial and Commercial Bank of China Limited +// https://www.iana.org/domains/root/db/icbc.html icbc -// ice : 2014-10-30 IntercontinentalExchange, Inc. +// ice : IntercontinentalExchange, Inc. +// https://www.iana.org/domains/root/db/ice.html ice -// icu : 2015-01-08 ShortDot SA +// icu : ShortDot SA +// https://www.iana.org/domains/root/db/icu.html icu -// ieee : 2015-07-23 IEEE Global LLC +// ieee : IEEE Global LLC +// https://www.iana.org/domains/root/db/ieee.html ieee -// ifm : 2014-01-30 ifm electronic gmbh +// ifm : ifm electronic gmbh +// https://www.iana.org/domains/root/db/ifm.html ifm -// ikano : 2015-07-09 Ikano S.A. +// ikano : Ikano S.A. +// https://www.iana.org/domains/root/db/ikano.html ikano -// imamat : 2015-08-06 Fondation Aga Khan (Aga Khan Foundation) +// imamat : Fondation Aga Khan (Aga Khan Foundation) +// https://www.iana.org/domains/root/db/imamat.html imamat -// imdb : 2015-06-25 Amazon Registry Services, Inc. +// imdb : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/imdb.html imdb -// immo : 2014-07-10 Binky Moon, LLC +// immo : Binky Moon, LLC +// https://www.iana.org/domains/root/db/immo.html immo -// immobilien : 2013-11-07 Dog Beach, LLC +// immobilien : Dog Beach, LLC +// https://www.iana.org/domains/root/db/immobilien.html immobilien -// inc : 2018-03-10 Intercap Registry Inc. +// inc : Intercap Registry Inc. +// https://www.iana.org/domains/root/db/inc.html inc -// industries : 2013-12-05 Binky Moon, LLC +// industries : Binky Moon, LLC +// https://www.iana.org/domains/root/db/industries.html industries -// infiniti : 2014-03-27 NISSAN MOTOR CO., LTD. +// infiniti : NISSAN MOTOR CO., LTD. +// https://www.iana.org/domains/root/db/infiniti.html infiniti -// ing : 2014-01-23 Charleston Road Registry Inc. +// ing : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/ing.html ing -// ink : 2013-12-05 Top Level Design, LLC +// ink : Registry Services, LLC +// https://www.iana.org/domains/root/db/ink.html ink -// institute : 2013-11-07 Binky Moon, LLC +// institute : Binky Moon, LLC +// https://www.iana.org/domains/root/db/institute.html institute -// insurance : 2015-02-19 fTLD Registry Services LLC +// insurance : fTLD Registry Services LLC +// https://www.iana.org/domains/root/db/insurance.html insurance -// insure : 2014-03-20 Binky Moon, LLC +// insure : Binky Moon, LLC +// https://www.iana.org/domains/root/db/insure.html insure -// international : 2013-11-07 Binky Moon, LLC +// international : Binky Moon, LLC +// https://www.iana.org/domains/root/db/international.html international -// intuit : 2015-07-30 Intuit Administrative Services, Inc. +// intuit : Intuit Administrative Services, Inc. +// https://www.iana.org/domains/root/db/intuit.html intuit -// investments : 2014-03-20 Binky Moon, LLC +// investments : Binky Moon, LLC +// https://www.iana.org/domains/root/db/investments.html investments -// ipiranga : 2014-08-28 Ipiranga Produtos de Petroleo S.A. +// ipiranga : Ipiranga Produtos de Petroleo S.A. +// https://www.iana.org/domains/root/db/ipiranga.html ipiranga -// irish : 2014-08-07 Binky Moon, LLC +// irish : Binky Moon, LLC +// https://www.iana.org/domains/root/db/irish.html irish -// ismaili : 2015-08-06 Fondation Aga Khan (Aga Khan Foundation) +// ismaili : Fondation Aga Khan (Aga Khan Foundation) +// https://www.iana.org/domains/root/db/ismaili.html ismaili -// ist : 2014-08-28 Istanbul Metropolitan Municipality +// ist : Istanbul Metropolitan Municipality +// https://www.iana.org/domains/root/db/ist.html ist -// istanbul : 2014-08-28 Istanbul Metropolitan Municipality +// istanbul : Istanbul Metropolitan Municipality +// https://www.iana.org/domains/root/db/istanbul.html istanbul -// itau : 2014-10-02 Itau Unibanco Holding S.A. +// itau : Itau Unibanco Holding S.A. +// https://www.iana.org/domains/root/db/itau.html itau -// itv : 2015-07-09 ITV Services Limited +// itv : ITV Services Limited +// https://www.iana.org/domains/root/db/itv.html itv -// jaguar : 2014-11-13 Jaguar Land Rover Ltd +// jaguar : Jaguar Land Rover Ltd +// https://www.iana.org/domains/root/db/jaguar.html jaguar -// java : 2014-06-19 Oracle Corporation +// java : Oracle Corporation +// https://www.iana.org/domains/root/db/java.html java -// jcb : 2014-11-20 JCB Co., Ltd. +// jcb : JCB Co., Ltd. +// https://www.iana.org/domains/root/db/jcb.html jcb -// jeep : 2015-07-30 FCA US LLC. +// jeep : FCA US LLC. +// https://www.iana.org/domains/root/db/jeep.html jeep -// jetzt : 2014-01-09 Binky Moon, LLC +// jetzt : Binky Moon, LLC +// https://www.iana.org/domains/root/db/jetzt.html jetzt -// jewelry : 2015-03-05 Binky Moon, LLC +// jewelry : Binky Moon, LLC +// https://www.iana.org/domains/root/db/jewelry.html jewelry -// jio : 2015-04-02 Reliance Industries Limited +// jio : Reliance Industries Limited +// https://www.iana.org/domains/root/db/jio.html jio -// jll : 2015-04-02 Jones Lang LaSalle Incorporated +// jll : Jones Lang LaSalle Incorporated +// https://www.iana.org/domains/root/db/jll.html jll -// jmp : 2015-03-26 Matrix IP LLC +// jmp : Matrix IP LLC +// https://www.iana.org/domains/root/db/jmp.html jmp -// jnj : 2015-06-18 Johnson & Johnson Services, Inc. +// jnj : Johnson & Johnson Services, Inc. +// https://www.iana.org/domains/root/db/jnj.html jnj -// joburg : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry +// joburg : ZA Central Registry NPC trading as ZA Central Registry +// https://www.iana.org/domains/root/db/joburg.html joburg -// jot : 2014-12-18 Amazon Registry Services, Inc. +// jot : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/jot.html jot -// joy : 2014-12-18 Amazon Registry Services, Inc. +// joy : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/joy.html joy -// jpmorgan : 2015-04-30 JPMorgan Chase Bank, National Association +// jpmorgan : JPMorgan Chase Bank, National Association +// https://www.iana.org/domains/root/db/jpmorgan.html jpmorgan -// jprs : 2014-09-18 Japan Registry Services Co., Ltd. +// jprs : Japan Registry Services Co., Ltd. +// https://www.iana.org/domains/root/db/jprs.html jprs -// juegos : 2014-03-20 Internet Naming Company LLC +// juegos : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/juegos.html juegos -// juniper : 2015-07-30 JUNIPER NETWORKS, INC. +// juniper : JUNIPER NETWORKS, INC. +// https://www.iana.org/domains/root/db/juniper.html juniper -// kaufen : 2013-11-07 Dog Beach, LLC +// kaufen : Dog Beach, LLC +// https://www.iana.org/domains/root/db/kaufen.html kaufen -// kddi : 2014-09-12 KDDI CORPORATION +// kddi : KDDI CORPORATION +// https://www.iana.org/domains/root/db/kddi.html kddi -// kerryhotels : 2015-04-30 Kerry Trading Co. Limited +// kerryhotels : Kerry Trading Co. Limited +// https://www.iana.org/domains/root/db/kerryhotels.html kerryhotels -// kerrylogistics : 2015-04-09 Kerry Trading Co. Limited +// kerrylogistics : Kerry Trading Co. Limited +// https://www.iana.org/domains/root/db/kerrylogistics.html kerrylogistics -// kerryproperties : 2015-04-09 Kerry Trading Co. Limited +// kerryproperties : Kerry Trading Co. Limited +// https://www.iana.org/domains/root/db/kerryproperties.html kerryproperties -// kfh : 2014-12-04 Kuwait Finance House +// kfh : Kuwait Finance House +// https://www.iana.org/domains/root/db/kfh.html kfh -// kia : 2015-07-09 KIA MOTORS CORPORATION +// kia : KIA MOTORS CORPORATION +// https://www.iana.org/domains/root/db/kia.html kia -// kids : 2021-08-13 DotKids Foundation Limited +// kids : DotKids Foundation Limited +// https://www.iana.org/domains/root/db/kids.html kids -// kim : 2013-09-23 Identity Digital Limited +// kim : Identity Digital Limited +// https://www.iana.org/domains/root/db/kim.html kim -// kinder : 2014-11-07 Ferrero Trading Lux S.A. +// kinder : Ferrero Trading Lux S.A. +// https://www.iana.org/domains/root/db/kinder.html kinder -// kindle : 2015-06-25 Amazon Registry Services, Inc. +// kindle : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/kindle.html kindle -// kitchen : 2013-09-20 Binky Moon, LLC +// kitchen : Binky Moon, LLC +// https://www.iana.org/domains/root/db/kitchen.html kitchen -// kiwi : 2013-09-20 DOT KIWI LIMITED +// kiwi : DOT KIWI LIMITED +// https://www.iana.org/domains/root/db/kiwi.html kiwi -// koeln : 2014-01-09 dotKoeln GmbH +// koeln : dotKoeln GmbH +// https://www.iana.org/domains/root/db/koeln.html koeln -// komatsu : 2015-01-08 Komatsu Ltd. +// komatsu : Komatsu Ltd. +// https://www.iana.org/domains/root/db/komatsu.html komatsu -// kosher : 2015-08-20 Kosher Marketing Assets LLC +// kosher : Kosher Marketing Assets LLC +// https://www.iana.org/domains/root/db/kosher.html kosher -// kpmg : 2015-04-23 KPMG International Cooperative (KPMG International Genossenschaft) +// kpmg : KPMG International Cooperative (KPMG International Genossenschaft) +// https://www.iana.org/domains/root/db/kpmg.html kpmg -// kpn : 2015-01-08 Koninklijke KPN N.V. +// kpn : Koninklijke KPN N.V. +// https://www.iana.org/domains/root/db/kpn.html kpn -// krd : 2013-12-05 KRG Department of Information Technology +// krd : KRG Department of Information Technology +// https://www.iana.org/domains/root/db/krd.html krd -// kred : 2013-12-19 KredTLD Pty Ltd +// kred : KredTLD Pty Ltd +// https://www.iana.org/domains/root/db/kred.html kred -// kuokgroup : 2015-04-09 Kerry Trading Co. Limited +// kuokgroup : Kerry Trading Co. Limited +// https://www.iana.org/domains/root/db/kuokgroup.html kuokgroup -// kyoto : 2014-11-07 Academic Institution: Kyoto Jyoho Gakuen +// kyoto : Academic Institution: Kyoto Jyoho Gakuen +// https://www.iana.org/domains/root/db/kyoto.html kyoto -// lacaixa : 2014-01-09 Fundación Bancaria Caixa d’Estalvis i Pensions de Barcelona, “la Caixa” +// lacaixa : Fundación Bancaria Caixa d’Estalvis i Pensions de Barcelona, “la Caixa” +// https://www.iana.org/domains/root/db/lacaixa.html lacaixa -// lamborghini : 2015-06-04 Automobili Lamborghini S.p.A. +// lamborghini : Automobili Lamborghini S.p.A. +// https://www.iana.org/domains/root/db/lamborghini.html lamborghini -// lamer : 2015-10-01 The Estée Lauder Companies Inc. +// lamer : The Estée Lauder Companies Inc. +// https://www.iana.org/domains/root/db/lamer.html lamer -// lancaster : 2015-02-12 LANCASTER +// lancaster : LANCASTER +// https://www.iana.org/domains/root/db/lancaster.html lancaster -// lancia : 2015-07-31 Fiat Chrysler Automobiles N.V. -lancia - -// land : 2013-09-10 Binky Moon, LLC +// land : Binky Moon, LLC +// https://www.iana.org/domains/root/db/land.html land -// landrover : 2014-11-13 Jaguar Land Rover Ltd +// landrover : Jaguar Land Rover Ltd +// https://www.iana.org/domains/root/db/landrover.html landrover -// lanxess : 2015-07-30 LANXESS Corporation +// lanxess : LANXESS Corporation +// https://www.iana.org/domains/root/db/lanxess.html lanxess -// lasalle : 2015-04-02 Jones Lang LaSalle Incorporated +// lasalle : Jones Lang LaSalle Incorporated +// https://www.iana.org/domains/root/db/lasalle.html lasalle -// lat : 2014-10-16 XYZ.COM LLC +// lat : XYZ.COM LLC +// https://www.iana.org/domains/root/db/lat.html lat -// latino : 2015-07-30 Dish DBS Corporation +// latino : Dish DBS Corporation +// https://www.iana.org/domains/root/db/latino.html latino -// latrobe : 2014-06-16 La Trobe University +// latrobe : La Trobe University +// https://www.iana.org/domains/root/db/latrobe.html latrobe -// law : 2015-01-22 Registry Services, LLC +// law : Registry Services, LLC +// https://www.iana.org/domains/root/db/law.html law -// lawyer : 2014-03-20 Dog Beach, LLC +// lawyer : Dog Beach, LLC +// https://www.iana.org/domains/root/db/lawyer.html lawyer -// lds : 2014-03-20 IRI Domain Management, LLC +// lds : IRI Domain Management, LLC +// https://www.iana.org/domains/root/db/lds.html lds -// lease : 2014-03-06 Binky Moon, LLC +// lease : Binky Moon, LLC +// https://www.iana.org/domains/root/db/lease.html lease -// leclerc : 2014-08-07 A.C.D. LEC Association des Centres Distributeurs Edouard Leclerc +// leclerc : A.C.D. LEC Association des Centres Distributeurs Edouard Leclerc +// https://www.iana.org/domains/root/db/leclerc.html leclerc -// lefrak : 2015-07-16 LeFrak Organization, Inc. +// lefrak : LeFrak Organization, Inc. +// https://www.iana.org/domains/root/db/lefrak.html lefrak -// legal : 2014-10-16 Binky Moon, LLC +// legal : Binky Moon, LLC +// https://www.iana.org/domains/root/db/legal.html legal -// lego : 2015-07-16 LEGO Juris A/S +// lego : LEGO Juris A/S +// https://www.iana.org/domains/root/db/lego.html lego -// lexus : 2015-04-23 TOYOTA MOTOR CORPORATION +// lexus : TOYOTA MOTOR CORPORATION +// https://www.iana.org/domains/root/db/lexus.html lexus -// lgbt : 2014-05-08 Identity Digital Limited +// lgbt : Identity Digital Limited +// https://www.iana.org/domains/root/db/lgbt.html lgbt -// lidl : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG +// lidl : Schwarz Domains und Services GmbH & Co. KG +// https://www.iana.org/domains/root/db/lidl.html lidl -// life : 2014-02-06 Binky Moon, LLC +// life : Binky Moon, LLC +// https://www.iana.org/domains/root/db/life.html life -// lifeinsurance : 2015-01-15 American Council of Life Insurers +// lifeinsurance : American Council of Life Insurers +// https://www.iana.org/domains/root/db/lifeinsurance.html lifeinsurance -// lifestyle : 2014-12-11 Lifestyle Domain Holdings, Inc. +// lifestyle : Lifestyle Domain Holdings, Inc. +// https://www.iana.org/domains/root/db/lifestyle.html lifestyle -// lighting : 2013-08-27 Binky Moon, LLC +// lighting : Binky Moon, LLC +// https://www.iana.org/domains/root/db/lighting.html lighting -// like : 2014-12-18 Amazon Registry Services, Inc. +// like : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/like.html like -// lilly : 2015-07-31 Eli Lilly and Company +// lilly : Eli Lilly and Company +// https://www.iana.org/domains/root/db/lilly.html lilly -// limited : 2014-03-06 Binky Moon, LLC +// limited : Binky Moon, LLC +// https://www.iana.org/domains/root/db/limited.html limited -// limo : 2013-10-17 Binky Moon, LLC +// limo : Binky Moon, LLC +// https://www.iana.org/domains/root/db/limo.html limo -// lincoln : 2014-11-13 Ford Motor Company +// lincoln : Ford Motor Company +// https://www.iana.org/domains/root/db/lincoln.html lincoln -// link : 2013-11-14 Nova Registry Ltd +// link : Nova Registry Ltd +// https://www.iana.org/domains/root/db/link.html link -// lipsy : 2015-06-25 Lipsy Ltd +// lipsy : Lipsy Ltd +// https://www.iana.org/domains/root/db/lipsy.html lipsy -// live : 2014-12-04 Dog Beach, LLC +// live : Dog Beach, LLC +// https://www.iana.org/domains/root/db/live.html live -// living : 2015-07-30 Lifestyle Domain Holdings, Inc. +// living : Lifestyle Domain Holdings, Inc. +// https://www.iana.org/domains/root/db/living.html living -// llc : 2017-12-14 Identity Digital Limited +// llc : Identity Digital Limited +// https://www.iana.org/domains/root/db/llc.html llc -// llp : 2019-08-26 Intercap Registry Inc. +// llp : Intercap Registry Inc. +// https://www.iana.org/domains/root/db/llp.html llp -// loan : 2014-11-20 dot Loan Limited +// loan : dot Loan Limited +// https://www.iana.org/domains/root/db/loan.html loan -// loans : 2014-03-20 Binky Moon, LLC +// loans : Binky Moon, LLC +// https://www.iana.org/domains/root/db/loans.html loans -// locker : 2015-06-04 Dish DBS Corporation +// locker : Orange Domains LLC +// https://www.iana.org/domains/root/db/locker.html locker -// locus : 2015-06-25 Locus Analytics LLC +// locus : Locus Analytics LLC +// https://www.iana.org/domains/root/db/locus.html locus -// lol : 2015-01-30 XYZ.COM LLC +// lol : XYZ.COM LLC +// https://www.iana.org/domains/root/db/lol.html lol -// london : 2013-11-14 Dot London Domains Limited +// london : Dot London Domains Limited +// https://www.iana.org/domains/root/db/london.html london -// lotte : 2014-11-07 Lotte Holdings Co., Ltd. +// lotte : Lotte Holdings Co., Ltd. +// https://www.iana.org/domains/root/db/lotte.html lotte -// lotto : 2014-04-10 Identity Digital Limited +// lotto : Identity Digital Limited +// https://www.iana.org/domains/root/db/lotto.html lotto -// love : 2014-12-22 Merchant Law Group LLP +// love : Merchant Law Group LLP +// https://www.iana.org/domains/root/db/love.html love -// lpl : 2015-07-30 LPL Holdings, Inc. +// lpl : LPL Holdings, Inc. +// https://www.iana.org/domains/root/db/lpl.html lpl -// lplfinancial : 2015-07-30 LPL Holdings, Inc. +// lplfinancial : LPL Holdings, Inc. +// https://www.iana.org/domains/root/db/lplfinancial.html lplfinancial -// ltd : 2014-09-25 Binky Moon, LLC +// ltd : Binky Moon, LLC +// https://www.iana.org/domains/root/db/ltd.html ltd -// ltda : 2014-04-17 InterNetX, Corp +// ltda : InterNetX, Corp +// https://www.iana.org/domains/root/db/ltda.html ltda -// lundbeck : 2015-08-06 H. Lundbeck A/S +// lundbeck : H. Lundbeck A/S +// https://www.iana.org/domains/root/db/lundbeck.html lundbeck -// luxe : 2014-01-09 Registry Services, LLC +// luxe : Registry Services, LLC +// https://www.iana.org/domains/root/db/luxe.html luxe -// luxury : 2013-10-17 Luxury Partners, LLC +// luxury : Luxury Partners, LLC +// https://www.iana.org/domains/root/db/luxury.html luxury -// madrid : 2014-05-01 Comunidad de Madrid +// madrid : Comunidad de Madrid +// https://www.iana.org/domains/root/db/madrid.html madrid -// maif : 2014-10-02 Mutuelle Assurance Instituteur France (MAIF) +// maif : Mutuelle Assurance Instituteur France (MAIF) +// https://www.iana.org/domains/root/db/maif.html maif -// maison : 2013-12-05 Binky Moon, LLC +// maison : Binky Moon, LLC +// https://www.iana.org/domains/root/db/maison.html maison -// makeup : 2015-01-15 XYZ.COM LLC +// makeup : XYZ.COM LLC +// https://www.iana.org/domains/root/db/makeup.html makeup -// man : 2014-12-04 MAN SE +// man : MAN SE +// https://www.iana.org/domains/root/db/man.html man -// management : 2013-11-07 Binky Moon, LLC +// management : Binky Moon, LLC +// https://www.iana.org/domains/root/db/management.html management -// mango : 2013-10-24 PUNTO FA S.L. +// mango : PUNTO FA S.L. +// https://www.iana.org/domains/root/db/mango.html mango -// map : 2016-06-09 Charleston Road Registry Inc. +// map : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/map.html map -// market : 2014-03-06 Dog Beach, LLC +// market : Dog Beach, LLC +// https://www.iana.org/domains/root/db/market.html market -// marketing : 2013-11-07 Binky Moon, LLC +// marketing : Binky Moon, LLC +// https://www.iana.org/domains/root/db/marketing.html marketing -// markets : 2014-12-11 Dog Beach, LLC +// markets : Dog Beach, LLC +// https://www.iana.org/domains/root/db/markets.html markets -// marriott : 2014-10-09 Marriott Worldwide Corporation +// marriott : Marriott Worldwide Corporation +// https://www.iana.org/domains/root/db/marriott.html marriott -// marshalls : 2015-07-16 The TJX Companies, Inc. +// marshalls : The TJX Companies, Inc. +// https://www.iana.org/domains/root/db/marshalls.html marshalls -// maserati : 2015-07-31 Fiat Chrysler Automobiles N.V. -maserati - -// mattel : 2015-08-06 Mattel Sites, Inc. +// mattel : Mattel Sites, Inc. +// https://www.iana.org/domains/root/db/mattel.html mattel -// mba : 2015-04-02 Binky Moon, LLC +// mba : Binky Moon, LLC +// https://www.iana.org/domains/root/db/mba.html mba -// mckinsey : 2015-07-31 McKinsey Holdings, Inc. +// mckinsey : McKinsey Holdings, Inc. +// https://www.iana.org/domains/root/db/mckinsey.html mckinsey -// med : 2015-08-06 Medistry LLC +// med : Medistry LLC +// https://www.iana.org/domains/root/db/med.html med -// media : 2014-03-06 Binky Moon, LLC +// media : Binky Moon, LLC +// https://www.iana.org/domains/root/db/media.html media -// meet : 2014-01-16 Charleston Road Registry Inc. +// meet : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/meet.html meet -// melbourne : 2014-05-29 The Crown in right of the State of Victoria, represented by its Department of State Development, Business and Innovation +// melbourne : The Crown in right of the State of Victoria, represented by its Department of State Development, Business and Innovation +// https://www.iana.org/domains/root/db/melbourne.html melbourne -// meme : 2014-01-30 Charleston Road Registry Inc. +// meme : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/meme.html meme -// memorial : 2014-10-16 Dog Beach, LLC +// memorial : Dog Beach, LLC +// https://www.iana.org/domains/root/db/memorial.html memorial -// men : 2015-02-26 Exclusive Registry Limited +// men : Exclusive Registry Limited +// https://www.iana.org/domains/root/db/men.html men -// menu : 2013-09-11 Dot Menu Registry, LLC +// menu : Dot Menu Registry, LLC +// https://www.iana.org/domains/root/db/menu.html menu -// merckmsd : 2016-07-14 MSD Registry Holdings, Inc. +// merckmsd : MSD Registry Holdings, Inc. +// https://www.iana.org/domains/root/db/merckmsd.html merckmsd -// miami : 2013-12-19 Registry Services, LLC +// miami : Registry Services, LLC +// https://www.iana.org/domains/root/db/miami.html miami -// microsoft : 2014-12-18 Microsoft Corporation +// microsoft : Microsoft Corporation +// https://www.iana.org/domains/root/db/microsoft.html microsoft -// mini : 2014-01-09 Bayerische Motoren Werke Aktiengesellschaft +// mini : Bayerische Motoren Werke Aktiengesellschaft +// https://www.iana.org/domains/root/db/mini.html mini -// mint : 2015-07-30 Intuit Administrative Services, Inc. +// mint : Intuit Administrative Services, Inc. +// https://www.iana.org/domains/root/db/mint.html mint -// mit : 2015-07-02 Massachusetts Institute of Technology +// mit : Massachusetts Institute of Technology +// https://www.iana.org/domains/root/db/mit.html mit -// mitsubishi : 2015-07-23 Mitsubishi Corporation +// mitsubishi : Mitsubishi Corporation +// https://www.iana.org/domains/root/db/mitsubishi.html mitsubishi -// mlb : 2015-05-21 MLB Advanced Media DH, LLC +// mlb : MLB Advanced Media DH, LLC +// https://www.iana.org/domains/root/db/mlb.html mlb -// mls : 2015-04-23 The Canadian Real Estate Association +// mls : The Canadian Real Estate Association +// https://www.iana.org/domains/root/db/mls.html mls -// mma : 2014-11-07 MMA IARD +// mma : MMA IARD +// https://www.iana.org/domains/root/db/mma.html mma -// mobile : 2016-06-02 Dish DBS Corporation +// mobile : Dish DBS Corporation +// https://www.iana.org/domains/root/db/mobile.html mobile -// moda : 2013-11-07 Dog Beach, LLC +// moda : Dog Beach, LLC +// https://www.iana.org/domains/root/db/moda.html moda -// moe : 2013-11-13 Interlink Systems Innovation Institute K.K. +// moe : Interlink Systems Innovation Institute K.K. +// https://www.iana.org/domains/root/db/moe.html moe -// moi : 2014-12-18 Amazon Registry Services, Inc. +// moi : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/moi.html moi -// mom : 2015-04-16 XYZ.COM LLC +// mom : XYZ.COM LLC +// https://www.iana.org/domains/root/db/mom.html mom -// monash : 2013-09-30 Monash University +// monash : Monash University +// https://www.iana.org/domains/root/db/monash.html monash -// money : 2014-10-16 Binky Moon, LLC +// money : Binky Moon, LLC +// https://www.iana.org/domains/root/db/money.html money -// monster : 2015-09-11 XYZ.COM LLC +// monster : XYZ.COM LLC +// https://www.iana.org/domains/root/db/monster.html monster -// mormon : 2013-12-05 IRI Domain Management, LLC +// mormon : IRI Domain Management, LLC +// https://www.iana.org/domains/root/db/mormon.html mormon -// mortgage : 2014-03-20 Dog Beach, LLC +// mortgage : Dog Beach, LLC +// https://www.iana.org/domains/root/db/mortgage.html mortgage -// moscow : 2013-12-19 Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID) +// moscow : Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID) +// https://www.iana.org/domains/root/db/moscow.html moscow -// moto : 2015-06-04 Motorola Trademark Holdings, LLC +// moto : Motorola Trademark Holdings, LLC +// https://www.iana.org/domains/root/db/moto.html moto -// motorcycles : 2014-01-09 XYZ.COM LLC +// motorcycles : XYZ.COM LLC +// https://www.iana.org/domains/root/db/motorcycles.html motorcycles -// mov : 2014-01-30 Charleston Road Registry Inc. +// mov : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/mov.html mov -// movie : 2015-02-05 Binky Moon, LLC +// movie : Binky Moon, LLC +// https://www.iana.org/domains/root/db/movie.html movie -// msd : 2015-07-23 MSD Registry Holdings, Inc. +// msd : MSD Registry Holdings, Inc. +// https://www.iana.org/domains/root/db/msd.html msd -// mtn : 2014-12-04 MTN Dubai Limited +// mtn : MTN Dubai Limited +// https://www.iana.org/domains/root/db/mtn.html mtn -// mtr : 2015-03-12 MTR Corporation Limited +// mtr : MTR Corporation Limited +// https://www.iana.org/domains/root/db/mtr.html mtr -// music : 2021-05-04 DotMusic Limited +// music : DotMusic Limited +// https://www.iana.org/domains/root/db/music.html music -// mutual : 2015-04-02 Northwestern Mutual MU TLD Registry, LLC -mutual - -// nab : 2015-08-20 National Australia Bank Limited +// nab : National Australia Bank Limited +// https://www.iana.org/domains/root/db/nab.html nab -// nagoya : 2013-10-24 GMO Registry, Inc. +// nagoya : GMO Registry, Inc. +// https://www.iana.org/domains/root/db/nagoya.html nagoya -// natura : 2015-03-12 NATURA COSMÉTICOS S.A. +// natura : NATURA COSMÉTICOS S.A. +// https://www.iana.org/domains/root/db/natura.html natura -// navy : 2014-03-06 Dog Beach, LLC +// navy : Dog Beach, LLC +// https://www.iana.org/domains/root/db/navy.html navy -// nba : 2015-07-31 NBA REGISTRY, LLC +// nba : NBA REGISTRY, LLC +// https://www.iana.org/domains/root/db/nba.html nba -// nec : 2015-01-08 NEC Corporation +// nec : NEC Corporation +// https://www.iana.org/domains/root/db/nec.html nec -// netbank : 2014-06-26 COMMONWEALTH BANK OF AUSTRALIA +// netbank : COMMONWEALTH BANK OF AUSTRALIA +// https://www.iana.org/domains/root/db/netbank.html netbank -// netflix : 2015-06-18 Netflix, Inc. +// netflix : Netflix, Inc. +// https://www.iana.org/domains/root/db/netflix.html netflix -// network : 2013-11-14 Binky Moon, LLC +// network : Binky Moon, LLC +// https://www.iana.org/domains/root/db/network.html network -// neustar : 2013-12-05 NeuStar, Inc. +// neustar : NeuStar, Inc. +// https://www.iana.org/domains/root/db/neustar.html neustar -// new : 2014-01-30 Charleston Road Registry Inc. +// new : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/new.html new -// news : 2014-12-18 Dog Beach, LLC +// news : Dog Beach, LLC +// https://www.iana.org/domains/root/db/news.html news -// next : 2015-06-18 Next plc +// next : Next plc +// https://www.iana.org/domains/root/db/next.html next -// nextdirect : 2015-06-18 Next plc +// nextdirect : Next plc +// https://www.iana.org/domains/root/db/nextdirect.html nextdirect -// nexus : 2014-07-24 Charleston Road Registry Inc. +// nexus : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/nexus.html nexus -// nfl : 2015-07-23 NFL Reg Ops LLC +// nfl : NFL Reg Ops LLC +// https://www.iana.org/domains/root/db/nfl.html nfl -// ngo : 2014-03-06 Public Interest Registry +// ngo : Public Interest Registry +// https://www.iana.org/domains/root/db/ngo.html ngo -// nhk : 2014-02-13 Japan Broadcasting Corporation (NHK) +// nhk : Japan Broadcasting Corporation (NHK) +// https://www.iana.org/domains/root/db/nhk.html nhk -// nico : 2014-12-04 DWANGO Co., Ltd. +// nico : DWANGO Co., Ltd. +// https://www.iana.org/domains/root/db/nico.html nico -// nike : 2015-07-23 NIKE, Inc. +// nike : NIKE, Inc. +// https://www.iana.org/domains/root/db/nike.html nike -// nikon : 2015-05-21 NIKON CORPORATION +// nikon : NIKON CORPORATION +// https://www.iana.org/domains/root/db/nikon.html nikon -// ninja : 2013-11-07 Dog Beach, LLC +// ninja : Dog Beach, LLC +// https://www.iana.org/domains/root/db/ninja.html ninja -// nissan : 2014-03-27 NISSAN MOTOR CO., LTD. +// nissan : NISSAN MOTOR CO., LTD. +// https://www.iana.org/domains/root/db/nissan.html nissan -// nissay : 2015-10-29 Nippon Life Insurance Company +// nissay : Nippon Life Insurance Company +// https://www.iana.org/domains/root/db/nissay.html nissay -// nokia : 2015-01-08 Nokia Corporation +// nokia : Nokia Corporation +// https://www.iana.org/domains/root/db/nokia.html nokia -// northwesternmutual : 2015-06-18 Northwestern Mutual Registry, LLC -northwesternmutual - -// norton : 2014-12-04 NortonLifeLock Inc. +// norton : NortonLifeLock Inc. +// https://www.iana.org/domains/root/db/norton.html norton -// now : 2015-06-25 Amazon Registry Services, Inc. +// now : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/now.html now -// nowruz : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// nowruz : Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// https://www.iana.org/domains/root/db/nowruz.html nowruz -// nowtv : 2015-05-14 Starbucks (HK) Limited +// nowtv : Starbucks (HK) Limited +// https://www.iana.org/domains/root/db/nowtv.html nowtv -// nra : 2014-05-22 NRA Holdings Company, INC. +// nra : NRA Holdings Company, INC. +// https://www.iana.org/domains/root/db/nra.html nra -// nrw : 2013-11-21 Minds + Machines GmbH +// nrw : Minds + Machines GmbH +// https://www.iana.org/domains/root/db/nrw.html nrw -// ntt : 2014-10-31 NIPPON TELEGRAPH AND TELEPHONE CORPORATION +// ntt : NIPPON TELEGRAPH AND TELEPHONE CORPORATION +// https://www.iana.org/domains/root/db/ntt.html ntt -// nyc : 2014-01-23 The City of New York by and through the New York City Department of Information Technology & Telecommunications +// nyc : The City of New York by and through the New York City Department of Information Technology & Telecommunications +// https://www.iana.org/domains/root/db/nyc.html nyc -// obi : 2014-09-25 OBI Group Holding SE & Co. KGaA +// obi : OBI Group Holding SE & Co. KGaA +// https://www.iana.org/domains/root/db/obi.html obi -// observer : 2015-04-30 Dog Beach, LLC +// observer : Fegistry, LLC +// https://www.iana.org/domains/root/db/observer.html observer -// office : 2015-03-12 Microsoft Corporation +// office : Microsoft Corporation +// https://www.iana.org/domains/root/db/office.html office -// okinawa : 2013-12-05 BRregistry, Inc. +// okinawa : BRregistry, Inc. +// https://www.iana.org/domains/root/db/okinawa.html okinawa -// olayan : 2015-05-14 Crescent Holding GmbH +// olayan : Competrol (Luxembourg) Sarl +// https://www.iana.org/domains/root/db/olayan.html olayan -// olayangroup : 2015-05-14 Crescent Holding GmbH +// olayangroup : Competrol (Luxembourg) Sarl +// https://www.iana.org/domains/root/db/olayangroup.html olayangroup -// oldnavy : 2015-07-31 The Gap, Inc. +// oldnavy : The Gap, Inc. +// https://www.iana.org/domains/root/db/oldnavy.html oldnavy -// ollo : 2015-06-04 Dish DBS Corporation +// ollo : Dish DBS Corporation +// https://www.iana.org/domains/root/db/ollo.html ollo -// omega : 2015-01-08 The Swatch Group Ltd +// omega : The Swatch Group Ltd +// https://www.iana.org/domains/root/db/omega.html omega -// one : 2014-11-07 One.com A/S +// one : One.com A/S +// https://www.iana.org/domains/root/db/one.html one -// ong : 2014-03-06 Public Interest Registry +// ong : Public Interest Registry +// https://www.iana.org/domains/root/db/ong.html ong -// onl : 2013-09-16 iRegistry GmbH +// onl : iRegistry GmbH +// https://www.iana.org/domains/root/db/onl.html onl -// online : 2015-01-15 Radix FZC +// online : Radix FZC DMCC +// https://www.iana.org/domains/root/db/online.html online -// ooo : 2014-01-09 INFIBEAM AVENUES LIMITED +// ooo : INFIBEAM AVENUES LIMITED +// https://www.iana.org/domains/root/db/ooo.html ooo -// open : 2015-07-31 American Express Travel Related Services Company, Inc. +// open : American Express Travel Related Services Company, Inc. +// https://www.iana.org/domains/root/db/open.html open -// oracle : 2014-06-19 Oracle Corporation +// oracle : Oracle Corporation +// https://www.iana.org/domains/root/db/oracle.html oracle -// orange : 2015-03-12 Orange Brand Services Limited +// orange : Orange Brand Services Limited +// https://www.iana.org/domains/root/db/orange.html orange -// organic : 2014-03-27 Identity Digital Limited +// organic : Identity Digital Limited +// https://www.iana.org/domains/root/db/organic.html organic -// origins : 2015-10-01 The Estée Lauder Companies Inc. +// origins : The Estée Lauder Companies Inc. +// https://www.iana.org/domains/root/db/origins.html origins -// osaka : 2014-09-04 Osaka Registry Co., Ltd. +// osaka : Osaka Registry Co., Ltd. +// https://www.iana.org/domains/root/db/osaka.html osaka -// otsuka : 2013-10-11 Otsuka Holdings Co., Ltd. +// otsuka : Otsuka Holdings Co., Ltd. +// https://www.iana.org/domains/root/db/otsuka.html otsuka -// ott : 2015-06-04 Dish DBS Corporation +// ott : Dish DBS Corporation +// https://www.iana.org/domains/root/db/ott.html ott -// ovh : 2014-01-16 MédiaBC +// ovh : MédiaBC +// https://www.iana.org/domains/root/db/ovh.html ovh -// page : 2014-12-04 Charleston Road Registry Inc. +// page : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/page.html page -// panasonic : 2015-07-30 Panasonic Corporation +// panasonic : Panasonic Holdings Corporation +// https://www.iana.org/domains/root/db/panasonic.html panasonic -// paris : 2014-01-30 City of Paris +// paris : City of Paris +// https://www.iana.org/domains/root/db/paris.html paris -// pars : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// pars : Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// https://www.iana.org/domains/root/db/pars.html pars -// partners : 2013-12-05 Binky Moon, LLC +// partners : Binky Moon, LLC +// https://www.iana.org/domains/root/db/partners.html partners -// parts : 2013-12-05 Binky Moon, LLC +// parts : Binky Moon, LLC +// https://www.iana.org/domains/root/db/parts.html parts -// party : 2014-09-11 Blue Sky Registry Limited +// party : Blue Sky Registry Limited +// https://www.iana.org/domains/root/db/party.html party -// passagens : 2015-03-05 Travel Reservations SRL -passagens - -// pay : 2015-08-27 Amazon Registry Services, Inc. +// pay : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/pay.html pay -// pccw : 2015-05-14 PCCW Enterprises Limited +// pccw : PCCW Enterprises Limited +// https://www.iana.org/domains/root/db/pccw.html pccw -// pet : 2015-05-07 Identity Digital Limited +// pet : Identity Digital Limited +// https://www.iana.org/domains/root/db/pet.html pet -// pfizer : 2015-09-11 Pfizer Inc. +// pfizer : Pfizer Inc. +// https://www.iana.org/domains/root/db/pfizer.html pfizer -// pharmacy : 2014-06-19 National Association of Boards of Pharmacy +// pharmacy : National Association of Boards of Pharmacy +// https://www.iana.org/domains/root/db/pharmacy.html pharmacy -// phd : 2016-07-28 Charleston Road Registry Inc. +// phd : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/phd.html phd -// philips : 2014-11-07 Koninklijke Philips N.V. +// philips : Koninklijke Philips N.V. +// https://www.iana.org/domains/root/db/philips.html philips -// phone : 2016-06-02 Dish DBS Corporation +// phone : Dish DBS Corporation +// https://www.iana.org/domains/root/db/phone.html phone -// photo : 2013-11-14 Registry Services, LLC +// photo : Registry Services, LLC +// https://www.iana.org/domains/root/db/photo.html photo -// photography : 2013-09-20 Binky Moon, LLC +// photography : Binky Moon, LLC +// https://www.iana.org/domains/root/db/photography.html photography -// photos : 2013-10-17 Binky Moon, LLC +// photos : Binky Moon, LLC +// https://www.iana.org/domains/root/db/photos.html photos -// physio : 2014-05-01 PhysBiz Pty Ltd +// physio : PhysBiz Pty Ltd +// https://www.iana.org/domains/root/db/physio.html physio -// pics : 2013-11-14 XYZ.COM LLC +// pics : XYZ.COM LLC +// https://www.iana.org/domains/root/db/pics.html pics -// pictet : 2014-06-26 Pictet Europe S.A. +// pictet : Pictet Europe S.A. +// https://www.iana.org/domains/root/db/pictet.html pictet -// pictures : 2014-03-06 Binky Moon, LLC +// pictures : Binky Moon, LLC +// https://www.iana.org/domains/root/db/pictures.html pictures -// pid : 2015-01-08 Top Level Spectrum, Inc. +// pid : Top Level Spectrum, Inc. +// https://www.iana.org/domains/root/db/pid.html pid -// pin : 2014-12-18 Amazon Registry Services, Inc. +// pin : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/pin.html pin -// ping : 2015-06-11 Ping Registry Provider, Inc. +// ping : Ping Registry Provider, Inc. +// https://www.iana.org/domains/root/db/ping.html ping -// pink : 2013-10-01 Identity Digital Limited +// pink : Identity Digital Limited +// https://www.iana.org/domains/root/db/pink.html pink -// pioneer : 2015-07-16 Pioneer Corporation +// pioneer : Pioneer Corporation +// https://www.iana.org/domains/root/db/pioneer.html pioneer -// pizza : 2014-06-26 Binky Moon, LLC +// pizza : Binky Moon, LLC +// https://www.iana.org/domains/root/db/pizza.html pizza -// place : 2014-04-24 Binky Moon, LLC +// place : Binky Moon, LLC +// https://www.iana.org/domains/root/db/place.html place -// play : 2015-03-05 Charleston Road Registry Inc. +// play : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/play.html play -// playstation : 2015-07-02 Sony Interactive Entertainment Inc. +// playstation : Sony Interactive Entertainment Inc. +// https://www.iana.org/domains/root/db/playstation.html playstation -// plumbing : 2013-09-10 Binky Moon, LLC +// plumbing : Binky Moon, LLC +// https://www.iana.org/domains/root/db/plumbing.html plumbing -// plus : 2015-02-05 Binky Moon, LLC +// plus : Binky Moon, LLC +// https://www.iana.org/domains/root/db/plus.html plus -// pnc : 2015-07-02 PNC Domain Co., LLC +// pnc : PNC Domain Co., LLC +// https://www.iana.org/domains/root/db/pnc.html pnc -// pohl : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG +// pohl : Deutsche Vermögensberatung Aktiengesellschaft DVAG +// https://www.iana.org/domains/root/db/pohl.html pohl -// poker : 2014-07-03 Identity Digital Limited +// poker : Identity Digital Limited +// https://www.iana.org/domains/root/db/poker.html poker -// politie : 2015-08-20 Politie Nederland +// politie : Politie Nederland +// https://www.iana.org/domains/root/db/politie.html politie -// porn : 2014-10-16 ICM Registry PN LLC +// porn : ICM Registry PN LLC +// https://www.iana.org/domains/root/db/porn.html porn -// pramerica : 2015-07-30 Prudential Financial, Inc. +// pramerica : Prudential Financial, Inc. +// https://www.iana.org/domains/root/db/pramerica.html pramerica -// praxi : 2013-12-05 Praxi S.p.A. +// praxi : Praxi S.p.A. +// https://www.iana.org/domains/root/db/praxi.html praxi -// press : 2014-04-03 Radix FZC +// press : Radix FZC DMCC +// https://www.iana.org/domains/root/db/press.html press -// prime : 2015-06-25 Amazon Registry Services, Inc. +// prime : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/prime.html prime -// prod : 2014-01-23 Charleston Road Registry Inc. +// prod : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/prod.html prod -// productions : 2013-12-05 Binky Moon, LLC +// productions : Binky Moon, LLC +// https://www.iana.org/domains/root/db/productions.html productions -// prof : 2014-07-24 Charleston Road Registry Inc. +// prof : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/prof.html prof -// progressive : 2015-07-23 Progressive Casualty Insurance Company +// progressive : Progressive Casualty Insurance Company +// https://www.iana.org/domains/root/db/progressive.html progressive -// promo : 2014-12-18 Identity Digital Limited +// promo : Identity Digital Limited +// https://www.iana.org/domains/root/db/promo.html promo -// properties : 2013-12-05 Binky Moon, LLC +// properties : Binky Moon, LLC +// https://www.iana.org/domains/root/db/properties.html properties -// property : 2014-05-22 Internet Naming Company LLC +// property : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/property.html property -// protection : 2015-04-23 XYZ.COM LLC +// protection : XYZ.COM LLC +// https://www.iana.org/domains/root/db/protection.html protection -// pru : 2015-07-30 Prudential Financial, Inc. +// pru : Prudential Financial, Inc. +// https://www.iana.org/domains/root/db/pru.html pru -// prudential : 2015-07-30 Prudential Financial, Inc. +// prudential : Prudential Financial, Inc. +// https://www.iana.org/domains/root/db/prudential.html prudential -// pub : 2013-12-12 Dog Beach, LLC +// pub : Dog Beach, LLC +// https://www.iana.org/domains/root/db/pub.html pub -// pwc : 2015-10-29 PricewaterhouseCoopers LLP +// pwc : PricewaterhouseCoopers LLP +// https://www.iana.org/domains/root/db/pwc.html pwc -// qpon : 2013-11-14 dotQPON LLC +// qpon : dotQPON LLC +// https://www.iana.org/domains/root/db/qpon.html qpon -// quebec : 2013-12-19 PointQuébec Inc +// quebec : PointQuébec Inc +// https://www.iana.org/domains/root/db/quebec.html quebec -// quest : 2015-03-26 XYZ.COM LLC +// quest : XYZ.COM LLC +// https://www.iana.org/domains/root/db/quest.html quest -// racing : 2014-12-04 Premier Registry Limited +// racing : Premier Registry Limited +// https://www.iana.org/domains/root/db/racing.html racing -// radio : 2016-07-21 European Broadcasting Union (EBU) +// radio : European Broadcasting Union (EBU) +// https://www.iana.org/domains/root/db/radio.html radio -// read : 2014-12-18 Amazon Registry Services, Inc. +// read : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/read.html read -// realestate : 2015-09-11 dotRealEstate LLC +// realestate : dotRealEstate LLC +// https://www.iana.org/domains/root/db/realestate.html realestate -// realtor : 2014-05-29 Real Estate Domains LLC +// realtor : Real Estate Domains LLC +// https://www.iana.org/domains/root/db/realtor.html realtor -// realty : 2015-03-19 Dog Beach, LLC +// realty : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/realty.html realty -// recipes : 2013-10-17 Binky Moon, LLC +// recipes : Binky Moon, LLC +// https://www.iana.org/domains/root/db/recipes.html recipes -// red : 2013-11-07 Identity Digital Limited +// red : Identity Digital Limited +// https://www.iana.org/domains/root/db/red.html red -// redstone : 2014-10-31 Redstone Haute Couture Co., Ltd. +// redstone : Redstone Haute Couture Co., Ltd. +// https://www.iana.org/domains/root/db/redstone.html redstone -// redumbrella : 2015-03-26 Travelers TLD, LLC +// redumbrella : Travelers TLD, LLC +// https://www.iana.org/domains/root/db/redumbrella.html redumbrella -// rehab : 2014-03-06 Dog Beach, LLC +// rehab : Dog Beach, LLC +// https://www.iana.org/domains/root/db/rehab.html rehab -// reise : 2014-03-13 Binky Moon, LLC +// reise : Binky Moon, LLC +// https://www.iana.org/domains/root/db/reise.html reise -// reisen : 2014-03-06 Binky Moon, LLC +// reisen : Binky Moon, LLC +// https://www.iana.org/domains/root/db/reisen.html reisen -// reit : 2014-09-04 National Association of Real Estate Investment Trusts, Inc. +// reit : National Association of Real Estate Investment Trusts, Inc. +// https://www.iana.org/domains/root/db/reit.html reit -// reliance : 2015-04-02 Reliance Industries Limited +// reliance : Reliance Industries Limited +// https://www.iana.org/domains/root/db/reliance.html reliance -// ren : 2013-12-12 ZDNS International Limited +// ren : ZDNS International Limited +// https://www.iana.org/domains/root/db/ren.html ren -// rent : 2014-12-04 XYZ.COM LLC +// rent : XYZ.COM LLC +// https://www.iana.org/domains/root/db/rent.html rent -// rentals : 2013-12-05 Binky Moon, LLC +// rentals : Binky Moon, LLC +// https://www.iana.org/domains/root/db/rentals.html rentals -// repair : 2013-11-07 Binky Moon, LLC +// repair : Binky Moon, LLC +// https://www.iana.org/domains/root/db/repair.html repair -// report : 2013-12-05 Binky Moon, LLC +// report : Binky Moon, LLC +// https://www.iana.org/domains/root/db/report.html report -// republican : 2014-03-20 Dog Beach, LLC +// republican : Dog Beach, LLC +// https://www.iana.org/domains/root/db/republican.html republican -// rest : 2013-12-19 Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable +// rest : Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable +// https://www.iana.org/domains/root/db/rest.html rest -// restaurant : 2014-07-03 Binky Moon, LLC +// restaurant : Binky Moon, LLC +// https://www.iana.org/domains/root/db/restaurant.html restaurant -// review : 2014-11-20 dot Review Limited +// review : dot Review Limited +// https://www.iana.org/domains/root/db/review.html review -// reviews : 2013-09-13 Dog Beach, LLC +// reviews : Dog Beach, LLC +// https://www.iana.org/domains/root/db/reviews.html reviews -// rexroth : 2015-06-18 Robert Bosch GMBH +// rexroth : Robert Bosch GMBH +// https://www.iana.org/domains/root/db/rexroth.html rexroth -// rich : 2013-11-21 iRegistry GmbH +// rich : iRegistry GmbH +// https://www.iana.org/domains/root/db/rich.html rich -// richardli : 2015-05-14 Pacific Century Asset Management (HK) Limited +// richardli : Pacific Century Asset Management (HK) Limited +// https://www.iana.org/domains/root/db/richardli.html richardli -// ricoh : 2014-11-20 Ricoh Company, Ltd. +// ricoh : Ricoh Company, Ltd. +// https://www.iana.org/domains/root/db/ricoh.html ricoh -// ril : 2015-04-02 Reliance Industries Limited +// ril : Reliance Industries Limited +// https://www.iana.org/domains/root/db/ril.html ril -// rio : 2014-02-27 Empresa Municipal de Informática SA - IPLANRIO +// rio : Empresa Municipal de Informática SA - IPLANRIO +// https://www.iana.org/domains/root/db/rio.html rio -// rip : 2014-07-10 Dog Beach, LLC +// rip : Dog Beach, LLC +// https://www.iana.org/domains/root/db/rip.html rip -// rocher : 2014-12-18 Ferrero Trading Lux S.A. +// rocher : Ferrero Trading Lux S.A. +// https://www.iana.org/domains/root/db/rocher.html rocher -// rocks : 2013-11-14 Dog Beach, LLC +// rocks : Dog Beach, LLC +// https://www.iana.org/domains/root/db/rocks.html rocks -// rodeo : 2013-12-19 Registry Services, LLC +// rodeo : Registry Services, LLC +// https://www.iana.org/domains/root/db/rodeo.html rodeo -// rogers : 2015-08-06 Rogers Communications Canada Inc. +// rogers : Rogers Communications Canada Inc. +// https://www.iana.org/domains/root/db/rogers.html rogers -// room : 2014-12-18 Amazon Registry Services, Inc. +// room : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/room.html room -// rsvp : 2014-05-08 Charleston Road Registry Inc. +// rsvp : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/rsvp.html rsvp -// rugby : 2016-12-15 World Rugby Strategic Developments Limited +// rugby : World Rugby Strategic Developments Limited +// https://www.iana.org/domains/root/db/rugby.html rugby -// ruhr : 2013-10-02 dotSaarland GmbH +// ruhr : dotSaarland GmbH +// https://www.iana.org/domains/root/db/ruhr.html ruhr -// run : 2015-03-19 Binky Moon, LLC +// run : Binky Moon, LLC +// https://www.iana.org/domains/root/db/run.html run -// rwe : 2015-04-02 RWE AG +// rwe : RWE AG +// https://www.iana.org/domains/root/db/rwe.html rwe -// ryukyu : 2014-01-09 BRregistry, Inc. +// ryukyu : BRregistry, Inc. +// https://www.iana.org/domains/root/db/ryukyu.html ryukyu -// saarland : 2013-12-12 dotSaarland GmbH +// saarland : dotSaarland GmbH +// https://www.iana.org/domains/root/db/saarland.html saarland -// safe : 2014-12-18 Amazon Registry Services, Inc. +// safe : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/safe.html safe -// safety : 2015-01-08 Safety Registry Services, LLC. +// safety : Safety Registry Services, LLC. +// https://www.iana.org/domains/root/db/safety.html safety -// sakura : 2014-12-18 SAKURA Internet Inc. +// sakura : SAKURA Internet Inc. +// https://www.iana.org/domains/root/db/sakura.html sakura -// sale : 2014-10-16 Dog Beach, LLC +// sale : Dog Beach, LLC +// https://www.iana.org/domains/root/db/sale.html sale -// salon : 2014-12-11 Binky Moon, LLC +// salon : Binky Moon, LLC +// https://www.iana.org/domains/root/db/salon.html salon -// samsclub : 2015-07-31 Wal-Mart Stores, Inc. +// samsclub : Wal-Mart Stores, Inc. +// https://www.iana.org/domains/root/db/samsclub.html samsclub -// samsung : 2014-04-03 SAMSUNG SDS CO., LTD +// samsung : SAMSUNG SDS CO., LTD +// https://www.iana.org/domains/root/db/samsung.html samsung -// sandvik : 2014-11-13 Sandvik AB +// sandvik : Sandvik AB +// https://www.iana.org/domains/root/db/sandvik.html sandvik -// sandvikcoromant : 2014-11-07 Sandvik AB +// sandvikcoromant : Sandvik AB +// https://www.iana.org/domains/root/db/sandvikcoromant.html sandvikcoromant -// sanofi : 2014-10-09 Sanofi +// sanofi : Sanofi +// https://www.iana.org/domains/root/db/sanofi.html sanofi -// sap : 2014-03-27 SAP AG +// sap : SAP AG +// https://www.iana.org/domains/root/db/sap.html sap -// sarl : 2014-07-03 Binky Moon, LLC +// sarl : Binky Moon, LLC +// https://www.iana.org/domains/root/db/sarl.html sarl -// sas : 2015-04-02 Research IP LLC +// sas : Research IP LLC +// https://www.iana.org/domains/root/db/sas.html sas -// save : 2015-06-25 Amazon Registry Services, Inc. +// save : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/save.html save -// saxo : 2014-10-31 Saxo Bank A/S +// saxo : Saxo Bank A/S +// https://www.iana.org/domains/root/db/saxo.html saxo -// sbi : 2015-03-12 STATE BANK OF INDIA +// sbi : STATE BANK OF INDIA +// https://www.iana.org/domains/root/db/sbi.html sbi -// sbs : 2014-11-07 ShortDot SA +// sbs : ShortDot SA +// https://www.iana.org/domains/root/db/sbs.html sbs -// sca : 2014-03-13 SVENSKA CELLULOSA AKTIEBOLAGET SCA (publ) +// sca : SVENSKA CELLULOSA AKTIEBOLAGET SCA (publ) +// https://www.iana.org/domains/root/db/sca.html sca -// scb : 2014-02-20 The Siam Commercial Bank Public Company Limited ("SCB") +// scb : The Siam Commercial Bank Public Company Limited ("SCB") +// https://www.iana.org/domains/root/db/scb.html scb -// schaeffler : 2015-08-06 Schaeffler Technologies AG & Co. KG +// schaeffler : Schaeffler Technologies AG & Co. KG +// https://www.iana.org/domains/root/db/schaeffler.html schaeffler -// schmidt : 2014-04-03 SCHMIDT GROUPE S.A.S. +// schmidt : SCHMIDT GROUPE S.A.S. +// https://www.iana.org/domains/root/db/schmidt.html schmidt -// scholarships : 2014-04-24 Scholarships.com, LLC +// scholarships : Scholarships.com, LLC +// https://www.iana.org/domains/root/db/scholarships.html scholarships -// school : 2014-12-18 Binky Moon, LLC +// school : Binky Moon, LLC +// https://www.iana.org/domains/root/db/school.html school -// schule : 2014-03-06 Binky Moon, LLC +// schule : Binky Moon, LLC +// https://www.iana.org/domains/root/db/schule.html schule -// schwarz : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG +// schwarz : Schwarz Domains und Services GmbH & Co. KG +// https://www.iana.org/domains/root/db/schwarz.html schwarz -// science : 2014-09-11 dot Science Limited +// science : dot Science Limited +// https://www.iana.org/domains/root/db/science.html science -// scot : 2014-01-23 Dot Scot Registry Limited +// scot : Dot Scot Registry Limited +// https://www.iana.org/domains/root/db/scot.html scot -// search : 2016-06-09 Charleston Road Registry Inc. +// search : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/search.html search -// seat : 2014-05-22 SEAT, S.A. (Sociedad Unipersonal) +// seat : SEAT, S.A. (Sociedad Unipersonal) +// https://www.iana.org/domains/root/db/seat.html seat -// secure : 2015-08-27 Amazon Registry Services, Inc. +// secure : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/secure.html secure -// security : 2015-05-14 XYZ.COM LLC +// security : XYZ.COM LLC +// https://www.iana.org/domains/root/db/security.html security -// seek : 2014-12-04 Seek Limited +// seek : Seek Limited +// https://www.iana.org/domains/root/db/seek.html seek -// select : 2015-10-08 Registry Services, LLC +// select : Registry Services, LLC +// https://www.iana.org/domains/root/db/select.html select -// sener : 2014-10-24 Sener Ingeniería y Sistemas, S.A. +// sener : Sener Ingeniería y Sistemas, S.A. +// https://www.iana.org/domains/root/db/sener.html sener -// services : 2014-02-27 Binky Moon, LLC +// services : Binky Moon, LLC +// https://www.iana.org/domains/root/db/services.html services -// seven : 2015-08-06 Seven West Media Ltd +// seven : Seven West Media Ltd +// https://www.iana.org/domains/root/db/seven.html seven -// sew : 2014-07-17 SEW-EURODRIVE GmbH & Co KG +// sew : SEW-EURODRIVE GmbH & Co KG +// https://www.iana.org/domains/root/db/sew.html sew -// sex : 2014-11-13 ICM Registry SX LLC +// sex : ICM Registry SX LLC +// https://www.iana.org/domains/root/db/sex.html sex -// sexy : 2013-09-11 Internet Naming Company LLC +// sexy : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/sexy.html sexy -// sfr : 2015-08-13 Societe Francaise du Radiotelephone - SFR +// sfr : Societe Francaise du Radiotelephone - SFR +// https://www.iana.org/domains/root/db/sfr.html sfr -// shangrila : 2015-09-03 Shangri‐La International Hotel Management Limited +// shangrila : Shangri‐La International Hotel Management Limited +// https://www.iana.org/domains/root/db/shangrila.html shangrila -// sharp : 2014-05-01 Sharp Corporation +// sharp : Sharp Corporation +// https://www.iana.org/domains/root/db/sharp.html sharp -// shaw : 2015-04-23 Shaw Cablesystems G.P. +// shaw : Shaw Cablesystems G.P. +// https://www.iana.org/domains/root/db/shaw.html shaw -// shell : 2015-07-30 Shell Information Technology International Inc +// shell : Shell Information Technology International Inc +// https://www.iana.org/domains/root/db/shell.html shell -// shia : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// shia : Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// https://www.iana.org/domains/root/db/shia.html shia -// shiksha : 2013-11-14 Identity Digital Limited +// shiksha : Identity Digital Limited +// https://www.iana.org/domains/root/db/shiksha.html shiksha -// shoes : 2013-10-02 Binky Moon, LLC +// shoes : Binky Moon, LLC +// https://www.iana.org/domains/root/db/shoes.html shoes -// shop : 2016-04-08 GMO Registry, Inc. +// shop : GMO Registry, Inc. +// https://www.iana.org/domains/root/db/shop.html shop -// shopping : 2016-03-31 Binky Moon, LLC +// shopping : Binky Moon, LLC +// https://www.iana.org/domains/root/db/shopping.html shopping -// shouji : 2015-01-08 Beijing Qihu Keji Co., Ltd. +// shouji : Beijing Qihu Keji Co., Ltd. +// https://www.iana.org/domains/root/db/shouji.html shouji -// show : 2015-03-05 Binky Moon, LLC +// show : Binky Moon, LLC +// https://www.iana.org/domains/root/db/show.html show -// showtime : 2015-08-06 CBS Domains Inc. +// showtime : CBS Domains Inc. +// https://www.iana.org/domains/root/db/showtime.html showtime -// silk : 2015-06-25 Amazon Registry Services, Inc. +// silk : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/silk.html silk -// sina : 2015-03-12 Sina Corporation +// sina : Sina Corporation +// https://www.iana.org/domains/root/db/sina.html sina -// singles : 2013-08-27 Binky Moon, LLC +// singles : Binky Moon, LLC +// https://www.iana.org/domains/root/db/singles.html singles -// site : 2015-01-15 Radix FZC +// site : Radix FZC DMCC +// https://www.iana.org/domains/root/db/site.html site -// ski : 2015-04-09 Identity Digital Limited +// ski : Identity Digital Limited +// https://www.iana.org/domains/root/db/ski.html ski -// skin : 2015-01-15 XYZ.COM LLC +// skin : XYZ.COM LLC +// https://www.iana.org/domains/root/db/skin.html skin -// sky : 2014-06-19 Sky International AG +// sky : Sky International AG +// https://www.iana.org/domains/root/db/sky.html sky -// skype : 2014-12-18 Microsoft Corporation +// skype : Microsoft Corporation +// https://www.iana.org/domains/root/db/skype.html skype -// sling : 2015-07-30 DISH Technologies L.L.C. +// sling : DISH Technologies L.L.C. +// https://www.iana.org/domains/root/db/sling.html sling -// smart : 2015-07-09 Smart Communications, Inc. (SMART) +// smart : Smart Communications, Inc. (SMART) +// https://www.iana.org/domains/root/db/smart.html smart -// smile : 2014-12-18 Amazon Registry Services, Inc. +// smile : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/smile.html smile -// sncf : 2015-02-19 Société Nationale SNCF +// sncf : Société Nationale SNCF +// https://www.iana.org/domains/root/db/sncf.html sncf -// soccer : 2015-03-26 Binky Moon, LLC +// soccer : Binky Moon, LLC +// https://www.iana.org/domains/root/db/soccer.html soccer -// social : 2013-11-07 Dog Beach, LLC +// social : Dog Beach, LLC +// https://www.iana.org/domains/root/db/social.html social -// softbank : 2015-07-02 SoftBank Group Corp. +// softbank : SoftBank Group Corp. +// https://www.iana.org/domains/root/db/softbank.html softbank -// software : 2014-03-20 Dog Beach, LLC +// software : Dog Beach, LLC +// https://www.iana.org/domains/root/db/software.html software -// sohu : 2013-12-19 Sohu.com Limited +// sohu : Sohu.com Limited +// https://www.iana.org/domains/root/db/sohu.html sohu -// solar : 2013-11-07 Binky Moon, LLC +// solar : Binky Moon, LLC +// https://www.iana.org/domains/root/db/solar.html solar -// solutions : 2013-11-07 Binky Moon, LLC +// solutions : Binky Moon, LLC +// https://www.iana.org/domains/root/db/solutions.html solutions -// song : 2015-02-26 Amazon Registry Services, Inc. +// song : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/song.html song -// sony : 2015-01-08 Sony Corporation +// sony : Sony Corporation +// https://www.iana.org/domains/root/db/sony.html sony -// soy : 2014-01-23 Charleston Road Registry Inc. +// soy : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/soy.html soy -// spa : 2019-09-19 Asia Spa and Wellness Promotion Council Limited +// spa : Asia Spa and Wellness Promotion Council Limited +// https://www.iana.org/domains/root/db/spa.html spa -// space : 2014-04-03 Radix FZC +// space : Radix FZC DMCC +// https://www.iana.org/domains/root/db/space.html space -// sport : 2017-11-16 Global Association of International Sports Federations (GAISF) +// sport : SportAccord +// https://www.iana.org/domains/root/db/sport.html sport -// spot : 2015-02-26 Amazon Registry Services, Inc. +// spot : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/spot.html spot -// srl : 2015-05-07 InterNetX, Corp +// srl : InterNetX, Corp +// https://www.iana.org/domains/root/db/srl.html srl -// stada : 2014-11-13 STADA Arzneimittel AG +// stada : STADA Arzneimittel AG +// https://www.iana.org/domains/root/db/stada.html stada -// staples : 2015-07-30 Staples, Inc. +// staples : Staples, Inc. +// https://www.iana.org/domains/root/db/staples.html staples -// star : 2015-01-08 Star India Private Limited +// star : Star India Private Limited +// https://www.iana.org/domains/root/db/star.html star -// statebank : 2015-03-12 STATE BANK OF INDIA +// statebank : STATE BANK OF INDIA +// https://www.iana.org/domains/root/db/statebank.html statebank -// statefarm : 2015-07-30 State Farm Mutual Automobile Insurance Company +// statefarm : State Farm Mutual Automobile Insurance Company +// https://www.iana.org/domains/root/db/statefarm.html statefarm -// stc : 2014-10-09 Saudi Telecom Company +// stc : Saudi Telecom Company +// https://www.iana.org/domains/root/db/stc.html stc -// stcgroup : 2014-10-09 Saudi Telecom Company +// stcgroup : Saudi Telecom Company +// https://www.iana.org/domains/root/db/stcgroup.html stcgroup -// stockholm : 2014-12-18 Stockholms kommun +// stockholm : Stockholms kommun +// https://www.iana.org/domains/root/db/stockholm.html stockholm -// storage : 2014-12-22 XYZ.COM LLC +// storage : XYZ.COM LLC +// https://www.iana.org/domains/root/db/storage.html storage -// store : 2015-04-09 Radix FZC +// store : Radix FZC DMCC +// https://www.iana.org/domains/root/db/store.html store -// stream : 2016-01-08 dot Stream Limited +// stream : dot Stream Limited +// https://www.iana.org/domains/root/db/stream.html stream -// studio : 2015-02-11 Dog Beach, LLC +// studio : Dog Beach, LLC +// https://www.iana.org/domains/root/db/studio.html studio -// study : 2014-12-11 Registry Services, LLC +// study : Registry Services, LLC +// https://www.iana.org/domains/root/db/study.html study -// style : 2014-12-04 Binky Moon, LLC +// style : Binky Moon, LLC +// https://www.iana.org/domains/root/db/style.html style -// sucks : 2014-12-22 Vox Populi Registry Ltd. +// sucks : Vox Populi Registry Ltd. +// https://www.iana.org/domains/root/db/sucks.html sucks -// supplies : 2013-12-19 Binky Moon, LLC +// supplies : Binky Moon, LLC +// https://www.iana.org/domains/root/db/supplies.html supplies -// supply : 2013-12-19 Binky Moon, LLC +// supply : Binky Moon, LLC +// https://www.iana.org/domains/root/db/supply.html supply -// support : 2013-10-24 Binky Moon, LLC +// support : Binky Moon, LLC +// https://www.iana.org/domains/root/db/support.html support -// surf : 2014-01-09 Registry Services, LLC +// surf : Registry Services, LLC +// https://www.iana.org/domains/root/db/surf.html surf -// surgery : 2014-03-20 Binky Moon, LLC +// surgery : Binky Moon, LLC +// https://www.iana.org/domains/root/db/surgery.html surgery -// suzuki : 2014-02-20 SUZUKI MOTOR CORPORATION +// suzuki : SUZUKI MOTOR CORPORATION +// https://www.iana.org/domains/root/db/suzuki.html suzuki -// swatch : 2015-01-08 The Swatch Group Ltd +// swatch : The Swatch Group Ltd +// https://www.iana.org/domains/root/db/swatch.html swatch -// swiss : 2014-10-16 Swiss Confederation +// swiss : Swiss Confederation +// https://www.iana.org/domains/root/db/swiss.html swiss -// sydney : 2014-09-18 State of New South Wales, Department of Premier and Cabinet +// sydney : State of New South Wales, Department of Premier and Cabinet +// https://www.iana.org/domains/root/db/sydney.html sydney -// systems : 2013-11-07 Binky Moon, LLC +// systems : Binky Moon, LLC +// https://www.iana.org/domains/root/db/systems.html systems -// tab : 2014-12-04 Tabcorp Holdings Limited +// tab : Tabcorp Holdings Limited +// https://www.iana.org/domains/root/db/tab.html tab -// taipei : 2014-07-10 Taipei City Government +// taipei : Taipei City Government +// https://www.iana.org/domains/root/db/taipei.html taipei -// talk : 2015-04-09 Amazon Registry Services, Inc. +// talk : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/talk.html talk -// taobao : 2015-01-15 Alibaba Group Holding Limited +// taobao : Alibaba Group Holding Limited +// https://www.iana.org/domains/root/db/taobao.html taobao -// target : 2015-07-31 Target Domain Holdings, LLC +// target : Target Domain Holdings, LLC +// https://www.iana.org/domains/root/db/target.html target -// tatamotors : 2015-03-12 Tata Motors Ltd +// tatamotors : Tata Motors Ltd +// https://www.iana.org/domains/root/db/tatamotors.html tatamotors -// tatar : 2014-04-24 Limited Liability Company "Coordination Center of Regional Domain of Tatarstan Republic" +// tatar : Limited Liability Company "Coordination Center of Regional Domain of Tatarstan Republic" +// https://www.iana.org/domains/root/db/tatar.html tatar -// tattoo : 2013-08-30 Top Level Design, LLC +// tattoo : Registry Services, LLC +// https://www.iana.org/domains/root/db/tattoo.html tattoo -// tax : 2014-03-20 Binky Moon, LLC +// tax : Binky Moon, LLC +// https://www.iana.org/domains/root/db/tax.html tax -// taxi : 2015-03-19 Binky Moon, LLC +// taxi : Binky Moon, LLC +// https://www.iana.org/domains/root/db/taxi.html taxi -// tci : 2014-09-12 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// tci : Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// https://www.iana.org/domains/root/db/tci.html tci -// tdk : 2015-06-11 TDK Corporation +// tdk : TDK Corporation +// https://www.iana.org/domains/root/db/tdk.html tdk -// team : 2015-03-05 Binky Moon, LLC +// team : Binky Moon, LLC +// https://www.iana.org/domains/root/db/team.html team -// tech : 2015-01-30 Radix FZC +// tech : Radix FZC DMCC +// https://www.iana.org/domains/root/db/tech.html tech -// technology : 2013-09-13 Binky Moon, LLC +// technology : Binky Moon, LLC +// https://www.iana.org/domains/root/db/technology.html technology -// temasek : 2014-08-07 Temasek Holdings (Private) Limited +// temasek : Temasek Holdings (Private) Limited +// https://www.iana.org/domains/root/db/temasek.html temasek -// tennis : 2014-12-04 Binky Moon, LLC +// tennis : Binky Moon, LLC +// https://www.iana.org/domains/root/db/tennis.html tennis -// teva : 2015-07-02 Teva Pharmaceutical Industries Limited +// teva : Teva Pharmaceutical Industries Limited +// https://www.iana.org/domains/root/db/teva.html teva -// thd : 2015-04-02 Home Depot Product Authority, LLC +// thd : Home Depot Product Authority, LLC +// https://www.iana.org/domains/root/db/thd.html thd -// theater : 2015-03-19 Binky Moon, LLC +// theater : Binky Moon, LLC +// https://www.iana.org/domains/root/db/theater.html theater -// theatre : 2015-05-07 XYZ.COM LLC +// theatre : XYZ.COM LLC +// https://www.iana.org/domains/root/db/theatre.html theatre -// tiaa : 2015-07-23 Teachers Insurance and Annuity Association of America +// tiaa : Teachers Insurance and Annuity Association of America +// https://www.iana.org/domains/root/db/tiaa.html tiaa -// tickets : 2015-02-05 XYZ.COM LLC +// tickets : XYZ.COM LLC +// https://www.iana.org/domains/root/db/tickets.html tickets -// tienda : 2013-11-14 Binky Moon, LLC +// tienda : Binky Moon, LLC +// https://www.iana.org/domains/root/db/tienda.html tienda -// tiffany : 2015-01-30 Tiffany and Company -tiffany - -// tips : 2013-09-20 Binky Moon, LLC +// tips : Binky Moon, LLC +// https://www.iana.org/domains/root/db/tips.html tips -// tires : 2014-11-07 Binky Moon, LLC +// tires : Binky Moon, LLC +// https://www.iana.org/domains/root/db/tires.html tires -// tirol : 2014-04-24 punkt Tirol GmbH +// tirol : punkt Tirol GmbH +// https://www.iana.org/domains/root/db/tirol.html tirol -// tjmaxx : 2015-07-16 The TJX Companies, Inc. +// tjmaxx : The TJX Companies, Inc. +// https://www.iana.org/domains/root/db/tjmaxx.html tjmaxx -// tjx : 2015-07-16 The TJX Companies, Inc. +// tjx : The TJX Companies, Inc. +// https://www.iana.org/domains/root/db/tjx.html tjx -// tkmaxx : 2015-07-16 The TJX Companies, Inc. +// tkmaxx : The TJX Companies, Inc. +// https://www.iana.org/domains/root/db/tkmaxx.html tkmaxx -// tmall : 2015-01-15 Alibaba Group Holding Limited +// tmall : Alibaba Group Holding Limited +// https://www.iana.org/domains/root/db/tmall.html tmall -// today : 2013-09-20 Binky Moon, LLC +// today : Binky Moon, LLC +// https://www.iana.org/domains/root/db/today.html today -// tokyo : 2013-11-13 GMO Registry, Inc. +// tokyo : GMO Registry, Inc. +// https://www.iana.org/domains/root/db/tokyo.html tokyo -// tools : 2013-11-21 Binky Moon, LLC +// tools : Binky Moon, LLC +// https://www.iana.org/domains/root/db/tools.html tools -// top : 2014-03-20 .TOP Registry +// top : .TOP Registry +// https://www.iana.org/domains/root/db/top.html top -// toray : 2014-12-18 Toray Industries, Inc. +// toray : Toray Industries, Inc. +// https://www.iana.org/domains/root/db/toray.html toray -// toshiba : 2014-04-10 TOSHIBA Corporation +// toshiba : TOSHIBA Corporation +// https://www.iana.org/domains/root/db/toshiba.html toshiba -// total : 2015-08-06 TotalEnergies SE +// total : TotalEnergies SE +// https://www.iana.org/domains/root/db/total.html total -// tours : 2015-01-22 Binky Moon, LLC +// tours : Binky Moon, LLC +// https://www.iana.org/domains/root/db/tours.html tours -// town : 2014-03-06 Binky Moon, LLC +// town : Binky Moon, LLC +// https://www.iana.org/domains/root/db/town.html town -// toyota : 2015-04-23 TOYOTA MOTOR CORPORATION +// toyota : TOYOTA MOTOR CORPORATION +// https://www.iana.org/domains/root/db/toyota.html toyota -// toys : 2014-03-06 Binky Moon, LLC +// toys : Binky Moon, LLC +// https://www.iana.org/domains/root/db/toys.html toys -// trade : 2014-01-23 Elite Registry Limited +// trade : Elite Registry Limited +// https://www.iana.org/domains/root/db/trade.html trade -// trading : 2014-12-11 Dog Beach, LLC +// trading : Dog Beach, LLC +// https://www.iana.org/domains/root/db/trading.html trading -// training : 2013-11-07 Binky Moon, LLC +// training : Binky Moon, LLC +// https://www.iana.org/domains/root/db/training.html training -// travel : 2015-10-09 Dog Beach, LLC +// travel : Dog Beach, LLC +// https://www.iana.org/domains/root/db/travel.html travel -// travelchannel : 2015-07-02 Lifestyle Domain Holdings, Inc. -travelchannel - -// travelers : 2015-03-26 Travelers TLD, LLC +// travelers : Travelers TLD, LLC +// https://www.iana.org/domains/root/db/travelers.html travelers -// travelersinsurance : 2015-03-26 Travelers TLD, LLC +// travelersinsurance : Travelers TLD, LLC +// https://www.iana.org/domains/root/db/travelersinsurance.html travelersinsurance -// trust : 2014-10-16 Internet Naming Company LLC +// trust : Internet Naming Company LLC +// https://www.iana.org/domains/root/db/trust.html trust -// trv : 2015-03-26 Travelers TLD, LLC +// trv : Travelers TLD, LLC +// https://www.iana.org/domains/root/db/trv.html trv -// tube : 2015-06-11 Latin American Telecom LLC +// tube : Latin American Telecom LLC +// https://www.iana.org/domains/root/db/tube.html tube -// tui : 2014-07-03 TUI AG +// tui : TUI AG +// https://www.iana.org/domains/root/db/tui.html tui -// tunes : 2015-02-26 Amazon Registry Services, Inc. +// tunes : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/tunes.html tunes -// tushu : 2014-12-18 Amazon Registry Services, Inc. +// tushu : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/tushu.html tushu -// tvs : 2015-02-19 T V SUNDRAM IYENGAR & SONS LIMITED +// tvs : T V SUNDRAM IYENGAR & SONS LIMITED +// https://www.iana.org/domains/root/db/tvs.html tvs -// ubank : 2015-08-20 National Australia Bank Limited +// ubank : National Australia Bank Limited +// https://www.iana.org/domains/root/db/ubank.html ubank -// ubs : 2014-12-11 UBS AG +// ubs : UBS AG +// https://www.iana.org/domains/root/db/ubs.html ubs -// unicom : 2015-10-15 China United Network Communications Corporation Limited +// unicom : China United Network Communications Corporation Limited +// https://www.iana.org/domains/root/db/unicom.html unicom -// university : 2014-03-06 Binky Moon, LLC +// university : Binky Moon, LLC +// https://www.iana.org/domains/root/db/university.html university -// uno : 2013-09-11 Radix FZC +// uno : Radix FZC DMCC +// https://www.iana.org/domains/root/db/uno.html uno -// uol : 2014-05-01 UBN INTERNET LTDA. +// uol : UBN INTERNET LTDA. +// https://www.iana.org/domains/root/db/uol.html uol -// ups : 2015-06-25 UPS Market Driver, Inc. +// ups : UPS Market Driver, Inc. +// https://www.iana.org/domains/root/db/ups.html ups -// vacations : 2013-12-05 Binky Moon, LLC +// vacations : Binky Moon, LLC +// https://www.iana.org/domains/root/db/vacations.html vacations -// vana : 2014-12-11 Lifestyle Domain Holdings, Inc. +// vana : Lifestyle Domain Holdings, Inc. +// https://www.iana.org/domains/root/db/vana.html vana -// vanguard : 2015-09-03 The Vanguard Group, Inc. +// vanguard : The Vanguard Group, Inc. +// https://www.iana.org/domains/root/db/vanguard.html vanguard -// vegas : 2014-01-16 Dot Vegas, Inc. +// vegas : Dot Vegas, Inc. +// https://www.iana.org/domains/root/db/vegas.html vegas -// ventures : 2013-08-27 Binky Moon, LLC +// ventures : Binky Moon, LLC +// https://www.iana.org/domains/root/db/ventures.html ventures -// verisign : 2015-08-13 VeriSign, Inc. +// verisign : VeriSign, Inc. +// https://www.iana.org/domains/root/db/verisign.html verisign -// versicherung : 2014-03-20 tldbox GmbH +// versicherung : tldbox GmbH +// https://www.iana.org/domains/root/db/versicherung.html versicherung -// vet : 2014-03-06 Dog Beach, LLC +// vet : Dog Beach, LLC +// https://www.iana.org/domains/root/db/vet.html vet -// viajes : 2013-10-17 Binky Moon, LLC +// viajes : Binky Moon, LLC +// https://www.iana.org/domains/root/db/viajes.html viajes -// video : 2014-10-16 Dog Beach, LLC +// video : Dog Beach, LLC +// https://www.iana.org/domains/root/db/video.html video -// vig : 2015-05-14 VIENNA INSURANCE GROUP AG Wiener Versicherung Gruppe +// vig : VIENNA INSURANCE GROUP AG Wiener Versicherung Gruppe +// https://www.iana.org/domains/root/db/vig.html vig -// viking : 2015-04-02 Viking River Cruises (Bermuda) Ltd. +// viking : Viking River Cruises (Bermuda) Ltd. +// https://www.iana.org/domains/root/db/viking.html viking -// villas : 2013-12-05 Binky Moon, LLC +// villas : Binky Moon, LLC +// https://www.iana.org/domains/root/db/villas.html villas -// vin : 2015-06-18 Binky Moon, LLC +// vin : Binky Moon, LLC +// https://www.iana.org/domains/root/db/vin.html vin -// vip : 2015-01-22 Registry Services, LLC +// vip : Registry Services, LLC +// https://www.iana.org/domains/root/db/vip.html vip -// virgin : 2014-09-25 Virgin Enterprises Limited +// virgin : Virgin Enterprises Limited +// https://www.iana.org/domains/root/db/virgin.html virgin -// visa : 2015-07-30 Visa Worldwide Pte. Limited +// visa : Visa Worldwide Pte. Limited +// https://www.iana.org/domains/root/db/visa.html visa -// vision : 2013-12-05 Binky Moon, LLC +// vision : Binky Moon, LLC +// https://www.iana.org/domains/root/db/vision.html vision -// viva : 2014-11-07 Saudi Telecom Company +// viva : Saudi Telecom Company +// https://www.iana.org/domains/root/db/viva.html viva -// vivo : 2015-07-31 Telefonica Brasil S.A. +// vivo : Telefonica Brasil S.A. +// https://www.iana.org/domains/root/db/vivo.html vivo -// vlaanderen : 2014-02-06 DNS.be vzw +// vlaanderen : DNS.be vzw +// https://www.iana.org/domains/root/db/vlaanderen.html vlaanderen -// vodka : 2013-12-19 Registry Services, LLC +// vodka : Registry Services, LLC +// https://www.iana.org/domains/root/db/vodka.html vodka -// volkswagen : 2015-05-14 Volkswagen Group of America Inc. +// volkswagen : Volkswagen Group of America Inc. +// https://www.iana.org/domains/root/db/volkswagen.html volkswagen -// volvo : 2015-11-12 Volvo Holding Sverige Aktiebolag +// volvo : Volvo Holding Sverige Aktiebolag +// https://www.iana.org/domains/root/db/volvo.html volvo -// vote : 2013-11-21 Monolith Registry LLC +// vote : Monolith Registry LLC +// https://www.iana.org/domains/root/db/vote.html vote -// voting : 2013-11-13 Valuetainment Corp. +// voting : Valuetainment Corp. +// https://www.iana.org/domains/root/db/voting.html voting -// voto : 2013-11-21 Monolith Registry LLC +// voto : Monolith Registry LLC +// https://www.iana.org/domains/root/db/voto.html voto -// voyage : 2013-08-27 Binky Moon, LLC +// voyage : Binky Moon, LLC +// https://www.iana.org/domains/root/db/voyage.html voyage -// vuelos : 2015-03-05 Travel Reservations SRL -vuelos - -// wales : 2014-05-08 Nominet UK +// wales : Nominet UK +// https://www.iana.org/domains/root/db/wales.html wales -// walmart : 2015-07-31 Wal-Mart Stores, Inc. +// walmart : Wal-Mart Stores, Inc. +// https://www.iana.org/domains/root/db/walmart.html walmart -// walter : 2014-11-13 Sandvik AB +// walter : Sandvik AB +// https://www.iana.org/domains/root/db/walter.html walter -// wang : 2013-10-24 Zodiac Wang Limited +// wang : Zodiac Wang Limited +// https://www.iana.org/domains/root/db/wang.html wang -// wanggou : 2014-12-18 Amazon Registry Services, Inc. +// wanggou : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/wanggou.html wanggou -// watch : 2013-11-14 Binky Moon, LLC +// watch : Binky Moon, LLC +// https://www.iana.org/domains/root/db/watch.html watch -// watches : 2014-12-22 Identity Digital Limited +// watches : Identity Digital Limited +// https://www.iana.org/domains/root/db/watches.html watches -// weather : 2015-01-08 International Business Machines Corporation +// weather : International Business Machines Corporation +// https://www.iana.org/domains/root/db/weather.html weather -// weatherchannel : 2015-03-12 International Business Machines Corporation +// weatherchannel : International Business Machines Corporation +// https://www.iana.org/domains/root/db/weatherchannel.html weatherchannel -// webcam : 2014-01-23 dot Webcam Limited +// webcam : dot Webcam Limited +// https://www.iana.org/domains/root/db/webcam.html webcam -// weber : 2015-06-04 Saint-Gobain Weber SA +// weber : Saint-Gobain Weber SA +// https://www.iana.org/domains/root/db/weber.html weber -// website : 2014-04-03 Radix FZC +// website : Radix FZC DMCC +// https://www.iana.org/domains/root/db/website.html website -// wedding : 2014-04-24 Registry Services, LLC +// wedding : Registry Services, LLC +// https://www.iana.org/domains/root/db/wedding.html wedding -// weibo : 2015-03-05 Sina Corporation +// weibo : Sina Corporation +// https://www.iana.org/domains/root/db/weibo.html weibo -// weir : 2015-01-29 Weir Group IP Limited +// weir : Weir Group IP Limited +// https://www.iana.org/domains/root/db/weir.html weir -// whoswho : 2014-02-20 Who's Who Registry +// whoswho : Who's Who Registry +// https://www.iana.org/domains/root/db/whoswho.html whoswho -// wien : 2013-10-28 punkt.wien GmbH +// wien : punkt.wien GmbH +// https://www.iana.org/domains/root/db/wien.html wien -// wiki : 2013-11-07 Top Level Design, LLC +// wiki : Registry Services, LLC +// https://www.iana.org/domains/root/db/wiki.html wiki -// williamhill : 2014-03-13 William Hill Organization Limited +// williamhill : William Hill Organization Limited +// https://www.iana.org/domains/root/db/williamhill.html williamhill -// win : 2014-11-20 First Registry Limited +// win : First Registry Limited +// https://www.iana.org/domains/root/db/win.html win -// windows : 2014-12-18 Microsoft Corporation +// windows : Microsoft Corporation +// https://www.iana.org/domains/root/db/windows.html windows -// wine : 2015-06-18 Binky Moon, LLC +// wine : Binky Moon, LLC +// https://www.iana.org/domains/root/db/wine.html wine -// winners : 2015-07-16 The TJX Companies, Inc. +// winners : The TJX Companies, Inc. +// https://www.iana.org/domains/root/db/winners.html winners -// wme : 2014-02-13 William Morris Endeavor Entertainment, LLC +// wme : William Morris Endeavor Entertainment, LLC +// https://www.iana.org/domains/root/db/wme.html wme -// wolterskluwer : 2015-08-06 Wolters Kluwer N.V. +// wolterskluwer : Wolters Kluwer N.V. +// https://www.iana.org/domains/root/db/wolterskluwer.html wolterskluwer -// woodside : 2015-07-09 Woodside Petroleum Limited +// woodside : Woodside Petroleum Limited +// https://www.iana.org/domains/root/db/woodside.html woodside -// work : 2013-12-19 Registry Services, LLC +// work : Registry Services, LLC +// https://www.iana.org/domains/root/db/work.html work -// works : 2013-11-14 Binky Moon, LLC +// works : Binky Moon, LLC +// https://www.iana.org/domains/root/db/works.html works -// world : 2014-06-12 Binky Moon, LLC +// world : Binky Moon, LLC +// https://www.iana.org/domains/root/db/world.html world -// wow : 2015-10-08 Amazon Registry Services, Inc. +// wow : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/wow.html wow -// wtc : 2013-12-19 World Trade Centers Association, Inc. +// wtc : World Trade Centers Association, Inc. +// https://www.iana.org/domains/root/db/wtc.html wtc -// wtf : 2014-03-06 Binky Moon, LLC +// wtf : Binky Moon, LLC +// https://www.iana.org/domains/root/db/wtf.html wtf -// xbox : 2014-12-18 Microsoft Corporation +// xbox : Microsoft Corporation +// https://www.iana.org/domains/root/db/xbox.html xbox -// xerox : 2014-10-24 Xerox DNHC LLC +// xerox : Xerox DNHC LLC +// https://www.iana.org/domains/root/db/xerox.html xerox -// xfinity : 2015-07-09 Comcast IP Holdings I, LLC +// xfinity : Comcast IP Holdings I, LLC +// https://www.iana.org/domains/root/db/xfinity.html xfinity -// xihuan : 2015-01-08 Beijing Qihu Keji Co., Ltd. +// xihuan : Beijing Qihu Keji Co., Ltd. +// https://www.iana.org/domains/root/db/xihuan.html xihuan -// xin : 2014-12-11 Elegant Leader Limited +// xin : Elegant Leader Limited +// https://www.iana.org/domains/root/db/xin.html xin -// xn--11b4c3d : 2015-01-15 VeriSign Sarl +// xn--11b4c3d : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--11b4c3d.html कॉम -// xn--1ck2e1b : 2015-02-26 Amazon Registry Services, Inc. +// xn--1ck2e1b : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--1ck2e1b.html セール -// xn--1qqw23a : 2014-01-09 Guangzhou YU Wei Information Technology Co., Ltd. +// xn--1qqw23a : Guangzhou YU Wei Information Technology Co., Ltd. +// https://www.iana.org/domains/root/db/xn--1qqw23a.html 佛山 -// xn--30rr7y : 2014-06-12 Excellent First Limited +// xn--30rr7y : Excellent First Limited +// https://www.iana.org/domains/root/db/xn--30rr7y.html 慈善 -// xn--3bst00m : 2013-09-13 Eagle Horizon Limited +// xn--3bst00m : Eagle Horizon Limited +// https://www.iana.org/domains/root/db/xn--3bst00m.html 集团 -// xn--3ds443g : 2013-09-08 TLD REGISTRY LIMITED OY +// xn--3ds443g : TLD REGISTRY LIMITED OY +// https://www.iana.org/domains/root/db/xn--3ds443g.html 在线 -// xn--3pxu8k : 2015-01-15 VeriSign Sarl +// xn--3pxu8k : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--3pxu8k.html 点看 -// xn--42c2d9a : 2015-01-15 VeriSign Sarl +// xn--42c2d9a : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--42c2d9a.html คอม -// xn--45q11c : 2013-11-21 Zodiac Gemini Ltd +// xn--45q11c : Zodiac Gemini Ltd +// https://www.iana.org/domains/root/db/xn--45q11c.html 八卦 -// xn--4gbrim : 2013-10-04 Helium TLDs Ltd +// xn--4gbrim : Helium TLDs Ltd +// https://www.iana.org/domains/root/db/xn--4gbrim.html موقع -// xn--55qw42g : 2013-11-08 China Organizational Name Administration Center +// xn--55qw42g : China Organizational Name Administration Center +// https://www.iana.org/domains/root/db/xn--55qw42g.html 公益 -// xn--55qx5d : 2013-11-14 China Internet Network Information Center (CNNIC) +// xn--55qx5d : China Internet Network Information Center (CNNIC) +// https://www.iana.org/domains/root/db/xn--55qx5d.html 公司 -// xn--5su34j936bgsg : 2015-09-03 Shangri‐La International Hotel Management Limited +// xn--5su34j936bgsg : Shangri‐La International Hotel Management Limited +// https://www.iana.org/domains/root/db/xn--5su34j936bgsg.html 香格里拉 -// xn--5tzm5g : 2014-12-22 Global Website TLD Asia Limited +// xn--5tzm5g : Global Website TLD Asia Limited +// https://www.iana.org/domains/root/db/xn--5tzm5g.html 网站 -// xn--6frz82g : 2013-09-23 Identity Digital Limited +// xn--6frz82g : Identity Digital Limited +// https://www.iana.org/domains/root/db/xn--6frz82g.html 移动 -// xn--6qq986b3xl : 2013-09-13 Tycoon Treasure Limited +// xn--6qq986b3xl : Tycoon Treasure Limited +// https://www.iana.org/domains/root/db/xn--6qq986b3xl.html 我爱你 -// xn--80adxhks : 2013-12-19 Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID) +// xn--80adxhks : Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID) +// https://www.iana.org/domains/root/db/xn--80adxhks.html москва -// xn--80aqecdr1a : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// xn--80aqecdr1a : Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// https://www.iana.org/domains/root/db/xn--80aqecdr1a.html католик -// xn--80asehdb : 2013-07-14 CORE Association +// xn--80asehdb : CORE Association +// https://www.iana.org/domains/root/db/xn--80asehdb.html онлайн -// xn--80aswg : 2013-07-14 CORE Association +// xn--80aswg : CORE Association +// https://www.iana.org/domains/root/db/xn--80aswg.html сайт -// xn--8y0a063a : 2015-03-26 China United Network Communications Corporation Limited +// xn--8y0a063a : China United Network Communications Corporation Limited +// https://www.iana.org/domains/root/db/xn--8y0a063a.html 联通 -// xn--9dbq2a : 2015-01-15 VeriSign Sarl +// xn--9dbq2a : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--9dbq2a.html קום -// xn--9et52u : 2014-06-12 RISE VICTORY LIMITED +// xn--9et52u : RISE VICTORY LIMITED +// https://www.iana.org/domains/root/db/xn--9et52u.html 时尚 -// xn--9krt00a : 2015-03-12 Sina Corporation +// xn--9krt00a : Sina Corporation +// https://www.iana.org/domains/root/db/xn--9krt00a.html 微博 -// xn--b4w605ferd : 2014-08-07 Temasek Holdings (Private) Limited +// xn--b4w605ferd : Temasek Holdings (Private) Limited +// https://www.iana.org/domains/root/db/xn--b4w605ferd.html 淡马锡 -// xn--bck1b9a5dre4c : 2015-02-26 Amazon Registry Services, Inc. +// xn--bck1b9a5dre4c : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--bck1b9a5dre4c.html ファッション -// xn--c1avg : 2013-11-14 Public Interest Registry +// xn--c1avg : Public Interest Registry +// https://www.iana.org/domains/root/db/xn--c1avg.html орг -// xn--c2br7g : 2015-01-15 VeriSign Sarl +// xn--c2br7g : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--c2br7g.html नेट -// xn--cck2b3b : 2015-02-26 Amazon Registry Services, Inc. +// xn--cck2b3b : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--cck2b3b.html ストア -// xn--cckwcxetd : 2019-12-19 Amazon Registry Services, Inc. +// xn--cckwcxetd : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--cckwcxetd.html アマゾン -// xn--cg4bki : 2013-09-27 SAMSUNG SDS CO., LTD +// xn--cg4bki : SAMSUNG SDS CO., LTD +// https://www.iana.org/domains/root/db/xn--cg4bki.html 삼성 -// xn--czr694b : 2014-01-16 Internet DotTrademark Organisation Limited +// xn--czr694b : Internet DotTrademark Organisation Limited +// https://www.iana.org/domains/root/db/xn--czr694b.html 商标 -// xn--czrs0t : 2013-12-19 Binky Moon, LLC +// xn--czrs0t : Binky Moon, LLC +// https://www.iana.org/domains/root/db/xn--czrs0t.html 商店 -// xn--czru2d : 2013-11-21 Zodiac Aquarius Limited +// xn--czru2d : Zodiac Aquarius Limited +// https://www.iana.org/domains/root/db/xn--czru2d.html 商城 -// xn--d1acj3b : 2013-11-20 The Foundation for Network Initiatives “The Smart Internet” +// xn--d1acj3b : The Foundation for Network Initiatives “The Smart Internet” +// https://www.iana.org/domains/root/db/xn--d1acj3b.html дети -// xn--eckvdtc9d : 2014-12-18 Amazon Registry Services, Inc. +// xn--eckvdtc9d : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--eckvdtc9d.html ポイント -// xn--efvy88h : 2014-08-22 Guangzhou YU Wei Information Technology Co., Ltd. +// xn--efvy88h : Guangzhou YU Wei Information Technology Co., Ltd. +// https://www.iana.org/domains/root/db/xn--efvy88h.html 新闻 -// xn--fct429k : 2015-04-09 Amazon Registry Services, Inc. +// xn--fct429k : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--fct429k.html 家電 -// xn--fhbei : 2015-01-15 VeriSign Sarl +// xn--fhbei : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--fhbei.html كوم -// xn--fiq228c5hs : 2013-09-08 TLD REGISTRY LIMITED OY +// xn--fiq228c5hs : TLD REGISTRY LIMITED OY +// https://www.iana.org/domains/root/db/xn--fiq228c5hs.html 中文网 -// xn--fiq64b : 2013-10-14 CITIC Group Corporation +// xn--fiq64b : CITIC Group Corporation +// https://www.iana.org/domains/root/db/xn--fiq64b.html 中信 -// xn--fjq720a : 2014-05-22 Binky Moon, LLC +// xn--fjq720a : Binky Moon, LLC +// https://www.iana.org/domains/root/db/xn--fjq720a.html 娱乐 -// xn--flw351e : 2014-07-31 Charleston Road Registry Inc. +// xn--flw351e : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/xn--flw351e.html 谷歌 -// xn--fzys8d69uvgm : 2015-05-14 PCCW Enterprises Limited +// xn--fzys8d69uvgm : PCCW Enterprises Limited +// https://www.iana.org/domains/root/db/xn--fzys8d69uvgm.html 電訊盈科 -// xn--g2xx48c : 2015-01-30 Nawang Heli(Xiamen) Network Service Co., LTD. +// xn--g2xx48c : Nawang Heli(Xiamen) Network Service Co., LTD. +// https://www.iana.org/domains/root/db/xn--g2xx48c.html 购物 -// xn--gckr3f0f : 2015-02-26 Amazon Registry Services, Inc. +// xn--gckr3f0f : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--gckr3f0f.html クラウド -// xn--gk3at1e : 2015-10-08 Amazon Registry Services, Inc. +// xn--gk3at1e : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--gk3at1e.html 通販 -// xn--hxt814e : 2014-05-15 Zodiac Taurus Limited +// xn--hxt814e : Zodiac Taurus Limited +// https://www.iana.org/domains/root/db/xn--hxt814e.html 网店 -// xn--i1b6b1a6a2e : 2013-11-14 Public Interest Registry +// xn--i1b6b1a6a2e : Public Interest Registry +// https://www.iana.org/domains/root/db/xn--i1b6b1a6a2e.html संगठन -// xn--imr513n : 2014-12-11 Internet DotTrademark Organisation Limited +// xn--imr513n : Internet DotTrademark Organisation Limited +// https://www.iana.org/domains/root/db/xn--imr513n.html 餐厅 -// xn--io0a7i : 2013-11-14 China Internet Network Information Center (CNNIC) +// xn--io0a7i : China Internet Network Information Center (CNNIC) +// https://www.iana.org/domains/root/db/xn--io0a7i.html 网络 -// xn--j1aef : 2015-01-15 VeriSign Sarl +// xn--j1aef : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--j1aef.html ком -// xn--jlq480n2rg : 2019-12-19 Amazon Registry Services, Inc. +// xn--jlq480n2rg : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--jlq480n2rg.html 亚马逊 -// xn--jvr189m : 2015-02-26 Amazon Registry Services, Inc. +// xn--jvr189m : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--jvr189m.html 食品 -// xn--kcrx77d1x4a : 2014-11-07 Koninklijke Philips N.V. +// xn--kcrx77d1x4a : Koninklijke Philips N.V. +// https://www.iana.org/domains/root/db/xn--kcrx77d1x4a.html 飞利浦 -// xn--kput3i : 2014-02-13 Beijing RITT-Net Technology Development Co., Ltd +// xn--kput3i : Beijing RITT-Net Technology Development Co., Ltd +// https://www.iana.org/domains/root/db/xn--kput3i.html 手机 -// xn--mgba3a3ejt : 2014-11-20 Aramco Services Company +// xn--mgba3a3ejt : Aramco Services Company +// https://www.iana.org/domains/root/db/xn--mgba3a3ejt.html ارامكو -// xn--mgba7c0bbn0a : 2015-05-14 Crescent Holding GmbH +// xn--mgba7c0bbn0a : Competrol (Luxembourg) Sarl +// https://www.iana.org/domains/root/db/xn--mgba7c0bbn0a.html العليان -// xn--mgbaakc7dvf : 2015-09-03 Emirates Telecommunications Corporation (trading as Etisalat) +// xn--mgbaakc7dvf : Emirates Telecommunications Corporation (trading as Etisalat) +// https://www.iana.org/domains/root/db/xn--mgbaakc7dvf.html اتصالات -// xn--mgbab2bd : 2013-10-31 CORE Association +// xn--mgbab2bd : CORE Association +// https://www.iana.org/domains/root/db/xn--mgbab2bd.html بازار -// xn--mgbca7dzdo : 2015-07-30 Abu Dhabi Systems and Information Centre +// xn--mgbca7dzdo : Abu Dhabi Systems and Information Centre +// https://www.iana.org/domains/root/db/xn--mgbca7dzdo.html ابوظبي -// xn--mgbi4ecexp : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// xn--mgbi4ecexp : Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// https://www.iana.org/domains/root/db/xn--mgbi4ecexp.html كاثوليك -// xn--mgbt3dhd : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// xn--mgbt3dhd : Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. +// https://www.iana.org/domains/root/db/xn--mgbt3dhd.html همراه -// xn--mk1bu44c : 2015-01-15 VeriSign Sarl +// xn--mk1bu44c : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--mk1bu44c.html 닷컴 -// xn--mxtq1m : 2014-03-06 Net-Chinese Co., Ltd. +// xn--mxtq1m : Net-Chinese Co., Ltd. +// https://www.iana.org/domains/root/db/xn--mxtq1m.html 政府 -// xn--ngbc5azd : 2013-07-13 International Domain Registry Pty. Ltd. +// xn--ngbc5azd : International Domain Registry Pty. Ltd. +// https://www.iana.org/domains/root/db/xn--ngbc5azd.html شبكة -// xn--ngbe9e0a : 2014-12-04 Kuwait Finance House +// xn--ngbe9e0a : Kuwait Finance House +// https://www.iana.org/domains/root/db/xn--ngbe9e0a.html بيتك -// xn--ngbrx : 2015-11-12 League of Arab States +// xn--ngbrx : League of Arab States +// https://www.iana.org/domains/root/db/xn--ngbrx.html عرب -// xn--nqv7f : 2013-11-14 Public Interest Registry +// xn--nqv7f : Public Interest Registry +// https://www.iana.org/domains/root/db/xn--nqv7f.html 机构 -// xn--nqv7fs00ema : 2013-11-14 Public Interest Registry +// xn--nqv7fs00ema : Public Interest Registry +// https://www.iana.org/domains/root/db/xn--nqv7fs00ema.html 组织机构 -// xn--nyqy26a : 2014-11-07 Stable Tone Limited +// xn--nyqy26a : Stable Tone Limited +// https://www.iana.org/domains/root/db/xn--nyqy26a.html 健康 -// xn--otu796d : 2017-08-06 Jiang Yu Liang Cai Technology Company Limited +// xn--otu796d : Jiang Yu Liang Cai Technology Company Limited +// https://www.iana.org/domains/root/db/xn--otu796d.html 招聘 -// xn--p1acf : 2013-12-12 Rusnames Limited +// xn--p1acf : Rusnames Limited +// https://www.iana.org/domains/root/db/xn--p1acf.html рус -// xn--pssy2u : 2015-01-15 VeriSign Sarl +// xn--pssy2u : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--pssy2u.html 大拿 -// xn--q9jyb4c : 2013-09-17 Charleston Road Registry Inc. +// xn--q9jyb4c : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/xn--q9jyb4c.html みんな -// xn--qcka1pmc : 2014-07-31 Charleston Road Registry Inc. +// xn--qcka1pmc : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/xn--qcka1pmc.html グーグル -// xn--rhqv96g : 2013-09-11 Stable Tone Limited +// xn--rhqv96g : Stable Tone Limited +// https://www.iana.org/domains/root/db/xn--rhqv96g.html 世界 -// xn--rovu88b : 2015-02-26 Amazon Registry Services, Inc. +// xn--rovu88b : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/xn--rovu88b.html 書籍 -// xn--ses554g : 2014-01-16 KNET Co., Ltd. +// xn--ses554g : KNET Co., Ltd. +// https://www.iana.org/domains/root/db/xn--ses554g.html 网址 -// xn--t60b56a : 2015-01-15 VeriSign Sarl +// xn--t60b56a : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--t60b56a.html 닷넷 -// xn--tckwe : 2015-01-15 VeriSign Sarl +// xn--tckwe : VeriSign Sarl +// https://www.iana.org/domains/root/db/xn--tckwe.html コム -// xn--tiq49xqyj : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// xn--tiq49xqyj : Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) +// https://www.iana.org/domains/root/db/xn--tiq49xqyj.html 天主教 -// xn--unup4y : 2013-07-14 Binky Moon, LLC +// xn--unup4y : Binky Moon, LLC +// https://www.iana.org/domains/root/db/xn--unup4y.html 游戏 -// xn--vermgensberater-ctb : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG +// xn--vermgensberater-ctb : Deutsche Vermögensberatung Aktiengesellschaft DVAG +// https://www.iana.org/domains/root/db/xn--vermgensberater-ctb.html vermögensberater -// xn--vermgensberatung-pwb : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG +// xn--vermgensberatung-pwb : Deutsche Vermögensberatung Aktiengesellschaft DVAG +// https://www.iana.org/domains/root/db/xn--vermgensberatung-pwb.html vermögensberatung -// xn--vhquv : 2013-08-27 Binky Moon, LLC +// xn--vhquv : Binky Moon, LLC +// https://www.iana.org/domains/root/db/xn--vhquv.html 企业 -// xn--vuq861b : 2014-10-16 Beijing Tele-info Network Technology Co., Ltd. +// xn--vuq861b : Beijing Tele-info Technology Co., Ltd. +// https://www.iana.org/domains/root/db/xn--vuq861b.html 信息 -// xn--w4r85el8fhu5dnra : 2015-04-30 Kerry Trading Co. Limited +// xn--w4r85el8fhu5dnra : Kerry Trading Co. Limited +// https://www.iana.org/domains/root/db/xn--w4r85el8fhu5dnra.html 嘉里大酒店 -// xn--w4rs40l : 2015-07-30 Kerry Trading Co. Limited +// xn--w4rs40l : Kerry Trading Co. Limited +// https://www.iana.org/domains/root/db/xn--w4rs40l.html 嘉里 -// xn--xhq521b : 2013-11-14 Guangzhou YU Wei Information Technology Co., Ltd. +// xn--xhq521b : Guangzhou YU Wei Information Technology Co., Ltd. +// https://www.iana.org/domains/root/db/xn--xhq521b.html 广东 -// xn--zfr164b : 2013-11-08 China Organizational Name Administration Center +// xn--zfr164b : China Organizational Name Administration Center +// https://www.iana.org/domains/root/db/xn--zfr164b.html 政务 -// xyz : 2013-12-05 XYZ.COM LLC +// xyz : XYZ.COM LLC +// https://www.iana.org/domains/root/db/xyz.html xyz -// yachts : 2014-01-09 XYZ.COM LLC +// yachts : XYZ.COM LLC +// https://www.iana.org/domains/root/db/yachts.html yachts -// yahoo : 2015-04-02 Oath Inc. +// yahoo : Oath Inc. +// https://www.iana.org/domains/root/db/yahoo.html yahoo -// yamaxun : 2014-12-18 Amazon Registry Services, Inc. +// yamaxun : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/yamaxun.html yamaxun -// yandex : 2014-04-10 Yandex Europe B.V. +// yandex : Yandex Europe B.V. +// https://www.iana.org/domains/root/db/yandex.html yandex -// yodobashi : 2014-11-20 YODOBASHI CAMERA CO.,LTD. +// yodobashi : YODOBASHI CAMERA CO.,LTD. +// https://www.iana.org/domains/root/db/yodobashi.html yodobashi -// yoga : 2014-05-29 Registry Services, LLC +// yoga : Registry Services, LLC +// https://www.iana.org/domains/root/db/yoga.html yoga -// yokohama : 2013-12-12 GMO Registry, Inc. +// yokohama : GMO Registry, Inc. +// https://www.iana.org/domains/root/db/yokohama.html yokohama -// you : 2015-04-09 Amazon Registry Services, Inc. +// you : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/you.html you -// youtube : 2014-05-01 Charleston Road Registry Inc. +// youtube : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/youtube.html youtube -// yun : 2015-01-08 Beijing Qihu Keji Co., Ltd. +// yun : Beijing Qihu Keji Co., Ltd. +// https://www.iana.org/domains/root/db/yun.html yun -// zappos : 2015-06-25 Amazon Registry Services, Inc. +// zappos : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/zappos.html zappos -// zara : 2014-11-07 Industria de Diseño Textil, S.A. (INDITEX, S.A.) +// zara : Industria de Diseño Textil, S.A. (INDITEX, S.A.) +// https://www.iana.org/domains/root/db/zara.html zara -// zero : 2014-12-18 Amazon Registry Services, Inc. +// zero : Amazon Registry Services, Inc. +// https://www.iana.org/domains/root/db/zero.html zero -// zip : 2014-05-08 Charleston Road Registry Inc. +// zip : Charleston Road Registry Inc. +// https://www.iana.org/domains/root/db/zip.html zip -// zone : 2013-11-14 Binky Moon, LLC +// zone : Binky Moon, LLC +// https://www.iana.org/domains/root/db/zone.html zone -// zuerich : 2014-11-07 Kanton Zürich (Canton of Zurich) +// zuerich : Kanton Zürich (Canton of Zurich) +// https://www.iana.org/domains/root/db/zuerich.html zuerich @@ -10808,49 +11416,79 @@ s3.dualstack.us-east-2.amazonaws.com s3.us-east-2.amazonaws.com s3-website.us-east-2.amazonaws.com +// Analytics on AWS +// Submitted by AWS Security +// Reference: c02c3a80-f8a0-4fd2-b719-48ea8b7c28de +analytics-gateway.ap-northeast-1.amazonaws.com +analytics-gateway.eu-west-1.amazonaws.com +analytics-gateway.us-east-1.amazonaws.com +analytics-gateway.us-east-2.amazonaws.com +analytics-gateway.us-west-2.amazonaws.com + // AWS Cloud9 // Submitted by: AWS Security -// Reference: 2b6dfa9a-3a7f-4367-b2e7-0321e77c0d59 +// Reference: 05c44955-977c-4b57-938a-f2af92733f9f +webview-assets.aws-cloud9.af-south-1.amazonaws.com vfs.cloud9.af-south-1.amazonaws.com webview-assets.cloud9.af-south-1.amazonaws.com +webview-assets.aws-cloud9.ap-east-1.amazonaws.com vfs.cloud9.ap-east-1.amazonaws.com webview-assets.cloud9.ap-east-1.amazonaws.com +webview-assets.aws-cloud9.ap-northeast-1.amazonaws.com vfs.cloud9.ap-northeast-1.amazonaws.com webview-assets.cloud9.ap-northeast-1.amazonaws.com +webview-assets.aws-cloud9.ap-northeast-2.amazonaws.com vfs.cloud9.ap-northeast-2.amazonaws.com webview-assets.cloud9.ap-northeast-2.amazonaws.com +webview-assets.aws-cloud9.ap-northeast-3.amazonaws.com vfs.cloud9.ap-northeast-3.amazonaws.com webview-assets.cloud9.ap-northeast-3.amazonaws.com +webview-assets.aws-cloud9.ap-south-1.amazonaws.com vfs.cloud9.ap-south-1.amazonaws.com webview-assets.cloud9.ap-south-1.amazonaws.com +webview-assets.aws-cloud9.ap-southeast-1.amazonaws.com vfs.cloud9.ap-southeast-1.amazonaws.com webview-assets.cloud9.ap-southeast-1.amazonaws.com +webview-assets.aws-cloud9.ap-southeast-2.amazonaws.com vfs.cloud9.ap-southeast-2.amazonaws.com webview-assets.cloud9.ap-southeast-2.amazonaws.com +webview-assets.aws-cloud9.ca-central-1.amazonaws.com vfs.cloud9.ca-central-1.amazonaws.com webview-assets.cloud9.ca-central-1.amazonaws.com +webview-assets.aws-cloud9.eu-central-1.amazonaws.com vfs.cloud9.eu-central-1.amazonaws.com webview-assets.cloud9.eu-central-1.amazonaws.com +webview-assets.aws-cloud9.eu-north-1.amazonaws.com vfs.cloud9.eu-north-1.amazonaws.com webview-assets.cloud9.eu-north-1.amazonaws.com +webview-assets.aws-cloud9.eu-south-1.amazonaws.com vfs.cloud9.eu-south-1.amazonaws.com webview-assets.cloud9.eu-south-1.amazonaws.com +webview-assets.aws-cloud9.eu-west-1.amazonaws.com vfs.cloud9.eu-west-1.amazonaws.com webview-assets.cloud9.eu-west-1.amazonaws.com +webview-assets.aws-cloud9.eu-west-2.amazonaws.com vfs.cloud9.eu-west-2.amazonaws.com webview-assets.cloud9.eu-west-2.amazonaws.com +webview-assets.aws-cloud9.eu-west-3.amazonaws.com vfs.cloud9.eu-west-3.amazonaws.com webview-assets.cloud9.eu-west-3.amazonaws.com +webview-assets.aws-cloud9.me-south-1.amazonaws.com vfs.cloud9.me-south-1.amazonaws.com webview-assets.cloud9.me-south-1.amazonaws.com +webview-assets.aws-cloud9.sa-east-1.amazonaws.com vfs.cloud9.sa-east-1.amazonaws.com webview-assets.cloud9.sa-east-1.amazonaws.com +webview-assets.aws-cloud9.us-east-1.amazonaws.com vfs.cloud9.us-east-1.amazonaws.com webview-assets.cloud9.us-east-1.amazonaws.com +webview-assets.aws-cloud9.us-east-2.amazonaws.com vfs.cloud9.us-east-2.amazonaws.com webview-assets.cloud9.us-east-2.amazonaws.com +webview-assets.aws-cloud9.us-west-1.amazonaws.com vfs.cloud9.us-west-1.amazonaws.com webview-assets.cloud9.us-west-1.amazonaws.com +webview-assets.aws-cloud9.us-west-2.amazonaws.com vfs.cloud9.us-west-2.amazonaws.com webview-assets.cloud9.us-west-2.amazonaws.com @@ -12643,7 +13281,6 @@ iobb.net // Submitted by Ihor Kolodyuk mel.cloudlets.com.au cloud.interhostsolutions.be -users.scale.virtualcloud.com.br mycloud.by alp1.ae.flow.ch appengine.flow.ch @@ -12667,9 +13304,7 @@ ch.trendhosting.cloud de.trendhosting.cloud jele.club amscompute.com -clicketcloud.com dopaas.com -hidora.com paas.hosted-by-previder.com rag-cloud.hosteur.com rag-cloud-ch.hosteur.com @@ -13459,6 +14094,10 @@ qoto.io // Submitted by Xavier De Cock qualifioapp.com +// Quality Unit: https://qualityunit.com +// Submitted by Vasyl Tsalko +ladesk.com + // QuickBackend: https://www.quickbackend.com // Submitted by Dani Biro qbuser.com @@ -13774,6 +14413,20 @@ bounty-full.com alpha.bounty-full.com beta.bounty-full.com +// Smallregistry by Promopixel SARL: https://www.smallregistry.net +// Former AFNIC's SLDs +// Submitted by Jérôme Lipowicz +aeroport.fr +avocat.fr +chambagri.fr +chirurgiens-dentistes.fr +experts-comptables.fr +medecin.fr +notaires.fr +pharmacien.fr +port.fr +veterinaire.fr + // Small Technology Foundation : https://small-tech.org // Submitted by Aral Balkan small-web.org @@ -13867,6 +14520,10 @@ myspreadshop.co.uk // Submitted by Jacob Lee api.stdlib.com +// Storipress : https://storipress.com +// Submitted by Benno Liu +storipress.app + // Storj Labs Inc. : https://storj.io/ // Submitted by Philip Hutchins storj.farm @@ -14234,6 +14891,8 @@ js.wpenginepowered.com // Submitted by Shahar Talmi wixsite.com editorx.io +wixstudio.io +wix.run // XenonCloud GbR: https://xenoncloud.net // Submitted by Julian Uphoff commit 11f10dc0d0b4b1d6af828102421eac9f79e0fcba Author: Stefan Kangas Date: Sat Oct 14 21:07:30 2023 +0200 Update etc/rgb.txt from X.Org upstream The upstream version contains the following changes: 2023-07-10 rgb: Make color entries uniform 2014-07-06 Add aliases for colors that differ between X11 and CSS 2014-07-06 Add missing colors from CSS Color Module Level 4 2008-06-04 Nuke CVS version tags 2003-11-14 R6.6 is the Xorg base-line * etc/rgb.txt: Sync with the version in X.Org upstream https://cgit.freedesktop.org/xorg/app/rgb/tree/rgb.txt commit 0d2caecebf0e2a10994c22960921f366dd98d19a. (Bug#66538) diff --git a/etc/rgb.txt b/etc/rgb.txt index 64d885db01a..2772ff238ff 100644 --- a/etc/rgb.txt +++ b/etc/rgb.txt @@ -93,6 +93,14 @@ 119 136 153 LightSlateGrey 190 190 190 gray 190 190 190 grey +190 190 190 x11 gray +190 190 190 X11Gray +190 190 190 x11 grey +190 190 190 X11Grey +128 128 128 web gray +128 128 128 WebGray +128 128 128 web grey +128 128 128 WebGrey 211 211 211 light grey 211 211 211 LightGrey 211 211 211 light gray @@ -141,6 +149,7 @@ 72 209 204 MediumTurquoise 64 224 208 turquoise 0 255 255 cyan + 0 255 255 aqua 224 255 255 light cyan 224 255 255 LightCyan 95 158 160 cadet blue @@ -167,6 +176,11 @@ 124 252 0 lawn green 124 252 0 LawnGreen 0 255 0 green + 0 255 0 lime + 0 255 0 x11 green + 0 255 0 X11Green + 0 128 0 web green + 0 128 0 WebGreen 127 255 0 chartreuse 0 250 154 medium spring green 0 250 154 MediumSpringGreen @@ -190,7 +204,7 @@ 255 255 224 light yellow 255 255 224 LightYellow 255 255 0 yellow -255 215 0 gold +255 215 0 gold 238 221 130 light goldenrod 238 221 130 LightGoldenrod 218 165 32 goldenrod @@ -238,11 +252,16 @@ 219 112 147 pale violet red 219 112 147 PaleVioletRed 176 48 96 maroon +176 48 96 x11 maroon +176 48 96 X11Maroon +128 0 0 web maroon +128 0 0 WebMaroon 199 21 133 medium violet red 199 21 133 MediumVioletRed 208 32 144 violet red 208 32 144 VioletRed 255 0 255 magenta +255 0 255 fuchsia 238 130 238 violet 221 160 221 plum 218 112 214 orchid @@ -255,6 +274,10 @@ 138 43 226 blue violet 138 43 226 BlueViolet 160 32 240 purple +160 32 240 x11 purple +160 32 240 X11Purple +128 0 128 web purple +128 0 128 WebPurple 147 112 219 medium purple 147 112 219 MediumPurple 216 191 216 thistle @@ -281,7 +304,7 @@ 255 222 173 NavajoWhite1 238 207 161 NavajoWhite2 205 179 139 NavajoWhite3 -139 121 94 NavajoWhite4 +139 121 94 NavajoWhite4 255 250 205 LemonChiffon1 238 233 191 LemonChiffon2 205 201 165 LemonChiffon3 @@ -389,131 +412,131 @@ 84 255 159 SeaGreen1 78 238 148 SeaGreen2 67 205 128 SeaGreen3 - 46 139 87 SeaGreen4 + 46 139 87 SeaGreen4 154 255 154 PaleGreen1 144 238 144 PaleGreen2 124 205 124 PaleGreen3 - 84 139 84 PaleGreen4 + 84 139 84 PaleGreen4 0 255 127 SpringGreen1 0 238 118 SpringGreen2 0 205 102 SpringGreen3 - 0 139 69 SpringGreen4 - 0 255 0 green1 - 0 238 0 green2 - 0 205 0 green3 - 0 139 0 green4 -127 255 0 chartreuse1 -118 238 0 chartreuse2 -102 205 0 chartreuse3 - 69 139 0 chartreuse4 -192 255 62 OliveDrab1 -179 238 58 OliveDrab2 -154 205 50 OliveDrab3 -105 139 34 OliveDrab4 + 0 139 69 SpringGreen4 + 0 255 0 green1 + 0 238 0 green2 + 0 205 0 green3 + 0 139 0 green4 +127 255 0 chartreuse1 +118 238 0 chartreuse2 +102 205 0 chartreuse3 + 69 139 0 chartreuse4 +192 255 62 OliveDrab1 +179 238 58 OliveDrab2 +154 205 50 OliveDrab3 +105 139 34 OliveDrab4 202 255 112 DarkOliveGreen1 188 238 104 DarkOliveGreen2 -162 205 90 DarkOliveGreen3 -110 139 61 DarkOliveGreen4 +162 205 90 DarkOliveGreen3 +110 139 61 DarkOliveGreen4 255 246 143 khaki1 238 230 133 khaki2 205 198 115 khaki3 -139 134 78 khaki4 +139 134 78 khaki4 255 236 139 LightGoldenrod1 238 220 130 LightGoldenrod2 205 190 112 LightGoldenrod3 -139 129 76 LightGoldenrod4 +139 129 76 LightGoldenrod4 255 255 224 LightYellow1 238 238 209 LightYellow2 205 205 180 LightYellow3 139 139 122 LightYellow4 -255 255 0 yellow1 -238 238 0 yellow2 -205 205 0 yellow3 -139 139 0 yellow4 -255 215 0 gold1 -238 201 0 gold2 -205 173 0 gold3 -139 117 0 gold4 -255 193 37 goldenrod1 -238 180 34 goldenrod2 -205 155 29 goldenrod3 -139 105 20 goldenrod4 -255 185 15 DarkGoldenrod1 -238 173 14 DarkGoldenrod2 -205 149 12 DarkGoldenrod3 -139 101 8 DarkGoldenrod4 +255 255 0 yellow1 +238 238 0 yellow2 +205 205 0 yellow3 +139 139 0 yellow4 +255 215 0 gold1 +238 201 0 gold2 +205 173 0 gold3 +139 117 0 gold4 +255 193 37 goldenrod1 +238 180 34 goldenrod2 +205 155 29 goldenrod3 +139 105 20 goldenrod4 +255 185 15 DarkGoldenrod1 +238 173 14 DarkGoldenrod2 +205 149 12 DarkGoldenrod3 +139 101 8 DarkGoldenrod4 255 193 193 RosyBrown1 238 180 180 RosyBrown2 205 155 155 RosyBrown3 139 105 105 RosyBrown4 255 106 106 IndianRed1 -238 99 99 IndianRed2 -205 85 85 IndianRed3 -139 58 58 IndianRed4 -255 130 71 sienna1 -238 121 66 sienna2 -205 104 57 sienna3 -139 71 38 sienna4 +238 99 99 IndianRed2 +205 85 85 IndianRed3 +139 58 58 IndianRed4 +255 130 71 sienna1 +238 121 66 sienna2 +205 104 57 sienna3 +139 71 38 sienna4 255 211 155 burlywood1 238 197 145 burlywood2 205 170 125 burlywood3 -139 115 85 burlywood4 +139 115 85 burlywood4 255 231 186 wheat1 238 216 174 wheat2 205 186 150 wheat3 139 126 102 wheat4 -255 165 79 tan1 -238 154 73 tan2 -205 133 63 tan3 -139 90 43 tan4 -255 127 36 chocolate1 -238 118 33 chocolate2 -205 102 29 chocolate3 -139 69 19 chocolate4 -255 48 48 firebrick1 -238 44 44 firebrick2 -205 38 38 firebrick3 -139 26 26 firebrick4 -255 64 64 brown1 -238 59 59 brown2 -205 51 51 brown3 -139 35 35 brown4 +255 165 79 tan1 +238 154 73 tan2 +205 133 63 tan3 +139 90 43 tan4 +255 127 36 chocolate1 +238 118 33 chocolate2 +205 102 29 chocolate3 +139 69 19 chocolate4 +255 48 48 firebrick1 +238 44 44 firebrick2 +205 38 38 firebrick3 +139 26 26 firebrick4 +255 64 64 brown1 +238 59 59 brown2 +205 51 51 brown3 +139 35 35 brown4 255 140 105 salmon1 -238 130 98 salmon2 -205 112 84 salmon3 -139 76 57 salmon4 +238 130 98 salmon2 +205 112 84 salmon3 +139 76 57 salmon4 255 160 122 LightSalmon1 238 149 114 LightSalmon2 -205 129 98 LightSalmon3 -139 87 66 LightSalmon4 -255 165 0 orange1 -238 154 0 orange2 -205 133 0 orange3 -139 90 0 orange4 -255 127 0 DarkOrange1 -238 118 0 DarkOrange2 -205 102 0 DarkOrange3 -139 69 0 DarkOrange4 -255 114 86 coral1 -238 106 80 coral2 -205 91 69 coral3 -139 62 47 coral4 -255 99 71 tomato1 -238 92 66 tomato2 -205 79 57 tomato3 -139 54 38 tomato4 -255 69 0 OrangeRed1 -238 64 0 OrangeRed2 -205 55 0 OrangeRed3 -139 37 0 OrangeRed4 -255 0 0 red1 -238 0 0 red2 -205 0 0 red3 -139 0 0 red4 +205 129 98 LightSalmon3 +139 87 66 LightSalmon4 +255 165 0 orange1 +238 154 0 orange2 +205 133 0 orange3 +139 90 0 orange4 +255 127 0 DarkOrange1 +238 118 0 DarkOrange2 +205 102 0 DarkOrange3 +139 69 0 DarkOrange4 +255 114 86 coral1 +238 106 80 coral2 +205 91 69 coral3 +139 62 47 coral4 +255 99 71 tomato1 +238 92 66 tomato2 +205 79 57 tomato3 +139 54 38 tomato4 +255 69 0 OrangeRed1 +238 64 0 OrangeRed2 +205 55 0 OrangeRed3 +139 37 0 OrangeRed4 +255 0 0 red1 +238 0 0 red2 +205 0 0 red3 +139 0 0 red4 255 20 147 DeepPink1 238 18 137 DeepPink2 205 16 118 DeepPink3 -139 10 80 DeepPink4 +139 10 80 DeepPink4 255 110 180 HotPink1 238 106 167 HotPink2 205 96 144 HotPink3 @@ -529,15 +552,15 @@ 255 130 171 PaleVioletRed1 238 121 159 PaleVioletRed2 205 104 137 PaleVioletRed3 -139 71 93 PaleVioletRed4 +139 71 93 PaleVioletRed4 255 52 179 maroon1 238 48 167 maroon2 205 41 144 maroon3 -139 28 98 maroon4 +139 28 98 maroon4 255 62 150 VioletRed1 238 58 140 VioletRed2 205 50 120 VioletRed3 -139 34 82 VioletRed4 +139 34 82 VioletRed4 255 0 255 magenta1 238 0 238 magenta2 205 0 205 magenta3 @@ -578,211 +601,218 @@ 5 5 5 grey2 8 8 8 gray3 8 8 8 grey3 - 10 10 10 gray4 - 10 10 10 grey4 - 13 13 13 gray5 - 13 13 13 grey5 - 15 15 15 gray6 - 15 15 15 grey6 - 18 18 18 gray7 - 18 18 18 grey7 - 20 20 20 gray8 - 20 20 20 grey8 - 23 23 23 gray9 - 23 23 23 grey9 - 26 26 26 gray10 - 26 26 26 grey10 - 28 28 28 gray11 - 28 28 28 grey11 - 31 31 31 gray12 - 31 31 31 grey12 - 33 33 33 gray13 - 33 33 33 grey13 - 36 36 36 gray14 - 36 36 36 grey14 - 38 38 38 gray15 - 38 38 38 grey15 - 41 41 41 gray16 - 41 41 41 grey16 - 43 43 43 gray17 - 43 43 43 grey17 - 46 46 46 gray18 - 46 46 46 grey18 - 48 48 48 gray19 - 48 48 48 grey19 - 51 51 51 gray20 - 51 51 51 grey20 - 54 54 54 gray21 - 54 54 54 grey21 - 56 56 56 gray22 - 56 56 56 grey22 - 59 59 59 gray23 - 59 59 59 grey23 - 61 61 61 gray24 - 61 61 61 grey24 - 64 64 64 gray25 - 64 64 64 grey25 - 66 66 66 gray26 - 66 66 66 grey26 - 69 69 69 gray27 - 69 69 69 grey27 - 71 71 71 gray28 - 71 71 71 grey28 - 74 74 74 gray29 - 74 74 74 grey29 - 77 77 77 gray30 - 77 77 77 grey30 - 79 79 79 gray31 - 79 79 79 grey31 - 82 82 82 gray32 - 82 82 82 grey32 - 84 84 84 gray33 - 84 84 84 grey33 - 87 87 87 gray34 - 87 87 87 grey34 - 89 89 89 gray35 - 89 89 89 grey35 - 92 92 92 gray36 - 92 92 92 grey36 - 94 94 94 gray37 - 94 94 94 grey37 - 97 97 97 gray38 - 97 97 97 grey38 - 99 99 99 gray39 - 99 99 99 grey39 -102 102 102 gray40 -102 102 102 grey40 -105 105 105 gray41 -105 105 105 grey41 -107 107 107 gray42 -107 107 107 grey42 -110 110 110 gray43 -110 110 110 grey43 -112 112 112 gray44 -112 112 112 grey44 -115 115 115 gray45 -115 115 115 grey45 -117 117 117 gray46 -117 117 117 grey46 -120 120 120 gray47 -120 120 120 grey47 -122 122 122 gray48 -122 122 122 grey48 -125 125 125 gray49 -125 125 125 grey49 -127 127 127 gray50 -127 127 127 grey50 -130 130 130 gray51 -130 130 130 grey51 -133 133 133 gray52 -133 133 133 grey52 -135 135 135 gray53 -135 135 135 grey53 -138 138 138 gray54 -138 138 138 grey54 -140 140 140 gray55 -140 140 140 grey55 -143 143 143 gray56 -143 143 143 grey56 -145 145 145 gray57 -145 145 145 grey57 -148 148 148 gray58 -148 148 148 grey58 -150 150 150 gray59 -150 150 150 grey59 -153 153 153 gray60 -153 153 153 grey60 -156 156 156 gray61 -156 156 156 grey61 -158 158 158 gray62 -158 158 158 grey62 -161 161 161 gray63 -161 161 161 grey63 -163 163 163 gray64 -163 163 163 grey64 -166 166 166 gray65 -166 166 166 grey65 -168 168 168 gray66 -168 168 168 grey66 -171 171 171 gray67 -171 171 171 grey67 -173 173 173 gray68 -173 173 173 grey68 -176 176 176 gray69 -176 176 176 grey69 -179 179 179 gray70 -179 179 179 grey70 -181 181 181 gray71 -181 181 181 grey71 -184 184 184 gray72 -184 184 184 grey72 -186 186 186 gray73 -186 186 186 grey73 -189 189 189 gray74 -189 189 189 grey74 -191 191 191 gray75 -191 191 191 grey75 -194 194 194 gray76 -194 194 194 grey76 -196 196 196 gray77 -196 196 196 grey77 -199 199 199 gray78 -199 199 199 grey78 -201 201 201 gray79 -201 201 201 grey79 -204 204 204 gray80 -204 204 204 grey80 -207 207 207 gray81 -207 207 207 grey81 -209 209 209 gray82 -209 209 209 grey82 -212 212 212 gray83 -212 212 212 grey83 -214 214 214 gray84 -214 214 214 grey84 -217 217 217 gray85 -217 217 217 grey85 -219 219 219 gray86 -219 219 219 grey86 -222 222 222 gray87 -222 222 222 grey87 -224 224 224 gray88 -224 224 224 grey88 -227 227 227 gray89 -227 227 227 grey89 -229 229 229 gray90 -229 229 229 grey90 -232 232 232 gray91 -232 232 232 grey91 -235 235 235 gray92 -235 235 235 grey92 -237 237 237 gray93 -237 237 237 grey93 -240 240 240 gray94 -240 240 240 grey94 -242 242 242 gray95 -242 242 242 grey95 -245 245 245 gray96 -245 245 245 grey96 -247 247 247 gray97 -247 247 247 grey97 -250 250 250 gray98 -250 250 250 grey98 -252 252 252 gray99 -252 252 252 grey99 -255 255 255 gray100 -255 255 255 grey100 + 10 10 10 gray4 + 10 10 10 grey4 + 13 13 13 gray5 + 13 13 13 grey5 + 15 15 15 gray6 + 15 15 15 grey6 + 18 18 18 gray7 + 18 18 18 grey7 + 20 20 20 gray8 + 20 20 20 grey8 + 23 23 23 gray9 + 23 23 23 grey9 + 26 26 26 gray10 + 26 26 26 grey10 + 28 28 28 gray11 + 28 28 28 grey11 + 31 31 31 gray12 + 31 31 31 grey12 + 33 33 33 gray13 + 33 33 33 grey13 + 36 36 36 gray14 + 36 36 36 grey14 + 38 38 38 gray15 + 38 38 38 grey15 + 41 41 41 gray16 + 41 41 41 grey16 + 43 43 43 gray17 + 43 43 43 grey17 + 46 46 46 gray18 + 46 46 46 grey18 + 48 48 48 gray19 + 48 48 48 grey19 + 51 51 51 gray20 + 51 51 51 grey20 + 54 54 54 gray21 + 54 54 54 grey21 + 56 56 56 gray22 + 56 56 56 grey22 + 59 59 59 gray23 + 59 59 59 grey23 + 61 61 61 gray24 + 61 61 61 grey24 + 64 64 64 gray25 + 64 64 64 grey25 + 66 66 66 gray26 + 66 66 66 grey26 + 69 69 69 gray27 + 69 69 69 grey27 + 71 71 71 gray28 + 71 71 71 grey28 + 74 74 74 gray29 + 74 74 74 grey29 + 77 77 77 gray30 + 77 77 77 grey30 + 79 79 79 gray31 + 79 79 79 grey31 + 82 82 82 gray32 + 82 82 82 grey32 + 84 84 84 gray33 + 84 84 84 grey33 + 87 87 87 gray34 + 87 87 87 grey34 + 89 89 89 gray35 + 89 89 89 grey35 + 92 92 92 gray36 + 92 92 92 grey36 + 94 94 94 gray37 + 94 94 94 grey37 + 97 97 97 gray38 + 97 97 97 grey38 + 99 99 99 gray39 + 99 99 99 grey39 +102 102 102 gray40 +102 102 102 grey40 +105 105 105 gray41 +105 105 105 grey41 +107 107 107 gray42 +107 107 107 grey42 +110 110 110 gray43 +110 110 110 grey43 +112 112 112 gray44 +112 112 112 grey44 +115 115 115 gray45 +115 115 115 grey45 +117 117 117 gray46 +117 117 117 grey46 +120 120 120 gray47 +120 120 120 grey47 +122 122 122 gray48 +122 122 122 grey48 +125 125 125 gray49 +125 125 125 grey49 +127 127 127 gray50 +127 127 127 grey50 +130 130 130 gray51 +130 130 130 grey51 +133 133 133 gray52 +133 133 133 grey52 +135 135 135 gray53 +135 135 135 grey53 +138 138 138 gray54 +138 138 138 grey54 +140 140 140 gray55 +140 140 140 grey55 +143 143 143 gray56 +143 143 143 grey56 +145 145 145 gray57 +145 145 145 grey57 +148 148 148 gray58 +148 148 148 grey58 +150 150 150 gray59 +150 150 150 grey59 +153 153 153 gray60 +153 153 153 grey60 +156 156 156 gray61 +156 156 156 grey61 +158 158 158 gray62 +158 158 158 grey62 +161 161 161 gray63 +161 161 161 grey63 +163 163 163 gray64 +163 163 163 grey64 +166 166 166 gray65 +166 166 166 grey65 +168 168 168 gray66 +168 168 168 grey66 +171 171 171 gray67 +171 171 171 grey67 +173 173 173 gray68 +173 173 173 grey68 +176 176 176 gray69 +176 176 176 grey69 +179 179 179 gray70 +179 179 179 grey70 +181 181 181 gray71 +181 181 181 grey71 +184 184 184 gray72 +184 184 184 grey72 +186 186 186 gray73 +186 186 186 grey73 +189 189 189 gray74 +189 189 189 grey74 +191 191 191 gray75 +191 191 191 grey75 +194 194 194 gray76 +194 194 194 grey76 +196 196 196 gray77 +196 196 196 grey77 +199 199 199 gray78 +199 199 199 grey78 +201 201 201 gray79 +201 201 201 grey79 +204 204 204 gray80 +204 204 204 grey80 +207 207 207 gray81 +207 207 207 grey81 +209 209 209 gray82 +209 209 209 grey82 +212 212 212 gray83 +212 212 212 grey83 +214 214 214 gray84 +214 214 214 grey84 +217 217 217 gray85 +217 217 217 grey85 +219 219 219 gray86 +219 219 219 grey86 +222 222 222 gray87 +222 222 222 grey87 +224 224 224 gray88 +224 224 224 grey88 +227 227 227 gray89 +227 227 227 grey89 +229 229 229 gray90 +229 229 229 grey90 +232 232 232 gray91 +232 232 232 grey91 +235 235 235 gray92 +235 235 235 grey92 +237 237 237 gray93 +237 237 237 grey93 +240 240 240 gray94 +240 240 240 grey94 +242 242 242 gray95 +242 242 242 grey95 +245 245 245 gray96 +245 245 245 grey96 +247 247 247 gray97 +247 247 247 grey97 +250 250 250 gray98 +250 250 250 grey98 +252 252 252 gray99 +252 252 252 grey99 +255 255 255 gray100 +255 255 255 grey100 169 169 169 dark grey 169 169 169 DarkGrey 169 169 169 dark gray 169 169 169 DarkGray -0 0 139 dark blue -0 0 139 DarkBlue -0 139 139 dark cyan -0 139 139 DarkCyan + 0 0 139 dark blue + 0 0 139 DarkBlue + 0 139 139 dark cyan + 0 139 139 DarkCyan 139 0 139 dark magenta 139 0 139 DarkMagenta 139 0 0 dark red 139 0 0 DarkRed 144 238 144 light green 144 238 144 LightGreen +220 20 60 crimson + 75 0 130 indigo +128 128 0 olive +102 51 153 rebecca purple +102 51 153 RebeccaPurple +192 192 192 silver + 0 128 128 teal commit 64850eaf989cdf3a69abc9b0c2fa37e098e7b0b9 Author: Alan Mackenzie Date: Sat Oct 14 19:14:57 2023 +0000 Fix an infinite loop in c-beginning-of-defun-1 This fixes bug#61436. The loop manifested itself in c-get-fallback-scan-pos as the position returned wasn't at a {, so the search back in c-beginning-of-defun-1 with a defun-prompt-regexp found the same BOL and moved forward to after the match, repeat. * lisp/progmodes/cc-defs.el (c-beginning-of-defun-1): Accept a position found by beginning-of-defun (which uses defun-prompt-regexp) only when the \\s( following it is a {. Repeat the backward search when this isn't the case. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 8662e0cade6..e15ce54da7f 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -927,7 +927,8 @@ c-go-down-list-backward (when dest (goto-char dest) t))) (defmacro c-beginning-of-defun-1 () - ;; Wrapper around beginning-of-defun. + ;; Wrapper around beginning-of-defun. Note that the return value from this + ;; macro has no significance. ;; ;; NOTE: This function should contain the only explicit use of ;; beginning-of-defun in CC Mode. Eventually something better than @@ -940,44 +941,49 @@ c-beginning-of-defun-1 ;; `c-parse-state'. `(progn - (if (and ,(fboundp 'buffer-syntactic-context-depth) - c-enable-xemacs-performance-kludge-p) - ,(when (fboundp 'buffer-syntactic-context-depth) - ;; XEmacs only. This can improve the performance of - ;; c-parse-state to between 3 and 60 times faster when - ;; braces are hung. It can also degrade performance by - ;; about as much when braces are not hung. - '(let (beginning-of-defun-function end-of-defun-function - pos) - (while (not pos) - (save-restriction - (widen) - (setq pos (c-safe-scan-lists - (point) -1 (buffer-syntactic-context-depth)))) - (cond - ((bobp) (setq pos (point-min))) - ((not pos) - (let ((distance (skip-chars-backward "^{"))) - ;; unbalanced parenthesis, while invalid C code, - ;; shouldn't cause an infloop! See unbal.c - (when (zerop distance) - ;; Punt! - (beginning-of-defun) - (setq pos (point))))) - ((= pos 0)) - ((not (eq (char-after pos) ?{)) - (goto-char pos) - (setq pos nil)) - )) - (goto-char pos))) - ;; Emacs, which doesn't have buffer-syntactic-context-depth - (let (beginning-of-defun-function end-of-defun-function) - (beginning-of-defun))) - ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at the - ;; open brace. - (and defun-prompt-regexp - (looking-at defun-prompt-regexp) - (goto-char (match-end 0))))) + (while + (progn + (if (and ,(fboundp 'buffer-syntactic-context-depth) + c-enable-xemacs-performance-kludge-p) + ,(when (fboundp 'buffer-syntactic-context-depth) + ;; XEmacs only. This can improve the performance of + ;; c-parse-state to between 3 and 60 times faster when + ;; braces are hung. It can also degrade performance by + ;; about as much when braces are not hung. + '(let (beginning-of-defun-function end-of-defun-function + pos) + (while (not pos) + (save-restriction + (widen) + (setq pos (c-safe-scan-lists + (point) -1 (buffer-syntactic-context-depth)))) + (cond + ((bobp) (setq pos (point-min))) + ((not pos) + (let ((distance (skip-chars-backward "^{"))) + ;; unbalanced parenthesis, while invalid C code, + ;; shouldn't cause an infloop! See unbal.c + (when (zerop distance) + ;; Punt! + (beginning-of-defun) + (setq pos (point))))) + ((= pos 0)) + ((not (eq (char-after pos) ?{)) + (goto-char pos) + (setq pos nil)) + )) + (goto-char pos))) + ;; Emacs, which doesn't have buffer-syntactic-context-depth + (let (beginning-of-defun-function end-of-defun-function) + (beginning-of-defun))) + (and (not (bobp)) + ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at + ;; the open brace. + defun-prompt-regexp + (looking-at (concat defun-prompt-regexp "\\s(")) + (or (not (eq (char-before (match-end 0)) ?{)) + (progn (goto-char (1- (match-end 0))) + nil))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; commit 9525315c1179065b69c937899ea18fe649b0f16f Author: Stefan Kangas Date: Sat Oct 14 21:00:00 2023 +0200 Add missing :version to two defcustoms * lisp/emacs-lisp/eldoc.el (eldoc-print-after-edit) (eldoc-echo-area-prefer-doc-buffer): Add missing custom :version. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 7cd676b8e50..bc498d4372f 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -65,7 +65,8 @@ eldoc-idle-delay (defcustom eldoc-print-after-edit nil "If non-nil, eldoc info is only shown after editing commands. Changing the value requires toggling `eldoc-mode'." - :type 'boolean) + :type 'boolean + :version "24.4") (defcustom eldoc-echo-area-display-truncation-message t "If non-nil, provide verbose help when a message has been truncated. @@ -134,7 +135,8 @@ eldoc-echo-area-prefer-doc-buffer is only skipped if the documentation needs to be truncated there." :type '(choice (const :tag "Prefer ElDoc's documentation buffer" t) (const :tag "Prefer echo area" nil) - (const :tag "Skip echo area if truncating" maybe))) + (const :tag "Skip echo area if truncating" maybe)) + :version "28.1") (defface eldoc-highlight-function-argument '((t (:inherit bold))) commit 9044d4d94bbdaed8af2681bf7facb0ce4b27cd48 Author: Mauro Aranda Date: Sat Oct 14 10:34:54 2023 -0300 Fix a defcustom :type in eldoc.el * lisp/emacs-lisp/eldoc.el (eldoc-echo-area-prefer-doc-buffer): Make :type a choice, to allow for the value 'maybe'. (Bug##66539) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index a175edcc671..7cd676b8e50 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -132,7 +132,9 @@ eldoc-echo-area-prefer-doc-buffer buffer (displayed by `eldoc-doc-buffer') is already displayed in some window. If the value is the symbol `maybe', then the echo area is only skipped if the documentation needs to be truncated there." - :type 'boolean) + :type '(choice (const :tag "Prefer ElDoc's documentation buffer" t) + (const :tag "Prefer echo area" nil) + (const :tag "Skip echo area if truncating" maybe))) (defface eldoc-highlight-function-argument '((t (:inherit bold))) commit fe62315ef35c301d1fa0e1614d6bbbc83dbeef81 Author: Dmitry Gutov Date: Sat Oct 14 20:47:57 2023 +0300 Fix vc-hg-log-edit-toggle-amend * lisp/vc/log-edit.el (log-edit--toggle-amend): Handle the case when the VCS returns log entry that doesn't end with a newline (bug#66423). diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 1e249c637a6..c77f4494c1a 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -1219,7 +1219,10 @@ log-edit--toggle-amend (let ((pt (point))) (and (zerop (forward-line 1)) (looking-at "\n\\|\\'") - (let ((summary (buffer-substring-no-properties pt (1- (point))))) + (let ((summary (buffer-substring-no-properties pt + (if (bolp) + (1- (point)) + (point))))) (skip-chars-forward " \n") (delete-region pt (point)) (log-edit-set-header "Summary" summary))))))) commit c0ffa8958eba358b6c8ad072912b1fcd5aa7dfa6 Author: Dmitry Gutov Date: Sat Oct 14 20:10:08 2023 +0300 (vc-default-checkin-patch): Try to be compatible with BSD 'patch' * lisp/vc/vc.el (vc-default-checkin-patch): Try to be compatible with BSD 'patch' (bug#66211). diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index e4ce75107ff..95f9218dcbf 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1738,7 +1738,8 @@ vc-default-checkin-patch nil "-p1" "-r" null-device - "--no-backup-if-mismatch" + "--posix" + "--remove-empty-files" "-i" "-")) (user-error "Patch failed: %s" (buffer-string)))) (vc-call-backend backend 'checkin files comment)) commit 717d0335d72de5696c5ac035b9877fec3132d189 Author: Dmitry Gutov Date: Sat Oct 14 20:01:24 2023 +0300 (vc-root-diff): Don't compute and pass on WORKING-REVISION * lisp/vc/vc.el (vc-root-diff): Don't compute and pass on WORKING-REVISION (bug#66364). It was unused. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a5575f91e9c..e4ce75107ff 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2238,7 +2238,7 @@ vc-root-diff (vc-maybe-buffer-sync not-urgent) (let ((backend (vc-deduce-backend)) (default-directory default-directory) - rootdir working-revision) + rootdir) (if backend (setq rootdir (vc-call-backend backend 'root default-directory)) (setq rootdir (read-directory-name "Directory for VC root-diff: ")) @@ -2246,14 +2246,13 @@ vc-root-diff (if backend (setq default-directory rootdir) (error "Directory is not version controlled"))) - (setq working-revision (vc-working-revision rootdir)) ;; VC diff for the root directory produces output that is ;; relative to it. Bind default-directory to the root directory ;; here, this way the *vc-diff* buffer is setup correctly, so ;; relative file names work. (let ((default-directory rootdir)) (vc-diff-internal - t (list backend (list rootdir) working-revision) nil nil + t (list backend (list rootdir)) nil nil (called-interactively-p 'interactive)))))) ;;;###autoload commit 64dcdb74172cb77650e8b46fcf08b989963cec17 Author: Spencer Baugh Date: Thu Oct 12 21:06:53 2023 -0400 Optimize vc-hg-state for directories Directories are never tracked in hg, so it's pointless to run vc-hg-state on them. And, in fact, our implementation previously would list all the files contained in the directory and then parse that in Emacs, which is very slow in large repos. Let's just use the knowledge that directories aren't tracked in hg, and skip running hg entirely. * lisp/vc/vc-hg.el (vc-hg-state): Return nil for directories. (Bug#66364) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index c3e563a1f10..f2ee9ef35e4 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -216,8 +216,9 @@ vc-hg-registered (defun vc-hg-state (file) "Hg-specific version of `vc-state'." - (let ((state (vc-hg-state-fast file))) - (if (eq state 'unsupported) (vc-hg-state-slow file) state))) + (unless (file-directory-p file) + (let ((state (vc-hg-state-fast file))) + (if (eq state 'unsupported) (vc-hg-state-slow file) state)))) (defun vc-hg-state-slow (file) "Determine status of FILE by running hg." commit 330dd51f8bf154fedde2110675fd606400173e23 Author: Harald Jörg Date: Sat Oct 14 18:15:11 2023 +0200 ;cperl-mode.el: Do not mistake a left-shift operator for a here-doc. * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Empty unquoted delimiters for here-documents are now forbidden (Bug#65834). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-65834): New test. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-65834.pl: new resource with source code from the bug report. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 7b72e3baee5..6ef552137a7 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3973,8 +3973,8 @@ cperl-find-pods-heres "\\([^\"'`\n]*\\)" ; 4 + 1 "\\4" "\\|" - ;; Second variant: Identifier or \ID (same as 'ID') or empty - "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1 + ;; Second variant: Identifier or \ID (same as 'ID') + "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\)" ; 5 + 1, 6 + 1 ;; Do not have <<= or << 30 or <<30 or << $blah. ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 "\\)" diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-65834.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-65834.pl new file mode 100644 index 00000000000..775a113ac17 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-65834.pl @@ -0,0 +1,5 @@ +# -*- mode: cperl -*- +if ($t->[3]<<5) { + return 0; +} +# comment diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index de7a614496f..0af44c8e08d 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1379,6 +1379,22 @@ cperl-test-bug-64364 (forward-line 1)))) (cperl-set-style-back)) +(ert-deftest cperl-test-bug-65834 () + "Verify that CPerl mode identifies a left-shift operator. +Left-shift and here-documents both use the \"<<\" operator. +In the code provided by this bug report, it needs to be +detected as left-shift operator." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-65834.pl")) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward "retur") ; leaves point before the "n" + (should (equal (get-text-property (point) 'face) + font-lock-keyword-face)) + (search-forward "# comm") ; leaves point before "ent" + (should (equal (get-text-property (point) 'face) + font-lock-comment-face)))) + (ert-deftest cperl-test-bug-66145 () "Verify that hashes and arrays are only fontified in code. In strings, comments and POD the syntaxified faces should commit ad02fc212b5a88d2ea793858d538809d9976b154 Author: Mauro Aranda Date: Sat Oct 14 09:05:35 2023 -0300 Fix indentation and fontification in shell-script (Bug#26217) * lisp/progmodes/sh-script.el (sh-smie--sh-keyword-p): Treat "do" as special, like we treat "in". (sh-smie--sh-keyword-in-p): Change signature. Take the token to decide correctly if it's a keyword. (sh-font-lock-keywords-var-1): Add do. * test/lisp/progmodes/sh-script-resources/sh-indents.erts: New test. * test/lisp/progmodes/sh-script-tests.el (sh-script-test-do-fontification): New test. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index cc521cb0591..de76e175a10 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -869,7 +869,7 @@ sh-font-lock-keywords-var "Default expressions to highlight in Shell Script modes. See `sh-feature'.") (defvar sh-font-lock-keywords-var-1 - '((sh "[ \t]in\\>")) + '((sh "[ \t]\\(in\\|do\\)\\>")) "Subdued level highlighting for Shell Script modes.") (defvar sh-font-lock-keywords-var-2 () @@ -1809,8 +1809,8 @@ sh-smie--sh-operators-back-re (concat "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*" "\\(" sh-smie--sh-operators-re "\\)")) -(defun sh-smie--sh-keyword-in-p () - "Assuming we're looking at \"in\", return non-nil if it's a keyword. +(defun sh-smie--sh-keyword-in/do-p (tok) + "When looking at TOK (either \"in\" or \"do\"), non-nil if TOK is a keyword. Does not preserve point." (let ((forward-sexp-function nil) (words nil) ;We've seen words. @@ -1832,7 +1832,10 @@ sh-smie--sh-keyword-in-p ((equal prev ";") (if words (setq newline t) (setq res 'keyword))) - ((member prev '("case" "for" "select")) (setq res 'keyword)) + ((member prev (if (string= tok "in") + '("case" "for" "select") + '("for" "select"))) + (setq res 'keyword)) ((assoc prev smie-grammar) (setq res 'word)) (t (if newline @@ -1844,7 +1847,7 @@ sh-smie--sh-keyword-p "Non-nil if TOK (at which we're looking) really is a keyword." (cond ((looking-at "[[:alnum:]_]+=") nil) - ((equal tok "in") (sh-smie--sh-keyword-in-p)) + ((member tok '("in" "do")) (sh-smie--sh-keyword-in/do-p tok)) (t (sh-smie--keyword-p)))) (defun sh-smie--default-forward-token () diff --git a/test/lisp/progmodes/sh-script-resources/sh-indents.erts b/test/lisp/progmodes/sh-script-resources/sh-indents.erts index 1f92610b3aa..36f4e4c22ab 100644 --- a/test/lisp/progmodes/sh-script-resources/sh-indents.erts +++ b/test/lisp/progmodes/sh-script-resources/sh-indents.erts @@ -38,3 +38,10 @@ if test ;then fi other =-=-= + +Name: sh-indents5 + +=-= +for i do echo 1; done +for i; do echo 1; done +=-=-= diff --git a/test/lisp/progmodes/sh-script-tests.el b/test/lisp/progmodes/sh-script-tests.el index 52c1303c414..135d7afe3fe 100644 --- a/test/lisp/progmodes/sh-script-tests.el +++ b/test/lisp/progmodes/sh-script-tests.el @@ -87,4 +87,15 @@ test-backward-token (should-not (test-sh-back "foo;bar")) (should (test-sh-back "foo#zot"))) +(ert-deftest sh-script-test-do-fontification () + "Test that \"do\" gets fontified correctly, even with no \";\"." + (with-temp-buffer + (shell-script-mode) + (insert "for i do echo 1; done") + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "do") + (forward-char -1) + (should (equal (get-text-property (point) 'face) 'font-lock-keyword-face)))) + ;;; sh-script-tests.el ends here commit 1f95f91d855b8e6fd4221650b7878008f7665454 Author: Mattias Engdegård Date: Sat Oct 14 13:24:30 2023 +0200 Simplify and describe docstrings-wide check * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-substitution-len): Remove. * lisp/emacs-lisp/bytecomp.el (bytecomp--docstring-line-width): Add back explanatory comments lost in a previous change. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f3e27a511da..92abe6b4624 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1674,23 +1674,26 @@ byte-compile-arglist-warn (if (equal sig1 '(1 . 1)) "argument" "arguments") (byte-compile-arglist-signature-string sig2))))))) -(defvar byte-compile--wide-docstring-substitution-len 3 - "Substitution width used in `byte-compile--wide-docstring-p'. -This is a heuristic for guessing the width of a documentation -string: `byte-compile--wide-docstring-p' assumes that any -`substitute-command-keys' command substitutions are this long.") - (defun bytecomp--docstring-line-width (str) "An approximation of the displayed width of docstring line STR." + ;; For literal key sequence substitutions (e.g. "\\`C-h'"), just + ;; remove the markup as `substitute-command-keys' would. (when (string-search "\\`" str) (setq str (replace-regexp-in-string (rx "\\`" (group (* (not "'"))) "'") "\\1" str t))) + ;; Heuristic: We can't reliably do `substitute-command-keys' + ;; substitutions, since the value of a keymap in general can't be + ;; known at compile time. So instead, we assume that these + ;; substitutions are of some constant length. (when (string-search "\\[" str) (setq str (replace-regexp-in-string (rx "\\[" (* (not "]")) "]") - (make-string byte-compile--wide-docstring-substitution-len ?x) + ;; We assume that substitutions have this length. + ;; To preserve the non-expansive property of the transform, + ;; it shouldn't be more than 3 characters long. + "xxx" str t t))) (setq str (replace-regexp-in-string @@ -1718,16 +1721,16 @@ bytecomp--docstring-line-width (defun byte-compile--wide-docstring-p (docstring max-width) "Whether DOCSTRING contains a line wider than MAX-WIDTH. Ignore all `substitute-command-keys' substitutions, except for -the `\\\\=[command]' ones that are assumed to be of length -`byte-compile--wide-docstring-substitution-len'. Also ignore URLs." +the `\\\\=[command]' ones that are assumed to be of a fixed length. +Also ignore URLs." (let ((string-len (length docstring)) (start 0) (too-wide nil)) (while (< start string-len) (let ((eol (or (string-search "\n" docstring start) string-len))) - ;; Since `bytecomp--docstring-line-width' is almost always - ;; contractive, we can safely assume that if the raw length is + ;; Since `bytecomp--docstring-line-width' is non-expansive, + ;; we can safely assume that if the raw length is ;; within the allowed width, then so is the transformed width. ;; This allows us to avoid the very expensive transformation in ;; most cases. commit 8141d73ea7f597787bd554b01f98f3925e6531d2 Author: Eshel Yaron Date: Mon Oct 2 10:02:46 2023 +0200 Document 'M-x align' in the Emacs manual * doc/emacs/indent.texi (Alignment): New section. * doc/emacs/emacs.texi: Update menu. (Bug#66303) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index c2cda7a932a..ca95a95eba8 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -592,6 +592,7 @@ Top * Tab Stops:: Stop points for indentation in Text modes. * Just Spaces:: Using only space characters for indentation. * Indent Convenience:: Optional indentation features. +* Code Alignment:: Making common parts of lines start at the same column. Commands for Human Languages diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index 17b663d22e1..0df973c1dd0 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -55,6 +55,7 @@ Indentation * Tab Stops:: Stop points for indentation in Text modes. * Just Spaces:: Using only space characters for indentation. * Indent Convenience:: Optional indentation features. +* Code Alignment:: Making common parts of lines start at the same column. @end menu @node Indentation Commands @@ -265,3 +266,236 @@ Indent Convenience by default. To toggle this minor mode, type @kbd{M-x electric-indent-mode}. To toggle the mode in a single buffer, use @kbd{M-x electric-indent-local-mode}. + +@node Code Alignment +@section Code Alignment +@cindex code alignment +@cindex aligning code + + @dfn{Alignment} is the process of adjusting whitespace in a sequence +of lines in the region such that in all lines certain parts begin at +the same column. This is usually something you do to enhance +readability of a piece of text or code. The classic example is +aligning a series of assignments in C-like programming languages: + +@example +int a = 1; +short foo = 2; +double blah = 4; +@end example + +@noindent +is commonly aligned to: + +@example +int a = 1; +short foo = 2; +double blah = 4; +@end example + +@cindex alignment rules +@findex align + You can use the command @kbd{M-x align} to align lines in the +current region. This command knows about common alignment patterns +across many markup and programming languages. It encodes these +patterns as a set of @dfn{alignment rules}, that say how to align +different kinds of text in different contexts. + +@vindex align-rules-list +@vindex align-mode-rules-list +The user option @code{align-rules-list} says which alignment rules +@kbd{M-x align} should consult. The value of this option is a list +with elements describing alignment rules. Each element is a cons cell +@code{(@var{title} . @var{attributes})}, where @var{title} is the name +of the alignment rule as a symbol, and @var{attributes} is a list of +rule attributes that define when the rule should apply and how it +partitions and aligns lines. Each rule attribute is a cons cell +@code{(@var{attribute} . @var{value})}, where @var{attribute} is the +name of attribute and @var{value} is its value. The only required +attribute is @code{regexp}, whose value is a regular expression with +sub-expressions matching the parts of each line where @kbd{M-x align} +should expand or contract whitespace (@pxref{Regexp Backslash}). See +the documentation string of @code{align-rules-list} (@kbd{C-h v +align-rules-list @key{RET}}) for a full description of possible +alignment rule attributes. By default, this option is set to a long +list of alignment rules for many languages that Emacs supports. The +default rules use the @code{modes} rule attribute to specify major +modes in which @kbd{M-x align} should apply them. Major modes can +also override @code{align-rules-list} by setting the buffer-local +variable @code{align-mode-rules-list} to a non-@code{nil} list of +alignment rules. When @code{align-mode-rules-list} is non-@code{nil}, +@kbd{M-x align} consults it instead of @code{align-rules-list}. + +@cindex align exclusion rules +@vindex align-exclude-rules-list +@vindex align-mode-exclude-rules-list +Besides alignment rules, @kbd{M-x align} uses another kind of rules +called @dfn{exclusion rules}. The exclusion rules say which parts in +the region @kbd{M-x align} should not align and instead leave them +intact. The user option @code{align-exclude-rules-list} specifies +these exclusion rules. Similarly to @code{align-rules-list}, the +value of @code{align-exclude-rules-list} is also a list of cons cells +that describe the exclusion rules. By default, +@code{align-exclude-rules-list} includes rules that exclude alignment +in quoted strings and comments in Lisp, C and other languages. Beyond +the default exclusion rules in @code{align-exclude-rules-list}, major +modes can define bespoke exclusion rules by setting +@code{align-mode-exclude-rules-list} to a non-@code{nil} list of +rules, this overrides @code{align-exclude-rules-list} just like +@code{align-mode-rules-list} overrides @code{align-rules-list}. + +@cindex alignment sections +@vindex align-region-separate +@kbd{M-x align} splits the region into a series of @dfn{sections}, +usually sequences of non-blank lines, and aligns each section +according to all matching alignment rule by expanding or contracting +stretches of whitespace. @kbd{M-x align} consistently aligns all +lines inside a single section, but it may align different sections in +the region differently. The user option @code{align-region-separate} +specifies how @kbd{M-x align} separates the region to sections. This +option can be one of the symbols @code{entire}, @code{group}, or a +regular expression. If @code{align-region-separate} is @code{entire}, +Emacs aligns the entire region as a single section. If this option is +@code{group}, Emacs aligns each group of consecutive non-blank lines +in the region as a separate section. If @code{align-region-separate} +is a regular expression, @kbd{M-x align} scans the region for matches +to that regular expression and treats them as section separators. By +default @code{align-region-separate} is set to a regular expression +that matches blank lines and lines that contains only whitespace and a +single curly brace (@samp{@{} or @samp{@}}). For special cases where +regular expressions are not accurate enough, you can also set +@code{align-region-separate} to a function that says how to separate +the region to alignment sections. See the documentation string of +@code{align-region-separate} for more details. Specific alignment +rules can override the value of @code{align-region-separate} and +define their own section separator by specifying the @code{separate} +rule attribute. + +If you call @kbd{M-x align} with a prefix argument (@kbd{C-u}), it +enables more alignment rules that are often useful but may sometimes +be too intrusive. For example, in a Lisp buffer with the following +form: + +@lisp +(set-face-attribute 'mode-line-inactive nil + :box nil + :background nil + :underline "black") +@end lisp + +@noindent +Typing (@kbd{C-u M-x align}) yields: + +@lisp +(set-face-attribute 'mode-line-inactive nil + :box nil + :background nil + :underline "black") +@end lisp + +In most cases, you should try @kbd{M-x align} without a prefix +argument first, and if that doesn't produce the right result you can +undo with @kbd{C-/} and try again with @kbd{C-u M-x align}. + +@findex align-highlight-rule +@findex align-unhighlight-rule +You can use the command @kbd{M-x align-highlight-rule} to visualize +the effect of a specific alignment or exclusion rule in the current +region. This command prompts you for the title of a rule and +highlights the parts on the region that this rule affects. For +alignment rules, this command highlights the whitespace that @kbd{M-x +align} would expand or contract, and for exclusion this command +highlights the parts that @kbd{M-x align} would exclude from +alignment. To remove the highlighting that this command creates, type +@kbd{M-x align-unhighlight-rule}. + +@findex align-current +@findex align-entire + The command @kbd{M-x align-current} is similar to @kbd{M-x align}, +except that it operates only on the alignment section that contains +point regardless of the current region. This command determines the +boundaries of the current section according to the section separators +that @code{align-region-separate} define. @kbd{M-x align-entire} is +another variant of @kbd{M-x align}, that disregards +@code{align-region-separate} and aligns the entire region as a single +alignment section with consistent alignment. If you set +@code{align-region-separate} to @code{entire}, @kbd{M-x align} behaves +like @kbd{M-x align-entire} by default. To illustrate the effect of +aligning the entire region as a single alignment section, consider the +following code: + +@example +one = 1; +foobarbaz = 2; + +spam = 3; +emacs = 4; +@end example + +@noindent +when the region covers all of these lines, typing @kbd{M-x align} +yields: + +@example +one = 1; +foobarbaz = 2; + +spam = 3; +emacs = 4; +@end example + +@noindent +On the other hand, @kbd{M-x align-entire} aligns all of the lines as a +single section, so the @samp{=} appears at the same column in all +lines: + +@example +one = 1; +foobarbaz = 2; + +spam = 3; +emacs = 4; +@end example + +@findex align-regexp + The command @kbd{M-x align-regexp} lets you align the current region +with an alignment rule that you define ad-hoc, instead of using the +predefined rules in @code{align-rules-list}. @kbd{M-x align-regexp} +prompts you for a regular expression and uses that expression as the +@code{regexp} attribute for an ad-hoc alignment rule that this command +uses to align the current region. By default, this command adjusts +the whitespace that matches the first sub-expression of the regular +expression you specify. If you call @kbd{M-x align-regexp} with a +prefix argument, it also prompts you for the sub-expression to use and +lets you specify the amount of whitespace to use as padding, as well +as whether to apply the rule repeatedly to all matches of the regular +expression in each line. @xref{Regexp Backslash}, for more +information about regular expressions and their sub-expressions. + +@vindex align-indent-before-aligning + If the user option @code{align-indent-before-aligning} is +non-@code{nil}, Emacs indents the region before aligning it with +@kbd{M-x align}. @xref{Indentation}. By default +@code{align-indent-before-aligning} is set to @code{nil}. + +@vindex align-to-tab-stop + The user option @code{align-to-tab-stop} says whether aligned parts +should start at a tab stop (@pxref{Tab Stops}). If this option is +@code{nil}, @kbd{M-x align} uses just enough whitespace for alignment, +disregarding tab stops. If this is a non-@code{nil} symbol, @kbd{M-x +align} checks the value of that symbol, and if this value is +non-@code{nil}, @kbd{M-x align} aligns to tab stops. By default, this +option is set to @code{indent-tabs-mode}, so alignment respects tab +stops in buffers that use tabs for indentation. @xref{Just Spaces}. + +@vindex align-default-spacing + The user option @code{align-default-spacing} specifies the default +amount of whitespace that @kbd{M-x align} and its related commands use +for padding between the different parts of each line when aligning it. +When @code{align-to-tab-stop} is @code{nil}, the value of +@code{align-default-spacing} is the number of spaces to use for +padding; when @code{align-to-tab-stop} is non-@code{nil}, the value of +@code{align-default-spacing} is instead the number of tab stops to +use. Each alignment rule can override the default that +@code{align-default-spacing} specifies with the @code{spacing} +attribute rule. commit fe110cb61152c21a24f3c0ceaa00290884365b61 Merge: fbbe40cf50e 06a87738114 Author: Eli Zaretskii Date: Sat Oct 14 06:55:05 2023 -0400 Merge from origin/emacs-29 06a87738114 ; * lisp/calendar/time-date.el (days-to-time): Doc fix. 0ea2d6d9e82 Document that time-to-days and days-to-time use different... commit fbbe40cf50ecd9f4ce5f2ff684190d8ed37f2aa9 Author: Mattias Engdegård Date: Sat Oct 14 11:42:44 2023 +0200 Make the docstrings-wide check 70x faster Instead of performing a number of expensive transformations on the original doc string and then use a dynamically-created regexp to find wide lines, step through the lines in the unmodified string and only perform the transformations on lines that exceed the limit. This is sound because the transformations are contractive. The new check will usually not cons nor perform any regexp matching. * lisp/emacs-lisp/bytecomp.el (bytecomp--docstring-line-width): New. (byte-compile--wide-docstring-p): Cheaper implementation. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b3ddc7dd208..f3e27a511da 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1680,47 +1680,66 @@ byte-compile--wide-docstring-substitution-len string: `byte-compile--wide-docstring-p' assumes that any `substitute-command-keys' command substitutions are this long.") -(defun byte-compile--wide-docstring-p (docstring col) - "Return t if string DOCSTRING is wider than COL. +(defun bytecomp--docstring-line-width (str) + "An approximation of the displayed width of docstring line STR." + (when (string-search "\\`" str) + (setq str (replace-regexp-in-string + (rx "\\`" (group (* (not "'"))) "'") + "\\1" + str t))) + (when (string-search "\\[" str) + (setq str (replace-regexp-in-string + (rx "\\[" (* (not "]")) "]") + (make-string byte-compile--wide-docstring-substitution-len ?x) + str t t))) + (setq str + (replace-regexp-in-string + (rx (or + ;; Ignore some URLs. + (seq "http" (? "s") "://" (* nonl)) + ;; Ignore these `substitute-command-keys' substitutions. + (seq "\\" (or "=" + (seq "<" (* (not ">")) ">") + (seq "{" (* (not "}")) "}"))) + ;; Ignore the function signature that's stashed at the end of + ;; the doc string (in some circumstances). + (seq bol "(" (+ (any word "-/:[]&")) + ;; One or more arguments. + (+ " " (or + ;; Arguments. + (+ (or (syntax symbol) + (any word "-/:[]&=()<>.,?^\\#*'\""))) + ;; Argument that is a list. + (seq "(" (* (not ")")) ")"))) + ")"))) + "" str t t)) + (length str)) + +(defun byte-compile--wide-docstring-p (docstring max-width) + "Whether DOCSTRING contains a line wider than MAX-WIDTH. Ignore all `substitute-command-keys' substitutions, except for the `\\\\=[command]' ones that are assumed to be of length -`byte-compile--wide-docstring-substitution-len'. Also ignore -URLs." - (string-match - (format "^.\\{%d,\\}$" (min (1+ col) #xffff)) ; Heed RE_DUP_MAX. - (replace-regexp-in-string - (rx (or - ;; Ignore some URLs. - (seq "http" (? "s") "://" (* nonl)) - ;; Ignore these `substitute-command-keys' substitutions. - (seq "\\" (or "=" - (seq "<" (* (not ">")) ">") - (seq "{" (* (not "}")) "}"))) - ;; Ignore the function signature that's stashed at the end of - ;; the doc string (in some circumstances). - (seq bol "(" (+ (any word "-/:[]&")) - ;; One or more arguments. - (+ " " (or - ;; Arguments. - (+ (or (syntax symbol) - (any word "-/:[]&=()<>.,?^\\#*'\""))) - ;; Argument that is a list. - (seq "(" (* (not ")")) ")"))) - ")"))) - "" - ;; Heuristic: We can't reliably do `substitute-command-keys' - ;; substitutions, since the value of a keymap in general can't be - ;; known at compile time. So instead, we assume that these - ;; substitutions are of some length N. - (replace-regexp-in-string - (rx "\\[" (* (not "]")) "]") - (make-string byte-compile--wide-docstring-substitution-len ?x) - ;; For literal key sequence substitutions (e.g. "\\`C-h'"), just - ;; remove the markup as `substitute-command-keys' would. - (replace-regexp-in-string - (rx "\\`" (group (* (not "'"))) "'") - "\\1" - docstring))))) +`byte-compile--wide-docstring-substitution-len'. Also ignore URLs." + (let ((string-len (length docstring)) + (start 0) + (too-wide nil)) + (while (< start string-len) + (let ((eol (or (string-search "\n" docstring start) + string-len))) + ;; Since `bytecomp--docstring-line-width' is almost always + ;; contractive, we can safely assume that if the raw length is + ;; within the allowed width, then so is the transformed width. + ;; This allows us to avoid the very expensive transformation in + ;; most cases. + (if (and (> (- eol start) max-width) + (> (bytecomp--docstring-line-width + (substring docstring start eol)) + max-width)) + (progn + (setq too-wide t) + (setq start string-len)) + (setq start (1+ eol))))) + too-wide)) (defcustom byte-compile-docstring-max-column 80 "Recommended maximum width of doc string lines. commit 06a87738114be7f79bee74d2233b0eed68954bf4 Author: Eli Zaretskii Date: Sat Oct 14 12:00:51 2023 +0300 ; * lisp/calendar/time-date.el (days-to-time): Doc fix. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 786134d8ac5..319d1d1b91c 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -182,7 +182,7 @@ seconds-to-time ;;;###autoload (defun days-to-time (days) "Convert Emacs-epoch DAYS into a time value. -Note that this does not use the same epoch as time-to-days; you +Note that this does not use the same epoch as `time-to-days'; you must subtract (time-to-days 0) first to convert, and may get nil if the result is before the start." ;; FIXME: We should likely just pass `t' to `time-convert'. commit 0ea2d6d9e82d2f88af4545f4b74c48989bf3415d Author: Bob Rogers Date: Thu Oct 12 10:23:35 2023 -0700 Document that time-to-days and days-to-time use different epochs * doc/lispref/os.texi (Time Calculations): * lisp/calendar/time-date.el (days-to-time, time-to-days): Doc fixes. (Bug#66502) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 7c8b35236cd..ea27af8edb2 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2104,6 +2104,14 @@ Time Calculations The operating system limits the range of time and zone values. @end defun +@defun days-to-time days +This is not quite the inverse of the @code{time-to-days} function, as +it uses the Emacs epoch (instead of the year 1) for historical +reasons. To get the inverse, subtract @code{(time-to-days 0)} from +@var{days}, in which case @code{days-to-time} may return @code{nil} if +@var{days} is negative. +@end defun + @defun time-to-day-in-year time-value This returns the day number within the year corresponding to @var{time-value}, assuming the default time zone. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 9cbe8e0f53c..786134d8ac5 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -181,7 +181,10 @@ seconds-to-time ;;;###autoload (defun days-to-time (days) - "Convert DAYS into a time value." + "Convert Emacs-epoch DAYS into a time value. +Note that this does not use the same epoch as time-to-days; you +must subtract (time-to-days 0) first to convert, and may get nil +if the result is before the start." ;; FIXME: We should likely just pass `t' to `time-convert'. ;; All uses I could find in Emacs, GNU ELPA, and NonGNU ELPA can handle ;; any valid time representation as return value. @@ -243,7 +246,7 @@ time-to-day-in-year ;;;###autoload (defun time-to-days (time) - "The absolute date corresponding to TIME, a time value. + "The absolute pseudo-Gregorian date for TIME, a time value. The absolute date is the number of days elapsed since the imaginary Gregorian date Sunday, December 31, 1 BC." (let* ((tim (decode-time time)) commit 548bc3e3d18ea6776032ca83dafbc89e3ddb5a5a Author: Mattias Engdegård Date: Fri Oct 13 19:55:45 2023 +0200 Sort byte compiler warnings in alphabetic order * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-types): Rearrange. Add a few missing ones. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5ce053c0d6e..b3ddc7dd208 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -292,49 +292,51 @@ byte-compile-error-on-warn ;;;###autoload(put 'byte-compile-error-on-warn 'safe-local-variable 'booleanp) (defconst byte-compile-warning-types - '(redefine callargs free-vars unresolved - obsolete noruntime interactive-only - make-local mapcar constants suspicious lexical lexical-dynamic - docstrings docstrings-wide docstrings-non-ascii-quotes not-unused - empty-body) + '( callargs constants + docstrings docstrings-non-ascii-quotes docstrings-wide + empty-body free-vars ignored-return-value interactive-only + lexical lexical-dynamic make-local + mapcar ; obsolete + mutate-constant noruntime not-unused obsolete redefine suspicious + unresolved) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "List of warnings that the byte-compiler should issue (t for almost all). Elements of the list may be: - free-vars references to variables not in the current lexical scope. - unresolved calls to unknown functions. callargs function calls with args that don't match the definition. - redefine function name redefined from a macro to ordinary function or vice - versa, or redefined to take a different number of arguments. - obsolete obsolete variables and functions. - noruntime functions that may not be defined at runtime (typically - defined only under `eval-when-compile'). - interactive-only - commands that normally shouldn't be called from Lisp code. - lexical global/dynamic variables lacking a prefix. - lexical-dynamic - lexically bound variable declared dynamic elsewhere - make-local calls to `make-variable-buffer-local' that may be incorrect. - ignored-return-value - function called without using the return value where this - is likely to be a mistake - not-unused warning about using variables with symbol names starting with _. constants let-binding of, or assignment to, constants/nonvariables. docstrings various docstring stylistic issues, such as incorrect use of single quotes + docstrings-non-ascii-quotes + docstrings that have non-ASCII quotes. + Only enabled when `docstrings' also is. docstrings-wide 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-non-ascii-quotes - docstrings that have non-ASCII quotes. - Only enabled when `docstrings' also is. - suspicious constructs that usually don't do what the coder wanted. 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 + function called without using the return value where this + is likely to be a mistake. + interactive-only + commands that normally shouldn't be called from Lisp code. + lexical global/dynamic variables lacking a prefix. + lexical-dynamic + lexically bound variable declared dynamic elsewhere + make-local calls to `make-variable-buffer-local' that may be incorrect. mutate-constant - code that mutates program constants such as quoted lists + code that mutates program constants such as quoted lists. + noruntime functions that may not be defined at runtime (typically + defined only under `eval-when-compile'). + not-unused warning about using variables with symbol names starting with _. + obsolete obsolete variables and functions. + redefine function name redefined from a macro to ordinary function or vice + versa, or redefined to take a different number of arguments. + suspicious constructs that usually don't do what the coder wanted. + unresolved calls to unknown functions. If the list begins with `not', then the remaining elements specify warnings to suppress. For example, (not free-vars) will suppress the `free-vars' warning. commit 115a940a4b1d28f18df5aa82a19fae9cbe67b869 Author: Jens Schmidt Date: Tue Sep 26 21:36:19 2023 +0200 Fix beginning-of-defun not jumping to BOF In batch mode or when font-lock and some other niceties are switched off, function `syntax-ppss' can modify match data held by function `beginning-of-defun-raw'. In that case, `beginning-of-defun' can jump to some seemingly arbitrary position, and not the actual BOF. * lisp/emacs-lisp/lisp.el (beginning-of-defun-raw): Save match data around a call to `syntax-ppss'. (Bug#66218) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index a4aa79c171e..ee481dc4ed3 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -422,7 +422,8 @@ beginning-of-defun-raw "\\(?:" defun-prompt-regexp "\\)\\s(") "^\\s(") nil 'move arg)) - (nth 8 (syntax-ppss)))) + (save-match-data + (nth 8 (syntax-ppss))))) found) (progn (goto-char (1- (match-end 0))) t))) commit 281258e5748385a01120cb3b7a90d9ce5f73e313 Author: Mauro Aranda Date: Sat Oct 7 11:57:18 2023 -0300 Fix saving faces with attributes that need filtering * lisp/cus-edit.el (custom-face-save): The :shown-value property for the custom-face widget is supposed to be a value suitable for the customization widget. (Bug#66391) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 1021707907d..706e08d5657 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4148,7 +4148,10 @@ custom-face-save ;; If recreating a widget that may have been edited by the user, remember ;; to always save the edited value into the :shown-value property, so ;; we use that value for the recreated widget. (Bug#44331) - (widget-put widget :shown-value (custom-face-widget-to-spec widget)) + (let ((child (car (widget-get widget :children)))) + (if (eq (widget-type child) 'custom-face-edit) + (widget-put widget :shown-value `((t ,(widget-value child)))) + (widget-put widget :shown-value (widget-value child)))) (custom-face-edit-all widget) (widget-put widget :shown-value nil) ; Reset it after we used it. (custom-face-mark-to-save widget) commit 1677a65554cf79fe4e12286796533a38a0e3baa7 Merge: 03f5a06a052 dc8b336d025 Author: Michael Albinus Date: Sat Oct 14 09:38:17 2023 +0200 Merge from origin/emacs-29 dc8b336d025 * lisp/files.el (file-name-non-special): Handle quoted ti... commit dc8b336d0254d751ffcb2466a20a650ca9c5f86a Author: Michael Albinus Date: Sat Oct 14 09:34:40 2023 +0200 * lisp/files.el (file-name-non-special): Handle quoted tilde. (Bug#65685) * test/lisp/files-tests.el (files-tests-file-name-non-special-expand-file-name-tilde): New test. diff --git a/lisp/files.el b/lisp/files.el index b72f141c0ee..8b5cb4964cc 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8185,13 +8185,12 @@ file-name-non-special ;; Get a list of the indices of the args that are file names. (file-arg-indices (cdr (or (assq operation - '(;; The first eight are special because they + '(;; The first seven are special because they ;; return a file name. We want to include ;; the /: in the return value. So just ;; avoid stripping it in the first place. (abbreviate-file-name) (directory-file-name) - (expand-file-name) (file-name-as-directory) (file-name-directory) (file-name-sans-versions) @@ -8200,6 +8199,10 @@ file-name-non-special ;; `identity' means just return the first ;; arg not stripped of its quoting. (substitute-in-file-name identity) + ;; `expand-file-name' shall do special case + ;; for the first argument starting with + ;; "/:~". (Bug#65685) + (expand-file-name expand-file-name) ;; `add' means add "/:" to the result. (file-truename add 0) ;;`insert-file-contents' needs special handling. @@ -8255,6 +8258,10 @@ file-name-non-special (let ((tramp-mode (and tramp-mode (eq method 'local-copy)))) (pcase method ('identity (car arguments)) + ('expand-file-name + (when (string-prefix-p "/:~" (car arguments)) + (setcar arguments (file-name-unquote (car arguments) t))) + (apply operation arguments)) ('add (file-name-quote (apply operation arguments) t)) ('buffer-file-name (let ((buffer-file-name (file-name-unquote buffer-file-name t))) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index aadb60e1de7..8f6495a293c 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -662,6 +662,23 @@ files-tests-file-name-non-special-expand-file-name (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (expand-file-name nospecial) nospecial)))) +(ert-deftest files-tests-file-name-non-special-expand-file-name-tilde () + (let ((process-environment + (cons (format "HOME=%s" temporary-file-directory) process-environment)) + abbreviated-home-dir) + (files-tests--with-temp-non-special (tmpfile nospecial) + (let (file-name-handler-alist) + (setq nospecial (file-name-quote (abbreviate-file-name tmpfile)))) + (should (equal (expand-file-name nospecial) + (expand-file-name (file-name-unquote nospecial t))))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (let (file-name-handler-alist) + (setq nospecial (file-name-quote (abbreviate-file-name tmpfile)))) + (should-not + (equal (expand-file-name nospecial) + ;; The file name handler deletes the ".special" extension. + (expand-file-name (file-name-unquote nospecial t))))))) + (ert-deftest files-tests-file-name-non-special-file-accessible-directory-p () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) (should (file-accessible-directory-p nospecial-dir))) commit 03f5a06a052ee0b4b8b77b4460ead717b87c4798 Author: Po Lu Date: Sat Oct 14 10:15:20 2023 +0800 Implement multi-window drag-and-drop under Android * java/org/gnu/emacs/EmacsNative.java (sendDndDrag, sendDndUri) (sendDndText): Declare new event-sending functions. * java/org/gnu/emacs/EmacsView.java (onDragEvent): New function. * java/org/gnu/emacs/EmacsWindow.java (onDragEvent): New function; respond to each drag and drop event, request permissions if necessary and transfer dropped data to Lisp. * lisp/dnd.el (dnd-unescape-file-uris): New variable. (dnd-get-local-file-name): If that variable is nil, refrain from unescaping URLs provided. * lisp/term/android-win.el (android-handle-dnd-event): New function. (special-event-map): Bind drag-n-drop-event. * src/android.c (sendDndDrag, sendDndUri, sendDndText): New functions. * src/androidgui.h (enum android_event_type): New event types ANDROID_DND_DRAG_EVENT, ANDROID_DND_URI_EVENT, ANDROID_DND_TEXT_EVENT. (struct android_dnd_event): New structure. (union android_event) : New field. * src/androidterm.c (handle_one_android_event) : Generate drag-n-drop events for each of these types. (syms_of_androidterm) : New defsyms. diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index d8524d92130..7d7e1e5d831 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -175,6 +175,17 @@ public static native long sendContextMenu (short window, int menuEventID, public static native long sendExpose (short window, int x, int y, int width, int height); + /* Send an ANDROID_DND_DRAG event. */ + public static native long sendDndDrag (short window, int x, int y); + + /* Send an ANDROID_DND_URI event. */ + public static native long sendDndUri (short window, int x, int y, + String text); + + /* Send an ANDROID_DND_TEXT event. */ + public static native long sendDndText (short window, int x, int y, + String text); + /* Return the file name associated with the specified file descriptor, or NULL if there is none. */ public static native byte[] getProcName (int fd); diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 877b1ce2429..2d53231fbf9 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -24,6 +24,7 @@ import android.text.InputType; import android.view.ContextMenu; +import android.view.DragEvent; import android.view.View; import android.view.KeyEvent; import android.view.MotionEvent; @@ -566,6 +567,19 @@ else if (child.getVisibility () != GONE) return window.onTouchEvent (motion); } + @Override + public boolean + onDragEvent (DragEvent drag) + { + /* Inter-program drag and drop isn't supported under Android 23 + and earlier. */ + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) + return false; + + return window.onDragEvent (drag); + } + private void diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 8d444aa27f5..3d2d86624a7 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -27,6 +27,8 @@ import java.util.LinkedHashMap; import java.util.Map; +import android.content.ClipData; +import android.content.ClipDescription; import android.content.Context; import android.graphics.Rect; @@ -34,12 +36,15 @@ import android.graphics.Bitmap; import android.graphics.PixelFormat; -import android.view.View; -import android.view.ViewManager; +import android.net.Uri; + +import android.view.DragEvent; import android.view.Gravity; +import android.view.InputDevice; import android.view.KeyEvent; import android.view.MotionEvent; -import android.view.InputDevice; +import android.view.View; +import android.view.ViewManager; import android.view.WindowManager; import android.util.Log; @@ -1560,4 +1565,131 @@ else if (EmacsWindow.this.isMapped) rect.width (), rect.height ()); } } + + + + /* Drag and drop. + + Android 7.0 and later permit multiple windows to be juxtaposed + on-screen, consequently enabling items selected from one window + to be dragged onto another. Data is transferred across program + boundaries using ClipData items, much the same way clipboard data + is transferred. + + When an item is dropped, Emacs must ascertain whether the clip + data represents plain text, a content URI incorporating a file, + or some other data. This is implemented by examining the clip + data's ``description'', which enumerates each of the MIME data + types the clip data is capable of providing data in. + + If the clip data represents plain text, then that text is copied + into a string and conveyed to Lisp code. Otherwise, Emacs must + solicit rights to access the URI from the system, absent which it + is accounted plain text and reinterpreted as such, to cue the + user that something has gone awry. + + Moreover, events are regularly sent as the item being dragged + travels across the frame, even if it might not be dropped. This + facilitates cursor motion and scrolling in response, as provided + by the options dnd-indicate-insertion-point and + dnd-scroll-margin. */ + + /* Register the drag and drop event EVENT. */ + + public boolean + onDragEvent (DragEvent event) + { + ClipData data; + ClipDescription description; + int i, x, y; + String type; + Uri uri; + EmacsActivity activity; + + x = (int) event.getX (); + y = (int) event.getY (); + + switch (event.getAction ()) + { + case DragEvent.ACTION_DRAG_STARTED: + /* Return true to continue the drag and drop operation. */ + return true; + + case DragEvent.ACTION_DRAG_LOCATION: + /* Send this drag motion event to Emacs. */ + EmacsNative.sendDndDrag (handle, x, y); + return true; + + case DragEvent.ACTION_DROP: + /* Judge whether this is plain text, or if it's a file URI for + which permissions must be requested. */ + + data = event.getClipData (); + description = data.getDescription (); + + /* If there are insufficient items within the clip data, + return false. */ + + if (data.getItemCount () < 1) + return false; + + /* Search for plain text data within the clipboard. */ + + for (i = 0; i < description.getMimeTypeCount (); ++i) + { + type = description.getMimeType (i); + + if (type.equals (ClipDescription.MIMETYPE_TEXT_PLAIN) + || type.equals (ClipDescription.MIMETYPE_TEXT_HTML)) + { + /* The data being dropped is plain text; encode it + suitably and send it to the main thread. */ + type = (data.getItemAt (0).coerceToText (EmacsService.SERVICE) + .toString ()); + EmacsNative.sendDndText (handle, x, y, type); + return true; + } + else if (type.equals (ClipDescription.MIMETYPE_TEXT_URILIST)) + { + /* The data being dropped is a list of URIs; encode it + suitably and send it to the main thread. */ + type = (data.getItemAt (0).coerceToText (EmacsService.SERVICE) + .toString ()); + EmacsNative.sendDndUri (handle, x, y, type); + return true; + } + else + { + /* If the item dropped is a URI, send it to the main + thread. */ + uri = data.getItemAt (0).getUri (); + + /* Attempt to acquire permissions for this URI; + failing which, insert it as text instead. */ + + if (uri.getScheme () != null + && uri.getScheme ().equals ("content") + && (activity = EmacsActivity.lastFocusedActivity) != null) + { + if (activity.requestDragAndDropPermissions (event) == null) + uri = null; + } + + if (uri != null) + EmacsNative.sendDndUri (handle, x, y, uri.toString ()); + else + { + type = (data.getItemAt (0) + .coerceToText (EmacsService.SERVICE) + .toString ()); + EmacsNative.sendDndText (handle, x, y, type); + } + + return true; + } + } + } + + return true; + } }; diff --git a/lisp/dnd.el b/lisp/dnd.el index 67907ec403e..14581e3d414 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -201,6 +201,11 @@ dnd-get-local-file-uri (string-equal sysname-no-dot hostname))) (concat "file://" (substring uri (+ 7 (length hostname)))))))) +(defvar dnd-unescape-file-uris t + "Whether to unescape file: URIs before they are opened. +Bind this to nil when providing `dnd-get-local-file-name' with a +file name that may incorporate URI escape sequences.") + (defun dnd--unescape-uri (uri) ;; Merge with corresponding code in URL library. (replace-regexp-in-string @@ -226,7 +231,10 @@ dnd-get-local-file-name 'utf-8 (or file-name-coding-system default-file-name-coding-system)))) - (and f (setq f (decode-coding-string (dnd--unescape-uri f) coding))) + (and f (setq f (decode-coding-string + (if dnd-unescape-file-uris + (dnd--unescape-uri f) f) + coding))) (when (and f must-exist (not (file-readable-p f))) (setq f nil)) f)) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index db873c176c8..f3f5c227df0 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -232,6 +232,64 @@ x-pointer-watch (defconst x-pointer-xterm 1008) (defconst x-pointer-invisible 0) + +;; Drag-and-drop. There are two formats of drag and drop event under +;; Android. The data field of the first is set to a cons of X and Y, +;; which represent a position within a frame that something is being +;; dragged over, whereas that of the second is a cons of either symbol +;; `uri' or `text' and a list of URIs or text to insert. +;; +;; If a content:// URI is encountered, then it in turn designates a +;; file within the special-purpose /content/by-authority directory, +;; which facilitates accessing such atypical files. + +(declare-function url-type "url-parse") +(declare-function url-host "url-parse") +(declare-function url-filename "url-parse") + +(defun android-handle-dnd-event (event) + "Respond to a drag-and-drop event EVENT. +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 reflects a list of URIs, then open each URI, converting +content:// URIs into the special file names which represent them." + (interactive "e") + (let ((message (caddr event)) + (posn (event-start event))) + (cond ((fixnump (car message)) + (dnd-handle-movement posn)) + ((eq (car message) 'text) + (let ((window (posn-window posn))) + (with-selected-window window + (unless mouse-yank-at-point + (goto-char (posn-point (event-start event)))) + (dnd-insert-text window 'copy (cdr message))))) + ((eq (car message) 'uri) + (let ((uri-list (split-string (cdr message) + "[\0\r\n]" t)) + (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)))) + (dnd-handle-one-url (posn-window posn) 'copy uri))))))) + +(define-key special-event-map [drag-n-drop] 'android-handle-dnd-event) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/android.c b/src/android.c index fa7bfe6c0f0..8c4748cccf6 100644 --- a/src/android.c +++ b/src/android.c @@ -2319,6 +2319,100 @@ NATIVE_NAME (sendExpose) (JNIEnv *env, jobject object, return event_serial; } +JNIEXPORT jboolean JNICALL +NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object, + jshort window, jint x, jint y) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + union android_event event; + + event.dnd.type = ANDROID_DND_DRAG_EVENT; + event.dnd.serial = ++event_serial; + event.dnd.window = window; + event.dnd.x = x; + event.dnd.y = y; + event.dnd.uri_or_string = NULL; + event.dnd.length = 0; + + android_write_event (&event); + return event_serial; +} + +JNIEXPORT jboolean JNICALL +NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object, + jshort window, jint x, jint y, + jstring string) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + union android_event event; + const jchar *characters; + jsize length; + uint16_t *buffer; + + event.dnd.type = ANDROID_DND_URI_EVENT; + event.dnd.serial = ++event_serial; + event.dnd.window = window; + event.dnd.x = x; + event.dnd.y = y; + + length = (*env)->GetStringLength (env, string); + buffer = malloc (length * sizeof *buffer); + characters = (*env)->GetStringChars (env, string, NULL); + + if (!characters) + /* The JVM has run out of memory; return and let the out of memory + error take its course. */ + return 0; + + memcpy (buffer, characters, length * sizeof *buffer); + (*env)->ReleaseStringChars (env, string, characters); + + event.dnd.uri_or_string = buffer; + event.dnd.length = length; + + android_write_event (&event); + return event_serial; +} + +JNIEXPORT jboolean JNICALL +NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object, + jshort window, jint x, jint y, + jstring string) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + union android_event event; + const jchar *characters; + jsize length; + uint16_t *buffer; + + event.dnd.type = ANDROID_DND_TEXT_EVENT; + event.dnd.serial = ++event_serial; + event.dnd.window = window; + event.dnd.x = x; + event.dnd.y = y; + + length = (*env)->GetStringLength (env, string); + buffer = malloc (length * sizeof *buffer); + characters = (*env)->GetStringChars (env, string, NULL); + + if (!characters) + /* The JVM has run out of memory; return and let the out of memory + error take its course. */ + return 0; + + memcpy (buffer, characters, length * sizeof *buffer); + (*env)->ReleaseStringChars (env, string, characters); + + event.dnd.uri_or_string = buffer; + event.dnd.length = length; + + android_write_event (&event); + return event_serial; +} + JNIEXPORT jboolean JNICALL NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, jobject object) diff --git a/src/androidgui.h b/src/androidgui.h index b58c39a5276..5fab5023ba4 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -248,6 +248,9 @@ #define PWinGravity (1L << 9) /* program specified window gravity */ ANDROID_CONTEXT_MENU, ANDROID_EXPOSE, ANDROID_INPUT_METHOD, + ANDROID_DND_DRAG_EVENT, + ANDROID_DND_URI_EVENT, + ANDROID_DND_TEXT_EVENT, }; struct android_any_event @@ -510,6 +513,28 @@ #define ANDROID_IS_MODIFIER_KEY(key) \ unsigned long counter; }; +struct android_dnd_event +{ + /* Type of the event. */ + enum android_event_type type; + + /* The event serial. */ + unsigned long serial; + + /* The window that gave rise to the event. */ + android_window window; + + /* X and Y coordinates of the event. */ + int x, y; + + /* Data tied to this event, such as a URI or clipboard string. + Must be deallocated with `free'. */ + unsigned short *uri_or_string; + + /* Length of that data. */ + size_t length; +}; + union android_event { enum android_event_type type; @@ -541,6 +566,11 @@ #define ANDROID_IS_MODIFIER_KEY(key) \ /* This is used to dispatch input method editing requests. */ struct android_ime_event ime; + + /* There is no analog under X because Android defines a strict DND + protocol, whereas there exist several competing X protocols + implemented in terms of X client messages. */ + struct android_dnd_event dnd; }; enum diff --git a/src/androidterm.c b/src/androidterm.c index ef3c20f4e0f..9d6517cce2b 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -1706,6 +1706,45 @@ handle_one_android_event (struct android_display_info *dpyinfo, goto OTHER; + case ANDROID_DND_DRAG_EVENT: + + if (!any) + goto OTHER; + + /* Generate a drag and drop event to convey its position. */ + inev.ie.kind = DRAG_N_DROP_EVENT; + XSETFRAME (inev.ie.frame_or_window, any); + inev.ie.timestamp = ANDROID_CURRENT_TIME; + XSETINT (inev.ie.x, event->dnd.x); + XSETINT (inev.ie.y, event->dnd.y); + inev.ie.arg = Fcons (inev.ie.x, inev.ie.y); + goto OTHER; + + case ANDROID_DND_URI_EVENT: + case ANDROID_DND_TEXT_EVENT: + + if (!any) + { + free (event->dnd.uri_or_string); + goto OTHER; + } + + /* An item was dropped over ANY, and is a file in the form of a + content or file URI or a string to be inserted. Generate an + event with this information. */ + + inev.ie.kind = DRAG_N_DROP_EVENT; + XSETFRAME (inev.ie.frame_or_window, any); + inev.ie.timestamp = ANDROID_CURRENT_TIME; + XSETINT (inev.ie.x, event->dnd.x); + XSETINT (inev.ie.y, event->dnd.y); + inev.ie.arg = Fcons ((event->type == ANDROID_DND_TEXT_EVENT + ? Qtext : Quri), + android_decode_utf16 (event->dnd.uri_or_string, + event->dnd.length)); + free (event->dnd.uri_or_string); + goto OTHER; + default: goto OTHER; } @@ -6593,6 +6632,10 @@ syms_of_androidterm (void) pdumper_do_now_and_after_load (android_set_build_fingerprint); DEFSYM (Qx_underline_at_descent_line, "x-underline-at-descent-line"); + + /* Symbols defined for DND events. */ + DEFSYM (Quri, "uri"); + DEFSYM (Qtext, "text"); } void commit 0dd7e6e3aeac1ab0a03f2ed2ad108deecde82447 Author: Eric Abrahamsen Date: Sat Sep 23 16:31:10 2023 -0700 Have gnus-summary-limit-to-age operate on calendar days Reported and patched by Łukasz Stelmach . * lisp/gnus/gnus-sum.el (gnus-summary-limit-to-age): Rather than 24-hour blocks. Also use `read-number', and drop the confusing option to reverse younger/older both with the prefix argument and with a negative number. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a3be5577f7a..f576d4e6147 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -8331,39 +8331,29 @@ gnus-summary-limit-to-predicate (defun gnus-summary-limit-to-age (age &optional younger-p) "Limit the summary buffer to articles that are older than (or equal) AGE days. -If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to -articles that are younger than AGE days." +Days are counted from midnight to midnight, and now to the +previous midnight counts as day one. If YOUNGER-P (the prefix) +is non-nil, limit the summary buffer to articles that are younger +than AGE days." (interactive - (let ((younger current-prefix-arg) - (days-got nil) - days) - (while (not days-got) - (setq days (if younger - (read-string "Limit to articles younger than (in days, older when negative): ") - (read-string - "Limit to articles older than (in days, younger when negative): "))) - (when (> (length days) 0) - (setq days (read days))) - (if (numberp days) - (progn - (setq days-got t) - (when (< days 0) - (setq younger (not younger)) - (setq days (* days -1)))) - (message "Please enter a number.") - (sleep-for 1))) + (let* ((younger current-prefix-arg) + (days (read-number + (if younger "Limit to articles younger than days: " + "Limit to articles older than days: ")))) (list days younger)) gnus-summary-mode) (prog1 - (let ((data gnus-newsgroup-data) - (cutoff (days-to-time age)) - articles d date is-younger) + (let* ((data gnus-newsgroup-data) + (now (append '(0 0 0) (cdddr (decode-time)))) + (delta (make-decoded-time :day (* -1 (- age 1)))) + (cutoff (encode-time (decoded-time-add now delta))) + articles d date is-younger) (while (setq d (pop data)) (when (and (mail-header-p (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) (setq is-younger (time-less-p - (time-since (gnus-date-get-time date)) - cutoff)) + cutoff + (gnus-date-get-time date))) (when (if younger-p is-younger (not is-younger)) commit 9ecb595dea56ed1149b60245d021cb5e6d7dd73f Author: Stefan Monnier Date: Fri Oct 13 19:28:30 2023 -0400 (sit-for): Remove support for old calling convention * lisp/subr.el (sit-for): Remove support for old calling convention * doc/lispref/functions.texi (Obsolete Functions): Adjust wording now that we don't support `sit-for`s old convention any more. * doc/lispref/commands.texi (Waiting): Remove mention of old calling convention for `sit-for`. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6601135cb85..fdf5ec1d7fe 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -3967,10 +3967,6 @@ Waiting In batch mode (@pxref{Batch Mode}), @code{sit-for} cannot be interrupted, even by input from the standard input descriptor. It is thus equivalent to @code{sleep-for}, which is described below. - -It is also possible to call @code{sit-for} with three arguments, -as @code{(sit-for @var{seconds} @var{millisec} @var{nodisp})}, -but that is considered obsolete. @end defun @defun sleep-for seconds &optional millisec diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 236b823e7e6..ba0d919549b 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2364,8 +2364,8 @@ Obsolete Functions (sit-for seconds milliseconds nodisp) @end example -However, calling @code{sit-for} this way is considered obsolete -(@pxref{Waiting}). The old calling convention is deprecated like +During a transition period, the function accepted those three +arguments, but declared this old calling convention as deprecated like this: @example diff --git a/etc/NEWS b/etc/NEWS index a8d028afc9d..3bd47a0112b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1022,6 +1022,9 @@ The compatibility aliases 'x-defined-colors', 'x-color-defined-p', ** 'easy-mmode-define-{minor,global}-mode' aliases are now obsolete. Use 'define-minor-mode' and 'define-globalized-minor-mode' instead. +** The obsolete calling convention of 'sit-for' has been removed. +That convention was: (sit-for SECONDS MILLISEC &optional NODISP) + * Lisp Changes in Emacs 30.1 diff --git a/lisp/subr.el b/lisp/subr.el index e88815fa58c..58274987d71 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3408,7 +3408,7 @@ read-char-choice-with-read-key (message "%s%s" prompt (char-to-string char)) char)) -(defun sit-for (seconds &optional nodisp obsolete) +(defun sit-for (seconds &optional nodisp) "Redisplay, then wait for SECONDS seconds. Stop when input is available. SECONDS may be a floating-point value. \(On operating systems that do not support waiting for fractions of a @@ -3417,29 +3417,11 @@ sit-for If optional arg NODISP is t, don't redisplay, just wait for input. Redisplay does not happen if input is available before it starts. -Value is t if waited the full time with no input arriving, and nil otherwise. - -An obsolete, but still supported form is -\(sit-for SECONDS &optional MILLISECONDS NODISP) -where the optional arg MILLISECONDS specifies an additional wait period, -in milliseconds; this was useful when Emacs was built without -floating point support." - (declare (advertised-calling-convention (seconds &optional nodisp) "22.1") - (compiler-macro - (lambda (form) - (if (not (or (numberp nodisp) obsolete)) form - (macroexp-warn-and-return - (format-message "Obsolete calling convention for `sit-for'") - `(,(car form) (+ ,seconds (/ (or ,nodisp 0) 1000.0)) ,obsolete) - '(obsolete sit-for)))))) +Value is t if waited the full time with no input arriving, and nil otherwise." ;; This used to be implemented in C until the following discussion: ;; https://lists.gnu.org/r/emacs-devel/2006-07/msg00401.html ;; Then it was moved here using an implementation based on an idle timer, ;; which was then replaced by the use of read-event. - (if (numberp nodisp) - (setq seconds (+ seconds (* 1e-3 nodisp)) - nodisp obsolete) - (if obsolete (setq nodisp obsolete))) (cond (noninteractive (sleep-for seconds) commit a5789198b34d83413674e596887c089a651f7cf4 Author: Harald Jörg Date: Sat Oct 14 00:48:23 2023 +0200 cperl-mode.el: Add new user option to etc/NEWS * etc/NEWS: Announce new user option `cperl-fontify-trailer'. diff --git a/etc/NEWS b/etc/NEWS index 0f9b5f98ebf..a8d028afc9d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -796,6 +796,13 @@ which makes them visually distinct from subroutine prototypes. CPerl mode supports the new keywords for exception handling and the object oriented syntax which were added in Perl 5.36 and 5.38. +*** New user option 'cperl-fontify-trailer'. +This user option takes the values "perl-code" or "comment" and treats +text after an "__END__" or "__DATA__" token accordingly. The default +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. + ** Emacs Sessions (Desktop) +++ commit 3a1fc816288131a877345cea0f73258652cb7f57 Author: Harald Jörg Date: Sat Oct 14 00:34:41 2023 +0200 cperl-mode.el: Optionally treat trailing text as comment * lisp/progmodes/cperl-mode.el (cperl-fontify-trailer): New customization variable. With a value of 'comment, cperl-mode treats trailing text after after __END__ and __DATA__ as comment, like perl-mode does (Bug#66161). (cperl-find-pods-heres): Treat trailing text after __END__ and __DATA__ according to the customization variable `cperl-fontify-trailer'. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-66161): New test, verifying the changed behavior if the custom variable is set to 'comment. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl: New resource file, source code from the corresponding bug report. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c2d9c0d6020..7b72e3baee5 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -550,6 +550,18 @@ cperl-file-style :version "29.1") ;;;###autoload(put 'cperl-file-style 'safe-local-variable 'stringp) +(defcustom cperl-fontify-trailer + 'perl-code + "How to fontify text after an \"__END__\" or \"__DATA__\" token. +If \"perl-code\", treat as Perl code for fontification, and +examine for imenu entries. Use this setting if you have trailing +POD documentation, or for modules which use AutoLoad or +AutoSplit. If \"comment\", treat as comment, and do not look for +imenu entries." + :type '(choice (const perl-code) + (const comment)) + :group 'cperl-faces) + (defcustom cperl-ps-print-face-properties '((font-lock-keyword-face nil nil bold shadow) (font-lock-variable-name-face nil nil bold) @@ -4913,8 +4925,9 @@ cperl-find-pods-heres ;; 1+6+2+1+1+6+1+1=19 extra () before this: ;; "__\\(END\\|DATA\\)__" ((match-beginning 20) ; __END__, __DATA__ - (setq bb (match-end 0)) - ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat + (if (eq cperl-fontify-trailer 'perl-code) + (setq bb (match-end 0)) + (setq bb (point-max))) (cperl-commentify b bb nil) (setq end t)) ;; "\\\\\\(['`\"($]\\)" diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl new file mode 100644 index 00000000000..e39cfdd3b24 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +print("Hello World\n"); + +__END__ + +TODO: +What's happening? + +It's all messed up. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 87d4f11280c..de7a614496f 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1403,6 +1403,20 @@ cperl-test-bug-66145 (cdr (assoc (match-string-no-properties 1) faces))))))))) +(ert-deftest cperl-test-bug-66161 () + "Verify that text after \"__END__\" is fontified as comment. +For `cperl-mode', this needs the custom variable +`cperl-fontify-trailer' to be set to `comment'. Per default, +cperl-mode fontifies text after the delimiter as Perl code." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-66161.pl")) + (setq cperl-fontify-trailer 'comment) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward "TODO") ; leaves point before the colon + (should (equal (get-text-property (point) 'face) + font-lock-comment-face)))) + (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) commit baf778c7caa0908789de7740aad719e168fffdf6 Author: Mauro Aranda Date: Fri Oct 13 10:36:29 2023 -0300 More defcustom fixes in ERC (Bug#66520) * lisp/erc/erc-fill.el (erc-fill-variable-maximum-indentation): Change :type to choice, to allow nil. * lisp/erc/erc-goodies.el (erc-keep-place-indicator-style): Fix copy-pasta. * lisp/erc/erc-networks.el (erc-networks-alist): Don't advertise that MATCHER can be a function since it doesn't look like that's ever been the case, reaching as far back as erc-networks.el's introduction to the old CVS repo, in 2006. (Bug#66520) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 58aab176b66..0048956e075 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -112,7 +112,8 @@ erc-fill-static-center (defcustom erc-fill-variable-maximum-indentation 17 "Don't indent a line after a long nick more than this many characters. Set to nil to disable." - :type 'integer) + :type '(choice (const :tag "Disable" nil) + integer)) (defcustom erc-fill-column 78 "The column at which a filled paragraph is broken." diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 0c616676841..9d70c644429 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -292,7 +292,9 @@ erc-keep-place-indicator-style appropriate line. A value of t does both." :group 'erc :package-version '(ERC . "5.6") ; FIXME sync on release - :type '(choice (const t) (const server) (const target))) + :type '(choice (const :tag "Use arrow" arrow) + (const :tag "Use face" face) + (const :tag "Use both arrow and face" t))) (defcustom erc-keep-place-indicator-buffer-type t "ERC buffer type in which to display `keep-place-indicator'. diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index ba7990e87d6..d73d715db2c 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -756,9 +756,8 @@ erc-networks-alist Each network is a list (NET MATCHER) where NET is a symbol naming that IRC network and MATCHER is used to find a corresponding network to a server while - connected to it. If it is regexp, it's used to match against - `erc-server-announced-name'. It can also be a function (predicate). - Then it is executed with the server buffer as current buffer." +connected to it. If it is a regexp, it's used to match against +`erc-server-announced-name'." :type '(repeat (list :tag "Network" (symbol :tag "Network name") commit 52af0a5fb97bd80f8c683f1286cdb33b319add2e Author: F. Jason Park Date: Thu Sep 21 06:54:27 2023 -0700 Add command to refill buffer in erc-fill-wrap-mode * lisp/erc/erc-fill.el (erc-fill-function, erc-fill-wrap-mode): Mention new command `erc-fill-wrap-refill-buffer' in doc string. (erc-fill--wrap-rejigger-last-message): New internal variable. (erc-fill--wrap-rejigger-region, erc-fill-wrap-refill-buffer): New command and helper function for fixing alignment issues that arise, for example, from adjusting pixel-display widths of buffer text during a session. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--simulate-refill): New function for approximating `erc-fill-wrap-refill-buffer'. (erc-fill-wrap--merge): Assert refilling is idempotent. (Bug#60936) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 3f5c8377868..58aab176b66 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -86,10 +86,12 @@ erc-fill-function A third style resembles static filling but \"wraps\" instead of fills, thanks to `visual-line-mode' mode, which ERC automatically -enables when this option is `erc-fill-wrap' or when -`erc-fill-wrap-mode' is active. Set `erc-fill-static-center' to -your preferred initial \"prefix\" width. For adjusting the width -during a session, see the command `erc-fill-wrap-nudge'." +enables when this option is `erc-fill-wrap' or when the module +`fill-wrap' is active. Use `erc-fill-static-center' to specify +an initial \"prefix\" width and `erc-fill-wrap-margin-width' +instead of `erc-fill-column' for influencing initial message +width. For adjusting these during a session, see the commands +`erc-fill-wrap-nudge' and `erc-fill-wrap-refill-buffer'." :type '(choice (const :tag "Variable Filling" erc-fill-variable) (const :tag "Static Filling" erc-fill-static) (const :tag "Dynamic word-wrap" erc-fill-wrap) @@ -403,15 +405,19 @@ erc-fill--wrap-ensure-dependencies (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'. 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. Once active, use +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. Once 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. Also see related options `erc-fill-line-spacing' and -`erc-fill-wrap-merge'. +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-line-spacing' and `erc-fill-wrap-merge'. This module imposes various restrictions on the appearance of timestamps. Most notably, it insists on displaying them in the @@ -565,6 +571,78 @@ erc-fill-wrap 'erc-fill--wrap-value)) wrap-prefix (space :width erc-fill--wrap-value)))))) +(defvar erc-fill--wrap-rejigger-last-message nil + "Temporary working instance of `erc-fill--wrap-last-msg'.") + +(defun erc-fill--wrap-rejigger-region (start finish on-next repairp) + "Recalculate `line-prefix' from START to FINISH. +After refilling each message, call ON-NEXT with no args. But +stash and restore `erc-fill--wrap-last-msg' before doing so, in +case this module's insert hooks run by way of the process filter. +With REPAIRP, destructively fill gaps and re-merge speakers." + (goto-char start) + (cl-assert (null erc-fill--wrap-rejigger-last-message)) + (let (erc-fill--wrap-rejigger-last-message) + (while-let + (((< (point) finish)) + (beg (if (get-text-property (point) 'line-prefix) + (point) + (next-single-property-change (point) 'line-prefix))) + (val (get-text-property beg 'line-prefix)) + (end (text-property-not-all beg finish 'line-prefix val))) + ;; If this is a left-side stamp on its own line. + (remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil)) + (when-let ((repairp) + (dbeg (text-property-not-all beg end 'display nil)) + ((get-text-property (1+ dbeg) 'erc-speaker)) + (dval (get-text-property dbeg 'display)) + ((equal "" dval))) + (remove-text-properties + dbeg (text-property-not-all dbeg end 'display dval) '(display))) + (let* ((pos (if (eq 'date-left (get-text-property beg 'erc-stamp-type)) + (field-beginning beg) + beg)) + (erc--msg-props (map-into (text-properties-at pos) 'hash-table)) + (erc-stamp--current-time (gethash 'erc-ts erc--msg-props))) + (save-restriction + (narrow-to-region beg (1+ end)) + (let ((erc-fill--wrap-last-msg erc-fill--wrap-rejigger-last-message)) + (erc-fill-wrap) + (setq erc-fill--wrap-rejigger-last-message + erc-fill--wrap-last-msg)))) + (when on-next + (funcall on-next)) + ;; Skip to end of message upon encountering accidental gaps + ;; introduced by third parties (or bugs). + (if-let (((/= ?\n (char-after end))) + (next (erc--get-inserted-msg-bounds 'end beg))) + (progn + (cl-assert (= ?\n (char-after next))) + (when repairp ; eol <= next + (put-text-property end (pos-eol) 'line-prefix val)) + (goto-char next)) + (goto-char end))))) + +(defun erc-fill-wrap-refill-buffer (repair) + "Recalculate all `fill-wrap' prefixes in the current buffer. +With REPAIR, attempt to refresh \"speaker merges\", which may be +necessary after revealing previously hidden text with commands +like `erc-match-toggle-hidden-fools'." + (interactive "P") + (unless erc-fill-wrap-mode + (user-error "Module `fill-wrap' not active in current buffer.")) + (save-excursion + (with-silent-modifications + (let* ((rep (make-progress-reporter + "Rewrap" 0 (line-number-at-pos erc-insert-marker) 1)) + (seen 0) + (callback (lambda () + (progress-reporter-update rep (cl-incf seen)) + (accept-process-output nil 0.000001)))) + (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker + callback repair) + (progress-reporter-done rep))))) + ;; FIXME use own text property to avoid false positives. (defun erc-fill--wrap-merged-button-p (point) (equal "" (get-text-property point 'display))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 8f0c8f9ccf4..f6c4c268017 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -234,6 +234,13 @@ erc-fill-wrap--monospace (erc-fill-tests--wrap-check-prefixes "*** " " " " ") (erc-fill-tests--compare "monospace-04-reset"))))) +(defun erc-fill-tests--simulate-refill () + ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without + ;; a progress reporter. + (save-excursion + (with-silent-modifications + (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker nil nil)))) + (ert-deftest erc-fill-wrap--merge () :tags '(:unstable) (unless (>= emacs-major-version 29) @@ -245,7 +252,9 @@ erc-fill-wrap--merge (erc-update-channel-member "#chan" "Dummy" "Dummy" t nil nil nil nil nil "fake" "~u" nil nil t) - ;; Set this here so that the first few messages are from 1970 + ;; Set this here so that the first few messages are from 1970. + ;; Following the current date stamp, the speaker isn't merged + ;; even though it's continued: " zero." (let ((erc-fill-tests--time-vals (lambda () 1680332400))) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "alice" "one.") @@ -267,7 +276,12 @@ erc-fill-wrap--merge (erc-fill-tests--wrap-check-prefixes "*** " " " " " " " " " " " " " " " " " " ") - (erc-fill-tests--compare "merge-02-right"))))) + (erc-fill-tests--compare "merge-02-right") + + (ert-info ("Command `erc-fill-wrap-refill-buffer' is idempotent") + (kill-buffer (pop erc-fill-tests--buffers)) + (erc-fill-tests--simulate-refill) ; idempotent + (erc-fill-tests--compare "merge-02-right")))))) (ert-deftest erc-fill-wrap--merge-action () :tags '(:unstable) commit f8af241192bc6ecff694f1c98002c353a06df4b0 Author: F. Jason Park Date: Mon Oct 9 02:29:44 2023 -0700 Treat previous/next-line specially in erc-fill-wrap * lisp/erc/erc-fill.el (erc-fill-wrap-visual-keys): Mention option `erc-fill-wrap-force-screen-line-movement' in doc string. (erc-fill-wrap-force-screen-line-movement): New option to suppress logical-line movement with `previous-line' and `next-line' when `erc-fill-wrap-mode' is enabled. (erc-fill--wrap-move): Accept trailing args. (erc-fill--wrap-previous-line, erc-fill--wrap-next-line): Use `erc-fill--wrap-move', like all the other `fill-wrap' commands. (Bug#60936) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 4ec58fcb96f..3f5c8377868 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -238,11 +238,23 @@ erc-fill-wrap-visual-keys `visual-line-mode' everywhere in an ERC buffer along with visual editing commands in the input area. A value of nil means to never do so. A value of `non-input' tells ERC to act like the -value is nil in the input area and t elsewhere. This option only -plays a role when `erc-fill-wrap-mode' is enabled." +value is nil in the input area and t elsewhere. See related +option `erc-fill-wrap-force-screen-line-movement' for behavior +involving `next-line' and `previous-line'." :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) (const t) (const non-input))) +(defcustom erc-fill-wrap-force-screen-line-movement '(non-input) + "Exceptions for vertical movement by logical line. +Including a symbol known to `erc-fill-wrap-visual-keys' in this +set tells `next-line' and `previous-line' to move vertically by +screen line even if the current `erc-fill-wrap-visual-keys' value +would normally do otherwise. For example, setting this to +\\='(nil non-input) disables logical-line movement regardless of +the value of `erc-fill-wrap-visual-keys'." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type '(set (const nil) (const non-input))) + (defcustom erc-fill-wrap-merge t "Whether to consolidate messages from the same speaker. This tells ERC to omit redundant speaker labels for subsequent @@ -250,13 +262,13 @@ erc-fill-wrap-merge :package-version '(ERC . "5.6") ; FIXME sync on release :type 'boolean) -(defun erc-fill--wrap-move (normal-cmd visual-cmd arg) - (funcall (pcase erc-fill--wrap-visual-keys - ('non-input - (if (>= (point) erc-input-marker) normal-cmd visual-cmd)) - ('t visual-cmd) - (_ normal-cmd)) - arg)) +(defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args) + (apply (pcase erc-fill--wrap-visual-keys + ('non-input + (if (>= (point) erc-input-marker) normal-cmd visual-cmd)) + ('t visual-cmd) + (_ normal-cmd)) + args)) (defun erc-fill--wrap-kill-line (arg) "Defer to `kill-line' or `kill-visual-line'." @@ -287,17 +299,23 @@ erc-fill--wrap-beginning-of-line (defun erc-fill--wrap-previous-line (&optional arg try-vscroll) "Move to ARGth previous logical or screen line." (interactive "^p\np") - (if erc-fill--wrap-visual-keys - (with-no-warnings (previous-line arg try-vscroll)) - (prog1 (previous-logical-line arg try-vscroll) - (erc-fill--wrap-escape-hidden-speaker)))) + ;; Return value seems undefined but preserve anyway just in case. + (prog1 + (let ((visp (memq erc-fill--wrap-visual-keys + erc-fill-wrap-force-screen-line-movement))) + (erc-fill--wrap-move (if visp #'previous-line #'previous-logical-line) + #'previous-line + arg try-vscroll)) + (erc-fill--wrap-escape-hidden-speaker))) (defun erc-fill--wrap-next-line (&optional arg try-vscroll) "Move to ARGth next logical or screen line." (interactive "^p\np") - (if erc-fill--wrap-visual-keys - (with-no-warnings (next-line arg try-vscroll)) - (next-logical-line arg try-vscroll))) + (let ((visp (memq erc-fill--wrap-visual-keys + erc-fill-wrap-force-screen-line-movement))) + (erc-fill--wrap-move (if visp #'next-line #'next-logical-line) + #'next-line + arg try-vscroll))) (defun erc-fill--wrap-end-of-line (arg) "Defer to `move-end-of-line' or `end-of-visual-line'." commit 5e2be1e0ba64f030b8493d3e7b93b69caba3a254 Author: F. Jason Park Date: Tue Oct 10 00:32:21 2023 -0700 Swap hook positions of erc-fill and erc-match-message * etc/ERC-NEWS: Fix new order of reserved modify-hook members. * lisp/erc/erc-fill.el: Increase depth of `erc-fill' in both modify hooks from 40 to 60. * lisp/erc/erc-match.el (erc-match-mode, erc-match-enable, erc-match-disable): Use general module setup function `erc-match--setup' for buffer-local modifications instead of calling `erc-match--modify-invisibility-spec' directly. Add and remove new post-modify hook `erc-match--on-insert-post'. (erc-hide-fools): Use `erc--msg-props' for communicating to post-processing step for applying invisible props instead of doing so immediately. (erc-match--on-insert-post): New function to apply module-specific `invisible' props. Will likely be replaced by a general service to do the same, perhaps provided by a future "erc-ignore"-like module. (erc-match--modify-invisibility-spec, erc-match--setup): Rename former to latter and only operate on current buffer. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--stamp-left-fools-invisible, erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-right-invisible-fill-wrap, erc-scenarios-match--stamp-both-invisible-fill-static): Update expected order of ERC-owned `invisible' prop members `match-fools' and `timestamp'. * test/lisp/erc/erc-tests.el (erc--essential-hook-ordering): Swap expected order of `erc-fill' and `erc-add-timestamp' in both hooks. (Bug#64301) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 1861e488288..2e56539f210 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -276,13 +276,12 @@ essential members of important hooks. Luckily, ERC now leverages a feature introduced in Emacs 27, "hook depth," to secure the positions of a few key members of 'erc-insert-modify-hook' and 'erc-send-modify-hook'. So far, this -includes the functions 'erc-button-add-buttons', 'erc-fill', -'erc-match-message', and 'erc-add-timestamp', which now appear in that -order, 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 two, 'erc-button-add-buttons' and 'erc-fill', which have -been swapped with respect to their previous places in recent ERC -versions. +includes the functions 'erc-button-add-buttons', 'erc-match-message', +'erc-fill', and 'erc-add-timestamp', which now appear in that order, +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). ERC also provisionally reserves the same depth interval for 'erc-insert-pre-hook' and possibly other, similar hooks, but will diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 5ab5d73d9f2..4ec58fcb96f 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -49,8 +49,8 @@ fill ;; other modules. Ideally, this module's processing should happen ;; after "morphological" modifications to a message's text but ;; before superficial decorations. - ((add-hook 'erc-insert-modify-hook #'erc-fill 40) - (add-hook 'erc-send-modify-hook #'erc-fill 40)) + ((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) (remove-hook 'erc-send-modify-hook #'erc-fill))) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 50db8a132ec..186717579d7 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -53,13 +53,14 @@ match you can decide whether the entire message or only the sending nick is highlighted." ((add-hook 'erc-insert-modify-hook #'erc-match-message 50) - (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec) - (unless erc--updating-modules-p - (erc-buffer-do #'erc-match--modify-invisibility-spec)) + (add-hook 'erc-mode-hook #'erc-match--setup) + (unless erc--updating-modules-p (erc-buffer-do #'erc-match--setup)) + (add-hook 'erc-insert-post-hook #'erc-match--on-insert-post 50) (erc--modify-local-map t "C-c C-k" #'erc-go-to-log-matches-buffer)) ((remove-hook 'erc-insert-modify-hook #'erc-match-message) - (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec) - (erc-match--modify-invisibility-spec) + (remove-hook 'erc-insert-post-hook #'erc-match--on-insert-post) + (remove-hook 'erc-mode-hook #'erc-match--setup) + (erc-buffer-do #'erc-match--setup) (erc--modify-local-map nil "C-c C-k" #'erc-go-to-log-matches-buffer))) ;; Remaining customizations @@ -657,7 +658,20 @@ erc-go-to-log-matches-buffer (defun erc-hide-fools (match-type _nickuserhost _message) "Hide comments from designated fools." - (when (eq match-type 'fool) + (when (and erc--msg-props (eq match-type 'fool)) + (puthash 'erc--invisible 'erc-match-fool erc--msg-props))) + +;; FIXME remove, make public, or only add locally. +;; +;; ERC modules typically don't add internal functions to public hooks +;; globally. However, ERC 5.6 will likely include a general +;; (internal) facility for adding invisible props, which will obviate +;; the need for this function. IOW, leaving this internal for now is +;; an attempt to avoid the hassle of the deprecation process. +(defun erc-match--on-insert-post () + "Hide messages marked with the `erc--invisible' prop." + (when (erc--check-msg-prop 'erc--invisible 'erc-match-fool) + (remhash 'erc--invisible erc--msg-props) (erc--hide-message 'match-fools))) (defun erc-beep-on-match (match-type _nickuserhost _message) @@ -666,14 +680,13 @@ erc-beep-on-match (when (member match-type erc-beep-match-types) (beep))) -(defun erc-match--modify-invisibility-spec () +(defun erc-match--setup () "Add an `erc-match' property to the local spec." ;; Hopefully, this will be extended to do the same for other ;; invisible properties managed by this module. (if erc-match-mode (erc-match-toggle-hidden-fools +1) - (erc-with-all-buffers-of-server nil nil - (erc-match-toggle-hidden-fools -1)))) + (erc-match-toggle-hidden-fools -1))) (defun erc-match-toggle-hidden-fools (arg) "Toggle fool visibility. diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 3da55572cf7..17f7649566e 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -134,7 +134,7 @@ erc-scenarios-match--stamp-left-fools-invisible ;; Leading stamp has combined `invisible' property value. (should (equal (get-text-property (pos-bol) 'invisible) - '(timestamp match-fools))) + '(match-fools timestamp))) ;; Message proper has the `invisible' property `match-fools'. (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) @@ -168,7 +168,7 @@ erc-scenarios-match--stamp-right-fools-invisible ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- end) 'invisible) - '(timestamp match-fools))) + '(match-fools timestamp))) ;; The final newline is hidden by `match', not `stamps' (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) @@ -184,7 +184,7 @@ erc-scenarios-match--stamp-right-fools-invisible ;; It ends just before the timestamp. (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) (should (equal (get-text-property msg-end 'invisible) - '(timestamp match-fools))) + '(match-fools timestamp))) ;; Stamp's `invisible' property extends throughout the stamp ;; and ends before the trailing newline. @@ -230,7 +230,7 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- (pos-eol)) 'invisible) - '(timestamp match-fools))) + '(match-fools timestamp))) ;; The message proper has the `invisible' property `match-fools', ;; which starts at the preceding newline... @@ -239,7 +239,7 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap ;; ... and ends just before the timestamp. (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) (should (equal (get-text-property msgend 'invisible) - '(timestamp match-fools))) + '(match-fools timestamp))) ;; The newline before `erc-insert-marker' is still visible. (should-not (get-text-property (pos-eol) 'invisible)) @@ -350,7 +350,7 @@ erc-scenarios-match--hide-fools/stamp-both/fill-wrap (let ((msgend (next-single-property-change (pos-bol) 'invisible))) ;; Stamp has a combined `invisible' property value. (should (equal (get-text-property msgend 'invisible) - '(timestamp match-fools))) + '(match-fools timestamp))) ;; Combined `invisible' property spans entire timestamp. (should (= (next-single-property-change msgend 'invisible) @@ -492,7 +492,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static (let ((msgend (next-single-property-change (pos-bol) 'invisible))) ;; Stamp has a combined `invisible' property value. (should (equal (get-text-property msgend 'invisible) - '(timestamp match-fools))) + '(match-fools timestamp))) ;; Combined `invisible' property spans entire timestamp. (should (= (next-single-property-change msgend 'invisible) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 39135a8c2df..4f4662f5075 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2455,14 +2455,14 @@ erc--essential-hook-ordering '( :erc-insert-modify-hook (erc-controls-highlight ; 0 erc-button-add-buttons ; 30 - erc-fill ; 40 erc-match-message ; 50 - erc-add-timestamp) ; 60 + erc-fill ; 60 + erc-add-timestamp) ; 70 :erc-send-modify-hook ( erc-controls-highlight ; 0 erc-button-add-buttons ; 30 erc-fill ; 40 - erc-add-timestamp)))) ; 50 + erc-add-timestamp)))) ; 70 (ert-deftest erc-migrate-modules () (should (equal (erc-migrate-modules '(autojoin timestamp button)) commit c68dc7786fc808b1ff7deb32d9964ae860e26f1e Author: F. Jason Park Date: Thu Sep 21 23:54:31 2023 -0700 Manage some text props for ERC insertion-hook members * etc/ERC-NEWS: Mention that ERC only adds the text property `cursor-sensor-functions' when `erc-echo-timestamps' is enabled. Also mention that date stamps are now inserted as separate messages. * lisp/erc/erc-fill.el (erc-fill): Look for text prop `erc-cmd' instead of `erc-command' and use helper utility to do so. (erc-fill-static): Skip date stamps because this fill style leaves them flush left. (erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): Don't hook on the soon-to-be-removed function interface `erc-stamp--insert-date-function' because date stamps are now separate messages. (erc-fill--wrap-continued-message-p): Restore accidentally discarded doc string. Derive context about current message from text props at `point-min', and use updated property names and utility functions. Abort when previous message is now hidden. (erc-fill--wrap-stamp-insert-prefixed-date): Remove unused function, originally meant to be new in ERC 5.6, and move logic for date-stamp measuring portion directly to `erc-fill-wrap' itself. (erc-fill--wrap-measure): New helper function. (erc-fill-wrap): Use helper `erc-fill--wrap-measure' and incorporate date-stamp detection and width measuring from removed helper. Don't dedent first word for messages of unknown origin, such as those inserted by `erc-display-line' alone without prior preparation from `erc-display-message'. * lisp/erc/erc-goodies.el (erc-readonly-mode, erc-readonly-enable): Set hook depth explicitly to 70. * lisp/erc/erc-stamp.el (erc-timestamp-format-left): Mention that a trailing newline is implicit if not provided and that users who don't want date stamps should use `erc-timestamp-format-right' instead. (erc-stamp-mode, erc-stamp-enable): Call `erc-stamp--setup' instead of `erc-munge-invisibility-spec', and bump hook depth for `erc-add-timestamp' to 70. (erc-stamp--current-time): Use `erc-ts' instead of `erc-timestamp' text property in doc string. (erc-stamp--skip): New internal variable. (erc-stamp--allow-unmanaged): New variable for legacy code to force `erc-add-timestamps' to run when `erc--msg-props' is nil. (erc-add-timestamp): Always run when `erc-stamp--allow-unmanaged' is non-nil unless `erc-stamp--skip' is as well because the latter takes precedence. Don't add `erc-ts' text prop directly unless `erc-stamp--allow-unmanaged is non-nil. Instead, use the new `erc--msg-props' facility to defer until after modification hooks. Likewise, don't add `cursor-senor-functions' directly either unless the same compatibility flag is enabled. Instead, expect the latter to be handled by a post-modify hook conditioned on the option `erc-echo-timestamps'. (erc-timestamp-last-inserted-left): Mention that the final trailing newline specified in the format string no longer appears in the recorded value. (erc-stamp-prefix-log-filter): Use updated name for timestamp property as well as helper utility for accessing it. (erc-stamp--inherited-props): Add doc string. (erc-insert-timestamp-right): Fix bug involving object cycle where the time-stamp string would appear in its own `display' property. (erc-stamp--insert-date-function, erc-stamp--insert-date-hook): Remove unused internal function-valued interface variable and replace with the latter, a normal hook. (erc-stamp--date-format-end, erc-stamp--propertize-left-date-stamp): New function and auxiliary variable to apply date stamp properties at the post-modify stage. Add text property `erc-stamp-type' to inserted date stamps to help folks distinguish between them and other left-sided stamps. (erc-stamp--current-datestamp-left, erc-stamp--format-date-stamp, erc-stamp--insert-date-stamp-as-phony-message, erc-stamp--lr-date-on-pre-modify): New functions and state variable to help ERC treat date stamps as separate messages while working within the established mechanism for processing inserted messages. Shadow `erc-stamp--invisible-property' when calling `erc-format-timestamp' in order to prevent date stamps from inheriting other `invisible' props. These date stamps are special in that they have no business being hidden along with the current message. (erc-insert-timestamp-left-and-right): On initial run in any buffer, remember whether the date stamp needed newline massaging on insertion. Move all business for inserting date stamps to post-modify hooks, but run them forcibly if this is the very first date stamp in the current buffer. Also mention some specifics related to relevant text props in the doc string. (erc-format-timestamp): Don't add `invisible' prop to stamp unless `erc-stamp--invisible-property' is non-nil. (erc-stamp--csf-props-updated-p): New local variable. (erc-munge-invisibility-spec): Restore `cursor-sensor-functions' text property for existing messages when a user enables the option mid-session. Add and remove hooks for use with automatic timestamp echoing. (erc-stamp--add-csf-on-post-modify): New function to add `cursor-sensor-functions' property on post-modify hooks. (erc-stamp--setup): Perform some additional teardown. (erc-stamp--on-clear-message): Look for text property `erc-ts' instead of `erc-timestamp'. (erc-echo-timestamp, erc--echo-ts-csf): Use utility to find time-stamp text prop in current message. (erc-stamp--update-saved-position, erc-stamp--reset-on-clear): Use hook `erc-stamp--insert-date-hook' instead of excised function-valued variable interface `erc-stamp--insert-date-function'. * lisp/erc/erc-truncate.el (erc-truncate-buffer-to-size): Use internal utility to find beginning of message. * lisp/erc/erc.el (erc--msg-props, erc--msg-props-overrides): New internal variables for initializing and conveying metadata-oriented text properties among insert and send hooks. (erc-insert-modify-hook): Mention reserved depth ranges for built-in members in doc string. (erc-send-action): Use convenience variable to modifying text props instead of awkwardly overriding `erc-insert-pre-hook'. (erc--check-msg-prop, erc--get-inserted-msg-bounds, erc--get-inserted-msg-prop, erc--with-inserted-msg, erc--traverse-inserted): New utility functions and macros to help modules find metadata and message-delimiting text props. (erc-display-line-1): Ensure the first character of every message in an ERC buffer has the `erc-msg' property, as well as any other props in `erc--msg-props', when populated. (erc--hide-message): Don't bother offsetting start of first message in a buffer. (erc--ranked-properties, erc--order-text-properties-from-hash): New variable and function to convert `erc--msg-props' into a plist suitable for `add-text-properties'. (erc-display-message): Make doc string more informative. Bind and initialize `erc--msg-props' for use by all hooks. Respect `erc--msg-prop-overrides' when non-nil. Don't add `erc-command' property. Instead, ensure `erc--msg-props' contains an `erc-cmd' item when the parameter PARSED is non-nil. (erc--own-property-names): Add `erc-stamp-type'. (erc--get-speaker-bounds): Use helper to find message start. (erc-process-ctcp-query, erc-send-current-line): Use convenience variable to leverage framework for manipulating message metadata instead of overriding `erc-insert-pre-hook'. (erc-display-msg): Bind `erc--msg-props' for use by all send-related hooks. Add text props from table after `erc-send-post-hook'. (erc-restore-text-properties): Improve doc string. (erc--get-eq-comparable-cmd): Use `if-let' instead of `if-let*'. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--insert-privmsg): Make phony message more realistic. (erc-fill-tests--wrap-populate): Shorten overlong line. (erc-fill-tests--wrap-check-prefixes): Make test utility more vigilant in asserting no gaps exist in `line-prefix' property interval. (erc-fill-tests--compare): Compare text props on text-prop values that are themselves strings. * test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp): Ensure `erc-stamp' is loaded. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--stamp-left-current-nick, erc-scenarios-match--invisible-stamp): Use `default-value' for `erc-insert-modify-hook' in ordering assertion. (erc-scenarios-match--find-bol, erc-scenarios-match--find-eol): Remove unused assertion helper functions. (erc-scenarios-match--stamp-right-fools-invisible): Remove misplaced ERT tag from function and use utility to find message bounds. (erc-scenarios-match--stamp-right-fools-invisible): Use real utility from main library to find message end. (erc-scenarios-match--fill-wrap-stamp-dedented-p): New assertion utility function. (erc-scenarios-match--hide-fools/stamp-both/fill-wrap) New test. (erc-scenarios-match--hide-fools/stamp-both/fill-wrap/speak): New test. (erc-scenarios-match--stamp-both-invisible-fill-static): Expect `erc-cmd' at beginning of inserted message's filled line, even if the line starts with white space. Also, add new function parameter `assert-ds', a callback to run when visiting the second date stamp, which is followed by a hidden message. In the test of the same name, expect the date stamp's invisibility interval to begin at the newline after the previous message and to not contain any existing invisibility props, namely, those belonging to the subsequent hidden "fools" message. Also use shortened "metadata" text prop names. (erc-scenarios-match--stamp-both-invisible-fill-static--nooffset): Expect the date stamp's invisibility interval to match its field's instead of starting and ending sooner. * test/lisp/erc/erc-stamp-tests.el: Put well-known metadata prop at the start of the message. * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Prevent modules from mutating hooks. (erc--order-text-properties-from-hash, erc--check-msg-prop): New tests. * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update test data. * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update test data. * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update. * test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Update. * test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Update. * test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Update. * test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Update. * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update. * test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: Update. * test/lisp/erc/resources/match/fools/fill-wrap.eld: New file. (Bug#60936) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 7c287b9de23..1861e488288 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -149,7 +149,7 @@ minor-mode maps, and new third-party modules should do the same. ** Option 'erc-timestamp-format-right' deprecated. Having to account for this option prevented other ERC modules from -easily determining what right-hand stamps would look like before +easily determining what right-sided stamps would look like before insertion, which is knowledge needed for certain UI decisions. The way ERC has chosen to address this is imperfect and boils down to asking users who've customized this option to switch to @@ -290,11 +290,13 @@ continue to modify non-ERC hooks locally whenever possible, especially in new code. *** ERC now manages timestamp-related properties a bit differently. -For starters, the 'cursor-sensor-functions' property no longer +For starters, the 'cursor-sensor-functions' text property is absent by +default unless the option 'erc-echo-timestamps' is already enabled on +module init. And when present, the property's value no longer contains unique closures and thus no longer proves effective for -traversing messages. To compensate, a new property, 'erc-timestamp', -now spans message bodies but not the newlines delimiting them. Also -affecting the 'stamp' module is the deprecation of the function +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. @@ -309,6 +311,23 @@ folded onto the next line. Such inconsistency made stamp detection overly complex and produced uneven results when toggling stamp visibility. +*** Date stamps are independent messages. +ERC now inserts "date stamps" generated from the option +'erc-timestamp-format-left' as separate, standalone messages. (This +only matters if 'erc-insert-timestamp-function' is set to its default +value of 'erc-insert-timestamp-left-and-right'.) ERC's near-term UI +goals require exposing these stamps to existing code designed to +operate on complete messages. For example, users likely expect date +stamps to be togglable with 'erc-toggle-timestamps' while also being +immune to hiding from commands like 'erc-match-toggle-hidden-fools'. +Before this change, meeting such expectations demanded brittle +heuristics that checked for the presence of these stamps in the +leading portion of message bodies as well as special casing to act on +these areas without inflicting collateral damage. It may also be +worth noting that as consequence of these changes, the internally +managed variable 'erc-timestamp-last-inserted-left' no longer records +the final trailing newline in 'erc-timestamp-format-left'. + *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and provided library features has improved. More specifically, a module's group now enjoys diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 0e6b5a3efb8..5ab5d73d9f2 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -158,6 +158,11 @@ erc-fill (when (or erc-fill--function erc-fill-function) ;; skip initial empty lines (goto-char (point-min)) + ;; Note the following search pattern was altered in 5.6 to adapt + ;; to a change in Emacs regexp behavior that turned out to be a + ;; regression (which has since been fixed). The patterns appear + ;; to be equivalent in practice, so this was left as is (wasn't + ;; reverted) to avoid additional git-blame(1)-related churn. (while (and (looking-at (rx bol (* (in " \t")) eol)) (zerop (forward-line 1)))) (unless (eobp) @@ -167,12 +172,10 @@ erc-fill (when-let* ((erc-fill-line-spacing) (p (point-min))) (widen) - (when (or (and-let* ((cmd (get-text-property p 'erc-command))) - (memq cmd erc-fill--spaced-commands)) + (when (or (erc--check-msg-prop 'erc-cmd erc-fill--spaced-commands) (and-let* ((cmd (save-excursion (forward-line -1) - (get-text-property (point) - 'erc-command)))) + (get-text-property (point) 'erc-cmd)))) (memq cmd erc-fill--spaced-commands))) (put-text-property (1- p) p 'line-spacing erc-fill-line-spacing)))))))) @@ -181,15 +184,17 @@ erc-fill-static "Fills a text such that messages start at column `erc-fill-static-center'." (save-restriction (goto-char (point-min)) - (looking-at "^\\(\\S-+\\)") - (let ((nick (match-string 1))) + (when-let (((looking-at "^\\(\\S-+\\)")) + ((not (erc--check-msg-prop 'erc-msg 'datestamp))) + (nick (match-string 1))) + (progn (let ((fill-column (- erc-fill-column (erc-timestamp-offset))) (fill-prefix (make-string erc-fill-static-center 32))) (insert (make-string (max 0 (- erc-fill-static-center (length nick) 1)) 32)) (erc-fill-regarding-timestamp)) - (erc-restore-text-properties)))) + (erc-restore-text-properties))))) (defun erc-fill-variable () "Fill from `point-min' to `point-max'." @@ -423,8 +428,6 @@ fill-wrap (eq (default-value 'erc-insert-timestamp-function) #'erc-insert-timestamp-left))) (setq erc-fill--function #'erc-fill-wrap) - (add-function :after (local 'erc-stamp--insert-date-function) - #'erc-fill--wrap-stamp-insert-prefixed-date) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) @@ -436,9 +439,7 @@ fill-wrap (kill-local-variable 'erc-fill--function) (kill-local-variable 'erc-fill--wrap-visual-keys) (remove-hook 'erc-button--prev-next-predicate-functions - #'erc-fill--wrap-merged-button-p t) - (remove-function (local 'erc-stamp--insert-date-function) - #'erc-fill--wrap-stamp-insert-prefixed-date)) + #'erc-fill--wrap-merged-button-p t)) 'local) (defvar-local erc-fill--wrap-length-function nil @@ -456,6 +457,9 @@ erc-fill--wrap-last-msg (defvar-local erc-fill--wrap-max-lull (* 24 60 60)) (defun erc-fill--wrap-continued-message-p () + "Return non-nil when the current speaker hasn't changed. +That is, indicate whether the text just inserted is from the same +sender as that of the previous \"PRIVMSG\"." (prog1 (and-let* ((m (or erc-fill--wrap-last-msg (setq erc-fill--wrap-last-msg (point-min-marker)) @@ -463,45 +467,37 @@ erc-fill--wrap-continued-message-p ((< (1+ (point-min)) (- (point) 2))) (props (save-restriction (widen) - (when (eq 'erc-timestamp (field-at-pos m)) - (set-marker m (field-end m))) (and-let* - (((eq 'PRIVMSG (get-text-property m 'erc-command))) - ((not (eq (get-text-property m 'erc-ctcp) - 'ACTION))) + (((eq 'PRIVMSG (get-text-property m 'erc-cmd))) + ((not (eq (get-text-property m 'erc-msg) 'ACTION))) + ((not (invisible-p m))) (spr (next-single-property-change m 'erc-speaker))) - (cons (get-text-property m 'erc-timestamp) + (cons (get-text-property m 'erc-ts) (get-text-property spr 'erc-speaker))))) (ts (pop props)) (props) ((not (time-less-p (erc-stamp--current-time) ts))) ((time-less-p (time-subtract (erc-stamp--current-time) ts) erc-fill--wrap-max-lull)) + ;; Assume presence of leading angle bracket or hyphen. (speaker (next-single-property-change (point-min) 'erc-speaker)) - ((not (eq (get-text-property speaker 'erc-ctcp) 'ACTION))) + ((not (erc--check-msg-prop 'erc-ctcp 'ACTION))) (nick (get-text-property speaker 'erc-speaker)) ((erc-nick-equal-p props nick)))) (set-marker erc-fill--wrap-last-msg (point-min)))) -(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args) - "Apply `line-prefix' property to args." - (let* ((ts-left (car args)) - (start) - ;; Insert " " to simulate gap between and msg beg. - (end (save-excursion (skip-chars-backward "\n") - (setq start (pos-bol)) - (insert " ") - (point))) - (width (if (and erc-fill-wrap-use-pixels - (fboundp 'buffer-text-pixel-size)) - (save-restriction (narrow-to-region start end) - (list (car (buffer-text-pixel-size)))) - (length (string-trim-left ts-left))))) - (delete-region (1- end) end) - ;; Use `point-min' instead of `start' to cover leading newilnes. - (put-text-property (point-min) (point) 'line-prefix - `(space :width (- erc-fill--wrap-value ,width)))) - args) +(defun erc-fill--wrap-measure (beg end) + "Return display spec width for inserted region between BEG and END. +Ignore any `invisible' props that may be present when figuring." + (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size)) + ;; `buffer-text-pixel-size' can move point! + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let* ((buffer-invisibility-spec) + (rv (car (buffer-text-pixel-size)))) + (if (zerop rv) 0 (list rv))))) + (- end beg))) ;; An escape hatch for third-party code expecting speakers of ACTION ;; messages to be exempt from `line-prefix'. This could be converted @@ -518,33 +514,38 @@ erc-fill-wrap (goto-char (point-min)) (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) - (progn + (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg))) (when-let ((e (erc--get-speaker-bounds)) (b (pop e)) ((or erc-fill--wrap-action-dedent-p - (not (eq (get-text-property b 'erc-ctcp) - 'ACTION))))) + (not (erc--check-msg-prop 'erc-ctcp + 'ACTION))))) (goto-char e)) (skip-syntax-forward "^-") (forward-char) - ;; Using the `invisible' property might make more - ;; sense, but that would require coordination - ;; with other modules, like `erc-match'. - (cond ((and erc-fill-wrap-merge + (cond ((eq msg-prop 'datestamp) + (when erc-fill--wrap-last-msg + (set-marker erc-fill--wrap-last-msg (point-min))) + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "\n") + (let ((beg (pos-bol))) + (insert " ") + (prog1 (erc-fill--wrap-measure beg (point)) + (delete-region (1- (point)) (point)))))) + ((and erc-fill-wrap-merge (erc-fill--wrap-continued-message-p)) (put-text-property (point-min) (point) 'display "") 0) - ((and erc-fill-wrap-use-pixels - (fboundp 'buffer-text-pixel-size)) - (save-restriction - (narrow-to-region (point-min) (point)) - (list (car (buffer-text-pixel-size))))) - (t (- (point) (point-min)))))))) - (erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n" - '(line-prefix wrap-prefix) nil - `((space :width (- erc-fill--wrap-value ,len)) - (space :width erc-fill--wrap-value)))))) + (t + (erc-fill--wrap-measure (point-min) (point)))))))) + (add-text-properties + (point-min) (1- (point-max)) ; exclude "\n" + `( line-prefix (space :width ,(if len + `(- erc-fill--wrap-value ,len) + 'erc-fill--wrap-value)) + wrap-prefix (space :width erc-fill--wrap-value)))))) ;; FIXME use own text property to avoid false positives. (defun erc-fill--wrap-merged-button-p (point) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 863429de202..0c616676841 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -242,8 +242,8 @@ erc-scroll-to-bottom ;;;###autoload(autoload 'erc-readonly-mode "erc-goodies" nil t) (define-erc-module readonly nil "This mode causes all inserted text to be read-only." - ((add-hook 'erc-insert-post-hook #'erc-make-read-only) - (add-hook 'erc-send-post-hook #'erc-make-read-only)) + ((add-hook 'erc-insert-post-hook #'erc-make-read-only 70) + (add-hook 'erc-send-post-hook #'erc-make-read-only 70)) ((remove-hook 'erc-insert-post-hook #'erc-make-read-only) (remove-hook 'erc-send-post-hook #'erc-make-read-only))) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 0f3163bf68d..394643c03cb 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -55,21 +55,22 @@ erc-timestamp-format :type '(choice (const nil) (string))) -;; FIXME remove surrounding whitespace from default value and have -;; `erc-insert-timestamp-left-and-right' add it before insertion. - (defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" - "If set to a string, messages will be timestamped. -This string is processed using `format-time-string'. -Good examples are \"%T\" and \"%H:%M\". - -This timestamp is used for timestamps on the left side of the -screen when `erc-insert-timestamp-function' is set to -`erc-insert-timestamp-left-and-right'. - -If nil, timestamping is turned off." - :type '(choice (const nil) - (string))) + "Format recognized by `format-time-string' for date stamps. +Only considered when `erc-insert-timestamp-function' is set to +`erc-insert-timestamp-left-and-right'. Used for displaying date +stamps on their own line, between messages. ERC inserts this +flavor of stamp as a separate \"psuedo message\", so a final +newline isn't necessary. For compatibility, only additional +trailing newlines beyond the first become empty lines. For +example, the default value results in an empty line after the +previous message, followed by the timestamp on its own line, +followed immediately by the next message on the next line. ERC +expects to display these stamps less frequently, so the +formatting specifiers should reflect that. To omit these stamps +entirely, use a different `erc-insert-timestamp-function', such +as `erc-timestamp-format-right'." + :type 'string) (defcustom erc-timestamp-format-right nil "If set to a string, messages will be timestamped. @@ -175,9 +176,9 @@ erc-timestamp-face ;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." - ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec) - (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 60) - (add-hook 'erc-send-modify-hook #'erc-add-timestamp 60) + ((add-hook 'erc-mode-hook #'erc-stamp--setup) + (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) + (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) @@ -214,18 +215,27 @@ erc-stamp--current-time (cl-defgeneric erc-stamp--current-time () "Return a lisp time object to associate with an IRC message. -This becomes the message's `erc-timestamp' text property." +This becomes the message's `erc-ts' text property." (erc-compat--current-lisp-time)) (cl-defmethod erc-stamp--current-time :around () (or erc-stamp--current-time (cl-call-next-method))) +(defvar erc-stamp--skip nil + "Non-nil means inhibit `erc-add-timestamp' completely.") + +(defvar erc-stamp--allow-unmanaged nil + "Non-nil means `erc-add-timestamp' runs unconditionally. +Escape hatch for third-parties using lower-level API functions, +such as `erc-display-line', directly.") + (defun erc-add-timestamp () "Add timestamp and text-properties to message. This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (progn ; remove this `progn' on next major refactor + (unless (or erc-stamp--skip (and (not erc-stamp--allow-unmanaged) + (null erc--msg-props))) (let* ((ct (erc-stamp--current-time)) (invisible (get-text-property (point-min) 'invisible)) (erc-stamp--invisible-property @@ -233,6 +243,8 @@ erc-add-timestamp (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp)) (skipp (and erc-stamp--skip-when-invisible invisible)) (erc-stamp--current-time ct)) + (when erc--msg-props + (puthash 'erc-ts ct erc--msg-props)) (unless skipp (funcall erc-insert-timestamp-function (erc-format-timestamp ct erc-timestamp-format))) @@ -244,12 +256,13 @@ erc-add-timestamp (erc-away-time)) (funcall erc-insert-away-timestamp-function (erc-format-timestamp ct erc-away-timestamp-format))) - (add-text-properties (point-min) (1- (point-max)) + (when erc-stamp--allow-unmanaged + (add-text-properties (point-min) (1- (point-max)) ;; It's important for the function to ;; be different on different entries (bug#22700). (list 'cursor-sensor-functions ;; Regions are no longer contiguous ^ - '(erc--echo-ts-csf) 'erc-timestamp ct))))) + '(erc--echo-ts-csf) 'erc-ts ct)))))) (defvar-local erc-timestamp-last-window-width nil "The width of the last window that showed the current buffer. @@ -260,9 +273,11 @@ erc-timestamp-last-inserted "Last timestamp inserted into the buffer.") (defvar-local erc-timestamp-last-inserted-left nil - "Last timestamp inserted into the left side of the buffer. -This is used when `erc-insert-timestamp-function' is set to -`erc-timestamp-left-and-right'") + "Last \"date stamp\" inserted into the left side of the buffer. +Used when `erc-insert-timestamp-function' is set to +`erc-timestamp-left-and-right'. If the format string specified +by `erc-timestamp-format-left' includes trailing newlines, this +value omits the last one.") (defvar-local erc-timestamp-last-inserted-right nil "Last timestamp inserted into the right side of the buffer. @@ -362,19 +377,27 @@ erc-stamp-prefix-log-filter (goto-char (point-min)) (while (progn - (when-let* (((< (point) (pos-eol))) - (end (1- (pos-eol))) - ((eq 'erc-timestamp (field-at-pos end))) - (beg (field-beginning end)) - ;; Skip a line that's just a timestamp. - ((> beg (point)))) + (when-let (((< (point) (pos-eol))) + (end (1- (pos-eol))) + ((eq 'erc-timestamp (field-at-pos end))) + (beg (field-beginning end)) + ;; Skip a line that's just a timestamp. + ((> beg (point)))) (delete-region beg (1+ end))) - (when-let (time (get-text-property (point) 'erc-timestamp)) + (when-let (time (erc--get-inserted-msg-prop 'erc-ts)) (insert (format-time-string "[%H:%M:%S] " time))) (zerop (forward-line)))) "") -(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) +;; These are currently extended manually, but we could also bind +;; `text-property-default-nonsticky' and call `insert-and-inherit' +;; instead of `insert', but we'd have to pair the props with differing +;; boolean values for left and right stamps. Also, since this hook +;; runs last, we can't expect overriding sticky props to be absent, +;; even though, as of 5.6, `front-sticky' is only added by the +;; `readonly' module after hooks run. +(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix) + "Extant properties at the start of a message inherited by the stamp.") (declare-function erc--remove-text-properties "erc" (string)) @@ -573,8 +596,11 @@ erc-insert-timestamp-right ;; intervening white space unless a hard break is warranted. (pcase erc-timestamp-use-align-to ((guard erc-stamp--display-margin-mode) - (put-text-property 0 (length string) - 'display `((margin right-margin) ,string) string)) + (let ((s (propertize (substring-no-properties string) + 'invisible erc-stamp--invisible-property))) + (put-text-property 0 (length string) 'display + `((margin right-margin) ,s) + string))) ((and 't (guard (< col pos))) (insert " ") (put-text-property from (point) 'display `(space :align-to ,pos))) @@ -599,30 +625,94 @@ erc-insert-timestamp-right (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) -(defvar erc-stamp--insert-date-function #'insert - "Function to insert left \"left-right date\" stamp. -A local module might use this to modify text properties, -`insert-before-markers' or renarrow the region after insertion.") +(defvar erc-stamp--insert-date-hook nil + "Functions appended to send and modify hooks when inserting date stamp.") + +(defvar-local erc-stamp--date-format-end nil + "Substring index marking usable portion of date stamp format.") + +(defun erc-stamp--propertize-left-date-stamp () + (add-text-properties (point-min) (1- (point-max)) + '(field erc-timestamp erc-stamp-type date-left)) + (erc--hide-message 'timestamp)) + +;; A kludge to pass state from insert hook to nested insert hook. +(defvar erc-stamp--current-datestamp-left nil) + +(defun erc-stamp--format-date-stamp (ct) + "Format left date stamp with `erc-timestamp-format-left'." + (unless erc-stamp--date-format-end + ;; Don't add text properties to the trailing newline. + (setq erc-stamp--date-format-end + (if (string-suffix-p "\n" erc-timestamp-format-left) -1 0))) + ;; Ignore existing `invisible' prop value because date stamps should + ;; never be hideable except via `timestamp'. + (let (erc-stamp--invisible-property) + (erc-format-timestamp ct (substring erc-timestamp-format-left + 0 erc-stamp--date-format-end)))) + +;; Calling `erc-display-message' from within a hook it's currently +;; running is roundabout, but it's a definite means of ensuring hooks +;; can act on the date stamp as a standalone message to do things like +;; adjust invisibility props. +(defun erc-stamp--insert-date-stamp-as-phony-message (string) + (cl-assert (string-empty-p string)) + (setq string erc-stamp--current-datestamp-left) + (cl-assert string) + (let ((erc-stamp--skip t) + (erc--msg-props (map-into `((erc-msg . datestamp) + (erc-ts . ,erc-stamp--current-time)) + 'hash-table)) + (erc-send-modify-hook `(,@erc-send-modify-hook + erc-stamp--propertize-left-date-stamp + ,@erc-stamp--insert-date-hook)) + (erc-insert-modify-hook `(,@erc-insert-modify-hook + erc-stamp--propertize-left-date-stamp + ,@erc-stamp--insert-date-hook))) + (erc-display-message nil nil (current-buffer) string) + (setq erc-timestamp-last-inserted-left string))) + +(defun erc-stamp--lr-date-on-pre-modify (_) + (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time))) + (rendered (erc-stamp--format-date-stamp ct)) + ((not (string-equal rendered erc-timestamp-last-inserted-left))) + (erc-stamp--current-datestamp-left rendered) + (erc-insert-timestamp-function + #'erc-stamp--insert-date-stamp-as-phony-message)) + (save-restriction + (narrow-to-region (or erc--insert-marker erc-insert-marker) + (or erc--insert-marker erc-insert-marker)) + (let (erc-timestamp-format erc-away-timestamp-format) + (erc-add-timestamp))))) (defun erc-insert-timestamp-left-and-right (string) "Insert a stamp on either side when it changes. When the deprecated option `erc-timestamp-format-right' is nil, use STRING, which originates from `erc-timestamp-format', for the -right-hand stamp. Use `erc-timestamp-format-left' for the -left-hand stamp and expect it to change less frequently." +right-hand stamp. Use `erc-timestamp-format-left' for formatting +the left-sided \"date stamp,\" and expect it to change less +frequently. Include all but the final trailing newline present +in the latter (if any) as part of the `erc-timestamp' field. +Allow the stamp's `invisible' property to span that same interval +but also cover the previous newline, in order to satisfy folding +requirements related to `erc-legacy-invisible-bounds-p'. +Additionally, ensure every date stamp is identifiable as such so +that internal modules can easily distinguish between other +left-sided stamps and date stamps inserted by this function." + (unless erc-stamp--date-format-end + (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t) + (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t) + (let ((erc--insert-marker (point-min-marker))) + (set-marker-insertion-type erc--insert-marker t) + (erc-stamp--lr-date-on-pre-modify nil) + (narrow-to-region erc--insert-marker (point-max)) + (set-marker erc--insert-marker nil))) (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) - (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) (ts-right (with-suppressed-warnings ((obsolete erc-timestamp-format-right)) (if erc-timestamp-format-right (erc-format-timestamp ct erc-timestamp-format-right) string)))) - ;; insert left timestamp - (unless (string-equal ts-left erc-timestamp-last-inserted-left) - (goto-char (point-min)) - (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) - (funcall erc-stamp--insert-date-function ts-left) - (setq erc-timestamp-last-inserted-left ts-left)) ;; insert right timestamp (let ((erc-timestamp-only-if-changed-flag t) (erc-timestamp-last-inserted erc-timestamp-last-inserted-right)) @@ -639,8 +729,9 @@ erc-format-timestamp (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) - (erc-put-text-property 0 (length ts) 'invisible - erc-stamp--invisible-property ts) + (when erc-stamp--invisible-property + (erc-put-text-property 0 (length ts) 'invisible + erc-stamp--invisible-property ts)) ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible @@ -649,6 +740,8 @@ erc-format-timestamp ts) "")) +(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, @@ -661,10 +754,23 @@ erc-munge-invisibility-spec (cursor-intangible-mode -1))) (if erc-echo-timestamps (progn + (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) + (unless (or erc-stamp--allow-unmanaged erc-stamp--csf-props-updated-p) + (setq erc-stamp--csf-props-updated-p t) + (let ((erc--msg-props (map-into '((erc-ts . t)) 'hash-table))) + (with-silent-modifications + (erc--traverse-inserted (point-min) erc-insert-marker + #'erc-stamp--add-csf-on-post-modify)))) (cursor-sensor-mode +1) ; idempotent (when (>= emacs-major-version 29) (add-function :before-until (local 'clear-message-function) #'erc-stamp--on-clear-message))) + (dolist (hook '(erc-insert-post-hook erc-send-post-hook)) + (remove-hook hook #'erc-stamp--add-csf-on-post-modify t)) + (kill-local-variable 'erc-stamp--csf-props-updated-p) (when (bound-and-true-p cursor-sensor-mode) (cursor-sensor-mode -1)) (remove-function (local 'clear-message-function) @@ -673,12 +779,22 @@ erc-munge-invisibility-spec (add-to-invisibility-spec 'timestamp) (remove-from-invisibility-spec 'timestamp))) +(defun erc-stamp--add-csf-on-post-modify () + "Add `cursor-sensor-functions' to narrowed buffer." + (when (erc--check-msg-prop 'erc-ts) + (put-text-property (point-min) (1- (point-max)) + 'cursor-sensor-functions '(erc--echo-ts-csf)))) + (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode (erc-munge-invisibility-spec) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) - (erc-munge-invisibility-spec)))) + (erc-munge-invisibility-spec)) + ;; Undo local mods from `erc-insert-timestamp-left-and-right'. + (remove-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify t) + (remove-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify t) + (kill-local-variable 'erc-stamp--date-format-end))) (defun erc-hide-timestamps () "Hide timestamp information from display." @@ -714,7 +830,7 @@ erc-stamp--last-stamp (defun erc-stamp--on-clear-message (&rest _) "Return `dont-clear-message' when operating inside the same stamp." (and erc-stamp--last-stamp erc-echo-timestamps - (eq (get-text-property (point) 'erc-timestamp) erc-stamp--last-stamp) + (eq (erc--get-inserted-msg-prop 'erc-ts) erc-stamp--last-stamp) 'dont-clear-message)) (defun erc-echo-timestamp (dir stamp &optional zone) @@ -724,7 +840,7 @@ erc-echo-timestamp interpret a \"raw\" prefix as UTC. To specify a zone for use with the option `erc-echo-timestamps', see the companion option `erc-echo-timestamp-zone'." - (interactive (list nil (get-text-property (point) 'erc-timestamp) + (interactive (list nil (erc--get-inserted-msg-prop 'erc-ts) (pcase current-prefix-arg ((and (pred numberp) v) (if (<= (abs v) 14) (* v 3600) v)) @@ -738,18 +854,18 @@ erc-echo-timestamp (setq erc-stamp--last-stamp nil)))) (defun erc--echo-ts-csf (_window _before dir) - (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp))) + (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc-ts))) (defun erc-stamp--update-saved-position (&rest _) - (remove-function (local 'erc-stamp--insert-date-function) - #'erc-stamp--update-saved-position) - (move-marker erc-last-saved-position (1- (point)))) + (remove-hook 'erc-stamp--insert-date-hook + #'erc-stamp--update-saved-position t) + (move-marker erc-last-saved-position (1- (point-max)))) (defun erc-stamp--reset-on-clear (pos) "Forget last-inserted stamps when POS is at insert marker." (when (= pos (1- erc-insert-marker)) - (add-function :after (local 'erc-stamp--insert-date-function) - #'erc-stamp--update-saved-position) + (add-hook 'erc-stamp--insert-date-hook + #'erc-stamp--update-saved-position 0 t) (setq erc-timestamp-last-inserted nil erc-timestamp-last-inserted-left nil erc-timestamp-last-inserted-right nil))) diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 48d8408a85a..3350cbd13b7 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -102,7 +102,7 @@ erc-truncate-buffer-to-size ;; Truncate at message boundary (formerly line boundary ;; before 5.6). (goto-char end) - (goto-char (or (previous-single-property-change (point) 'erc-command) + (goto-char (or (erc--get-inserted-msg-bounds 'beg) (pos-bol))) (setq end (point)) ;; try to save the current buffer using diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index c3312000ffd..5bf6496e926 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -135,9 +135,11 @@ erc-scripts "Running scripts at startup and with /LOAD." :group 'erc) -;; Forward declarations -(defvar erc-message-parsed) +(defvar erc-message-parsed) ; only known to this file +(defvar erc--msg-props nil) +(defvar erc--msg-prop-overrides nil) +;; Forward declarations (defvar tabbar--local-hlf) (defvar motif-version-string) (defvar gtk-version-string) @@ -1139,9 +1141,13 @@ erc-insert-modify-hook "Insertion hook for functions that will change the text's appearance. This hook is called just after `erc-insert-pre-hook' when the value of `erc-insert-this' is t. -While this hook is run, narrowing is in effect and `current-buffer' is -the buffer where the text got inserted. One possible value to add here -is `erc-fill'." + +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 +`erc-find-parsed-property' and `erc-get-parsed-vector' to locate +and extract the `erc-response' object for the inserted message." :group 'erc-hooks :type 'hook) @@ -2871,11 +2877,10 @@ erc-toggle-debug-irc-protocol (defun erc-send-action (tgt str &optional force) "Send CTCP ACTION information described by STR to TGT." (erc-send-ctcp-message tgt (format "ACTION %s" str) force) - (let ((erc-insert-pre-hook - (cons (lambda (s) ; Leave newline be. - (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s) - (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s)) - erc-insert-pre-hook)) + ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us. + (let ((erc--msg-prop-overrides '((erc-msg . msg) + (erc-cmd . PRIVMSG) + (erc-ctcp . ACTION))) (nick (erc-current-nick))) (setq nick (propertize nick 'erc-speaker nick)) (erc-display-message nil '(t action input) (current-buffer) @@ -2934,6 +2939,67 @@ erc--refresh-prompt (delete-region (point) (1- erc-input-marker)))) (run-hooks 'erc--refresh-prompt-hook))) +(defun erc--check-msg-prop (prop &optional val) + "Return PROP's value in `erc--msg-props' when populated. +If VAL is a list, return non-nil if PROP appears in VAL. If VAL +is otherwise non-nil, return non-nil if VAL compares `eq' to the +stored value. Otherwise, return the stored value." + (and-let* ((erc--msg-props) + (v (gethash prop erc--msg-props))) + (if (consp val) (memq v val) (if val (eq v val) v)))) + +(defmacro erc--get-inserted-msg-bounds (&optional only point) + "Return the bounds of a message in an ERC buffer. +Return ONLY one side when the first arg is `end' or `beg'. With +POINT, search from POINT instead of `point'." + `(let* ((point ,(or point '(point))) + (at-start-p (get-text-property point 'erc-msg))) + (and-let* + (,@(and (member only '(nil 'beg)) + '((b (or (and at-start-p point) + (and-let* + ((p (previous-single-property-change point + 'erc-msg))) + (if (= p (1- point)) point (1- p))))))) + ,@(and (member only '(nil 'end)) + '((e (1- (next-single-property-change + (if at-start-p (1+ point) point) + 'erc-msg nil erc-insert-marker)))))) + ,(pcase only + ('(quote beg) 'b) + ('(quote end) 'e) + (_ '(cons b e)))))) + +(defun erc--get-inserted-msg-prop (prop) + "Return the value of text property PROP for some message at point." + (and-let* ((stack-pos (erc--get-inserted-msg-bounds 'beg))) + (get-text-property stack-pos prop))) + +(defmacro erc--with-inserted-msg (&rest body) + "Simulate narrowing performed for send and insert hooks, and run BODY. +Expect callers to know that this doesn't wrap BODY in +`with-silent-modifications' or bind a temporary `erc--msg-props'." + `(when-let ((bounds (erc--get-inserted-msg-bounds))) + (save-restriction + (narrow-to-region (car bounds) (1+ (cdr bounds))) + ,@body))) + +(defun erc--traverse-inserted (beg end fn) + "Visit messages between BEG and END and run FN in narrowed buffer." + (setq end (min end (marker-position erc-insert-marker))) + (save-excursion + (goto-char beg) + (let ((b (if (get-text-property (point) 'erc-msg) + (point) + (next-single-property-change (point) 'erc-msg nil end)))) + (while-let ((b) + ((< b end)) + (e (next-single-property-change (1+ b) 'erc-msg nil end))) + (save-restriction + (narrow-to-region b e) + (funcall fn)) + (setq b e))))) + (defvar erc--insert-marker nil "Internal override for `erc-insert-marker'.") @@ -2981,7 +3047,13 @@ erc-display-line-1 (run-hooks 'erc-insert-post-hook) (when erc-remove-parsed-property (remove-text-properties (point-min) (point-max) - '(erc-parsed nil tags nil)))) + '(erc-parsed nil tags nil))) + (cl-assert (> (- (point-max) (point-min)) 1)) + (let ((props (if erc--msg-props + (erc--order-text-properties-from-hash + erc--msg-props) + '(erc-msg unknown)))) + (add-text-properties (point-min) (1+ (point-min)) props))) (erc--refresh-prompt))))) (run-hooks 'erc-insert-done-hook) (erc-update-undo-list (- (or (marker-position (or erc--insert-marker @@ -3112,7 +3184,11 @@ erc-legacy-invisible-bounds-p (defun erc--hide-message (value) "Apply `invisible' text-property with VALUE to current message. -Expect to run in a narrowed buffer during message insertion." +Expect to run in a narrowed buffer during message insertion. +Begin the invisible interval at the previous message's trailing +newline and end before the current message's. If the preceding +message ends in a double newline or there is no previous message, +don't bother including the preceding newline." (if erc-legacy-invisible-bounds-p ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. @@ -3121,8 +3197,25 @@ erc--hide-message (end (point-max))) (save-restriction (widen) + (when (or (<= beg 4) (= ?\n (char-before (- beg 2)))) + (cl-incf beg)) (erc--merge-prop (1- beg) (1- end) 'invisible value))))) +(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd)) + +(defun erc--order-text-properties-from-hash (table) + "Return a plist of text props from items in TABLE. +Ensure props in `erc--ranked-properties' appear last and in +reverse order so they end up sorted in buffer interval plists for +retrieval by `text-properties-at' and friends." + (let (out) + (dolist (k erc--ranked-properties) + (when-let ((v (gethash k table))) + (remhash k table) + (setq out (nconc (list k v) out)))) + (maphash (lambda (k v) (setq out (nconc (list k v) out))) table) + out)) + (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. @@ -3336,23 +3429,52 @@ erc-hide-current-message-p (defun erc-display-message (parsed type buffer msg &rest args) "Display MSG in BUFFER. -ARGS, PARSED, and TYPE are used to format MSG sensibly. +Insert MSG or text derived from MSG into an ERC buffer, possibly +after applying formatting by way of either a `format-spec' known +to a message-catalog entry or a TYPE known to a specialized +string handler. Additionally, derive internal metadata, faces, +and other text properties from the various overloaded parameters, +such as PARSED, when it's an `erc-response' object, and MSG, when +it's a key (symbol) for a \"message catalog\" entry. Expect +ARGS, when applicable, to be `format-spec' args known to such an +entry, and TYPE, when non-nil, to be a symbol handled by +`erc-display-message-highlight' (necessarily accompanied by a +string MSG). When TYPE is a list of symbols, call handlers from left to right without influencing how they behave when encountering existing faces. As of ERC 5.6, expect a TYPE of (notice error) to insert MSG with `font-lock-face' as `erc-error-face' throughout. However, when the list of symbols begins with t, tell compatible -handlers to compose rather than clobber faces. For example, as -of ERC 5.6, expect a TYPE of (t notice error) to result in MSG's -`font-lock-face' being (erc-error-face erc-notice-face) -throughout when `erc-notice-highlight-type' is set to its default -`all'. - -See also `erc-format-message' and `erc-display-line'." +handlers to compose rather than clobber faces. For example, +expect a TYPE of (t notice error) to result in `font-lock-face' +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 user code will use this function instead of +`erc-display-line' when it's important that insert hooks treat +MSG in a manner befitting messages received from a server. That +is, expect to process most nontrivial informational messages, for +which PARSED is typically nil, when the caller desires +buttonizing and other effects." (let ((string (if (symbolp msg) (apply #'erc-format-message msg args) msg)) + (erc--msg-props + (or erc--msg-props + (let* ((table (make-hash-table :size 5)) + (cmd (and parsed (erc--get-eq-comparable-cmd + (erc-response.command parsed)))) + (m (cond ((and msg (symbolp msg)) msg) + ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg)) + (t 'unknown)))) + (puthash 'erc-msg m table) + (when cmd + (puthash 'erc-cmd cmd table)) + (and erc--msg-prop-overrides + (pcase-dolist (`(,k . ,v) erc--msg-prop-overrides) + (puthash k v table))) + table))) (erc-message-parsed parsed)) (setq string (cond @@ -3371,9 +3493,6 @@ erc-display-message (erc-display-line string buffer) (unless (erc-hide-current-message-p parsed) (erc-put-text-property 0 (length string) 'erc-parsed parsed string) - (put-text-property - 0 (length string) 'erc-command - (erc--get-eq-comparable-cmd (erc-response.command parsed)) string) (when (erc-response.tags parsed) (erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed) string)) @@ -4824,6 +4943,7 @@ erc--own-property-names rear-nonsticky erc-prompt field front-sticky read-only ;; stamp cursor-intangible cursor-sensor-functions isearch-open-invisible + erc-stamp-type ;; match invisible intangible ;; button @@ -5306,15 +5426,13 @@ erc-is-message-ctcp-and-not-action-p (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) -(define-inline erc--get-speaker-bounds () - "Return the bounds of `erc-speaker' property when present. +(defun erc--get-speaker-bounds () + "Return the bounds of `erc-speaker' text property when present. Assume buffer is narrowed to the confines of an inserted message." - (inline-quote - (and-let* - (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE))) - (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min)) - (next-single-property-change (point-min) 'erc-speaker)))) - (cons beg (next-single-property-change beg 'erc-speaker))))) + (and-let* (((erc--check-msg-prop 'erc-msg 'msg)) + (beg (text-property-not-all (point-min) (point-max) + 'erc-speaker nil))) + (cons beg (next-single-property-change beg 'erc-speaker)))) (defvar erc--cmem-from-nick-function #'erc--cmem-get-existing "Function maybe returning a \"channel member\" cons from a nick. @@ -5636,11 +5754,8 @@ erc-process-ctcp-query (while queries (let* ((type (upcase (car (split-string (car queries))))) (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))) - (erc-insert-pre-hook - (cons (lambda (s) - (put-text-property 0 (1- (length s)) 'erc-ctcp - (intern type) s)) - erc-insert-pre-hook))) + (erc--msg-prop-overrides `((erc-msg . msg) + (erc-ctcp . ,(intern type))))) (if (and hook (boundp hook)) (if (string-equal type "ACTION") (run-hook-with-args-until-success @@ -6645,7 +6760,8 @@ erc-send-current-line (when-let (((not (erc--input-split-abortp state))) (inhibit-read-only t) (old-buf (current-buffer))) - (progn ; unprogn this during next major surgery + (let ((erc--msg-prop-overrides '((erc-cmd . PRIVMSG) + (erc-msg . msg)))) (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt (delete-region erc-input-marker (erc-end-of-input-line)) @@ -6792,17 +6908,24 @@ erc-display-msg (save-excursion (erc--assert-input-bounds) (let ((insert-position (marker-position (goto-char erc-insert-marker))) + (erc--msg-props (or erc--msg-props + (map-into (cons '(erc-msg . self) + erc--msg-prop-overrides) + 'hash-table))) beg) (insert (erc-format-my-nick)) (setq beg (point)) (insert line) (erc-put-text-property beg (point) 'font-lock-face 'erc-input-face) - (erc-put-text-property insert-position (point) 'erc-command 'PRIVMSG) (insert "\n") (save-restriction (narrow-to-region insert-position (point)) (run-hooks 'erc-send-modify-hook) - (run-hooks 'erc-send-post-hook)) + (run-hooks 'erc-send-post-hook) + (cl-assert (> (- (point-max) (point-min)) 1)) + (add-text-properties (point-min) (1+ (point-min)) + (erc--order-text-properties-from-hash + erc--msg-props))) (erc--refresh-prompt))))) (defun erc-command-symbol (command) @@ -8190,8 +8313,8 @@ erc-find-parsed-property (text-property-not-all (point-min) (point-max) 'erc-parsed nil)) (defun erc-restore-text-properties () - "Restore the property `erc-parsed' for the region." - (when-let* ((parsed-posn (erc-find-parsed-property)) + "Ensure the `erc-parsed' and `tags' props cover the entire message." + (when-let ((parsed-posn (erc-find-parsed-property)) (found (erc-get-parsed-vector parsed-posn))) (put-text-property (point-min) (point-max) 'erc-parsed found) (when-let ((tags (get-text-property parsed-posn 'tags))) @@ -8220,7 +8343,7 @@ erc--get-eq-comparable-cmd See also `erc-message-type'." ;; IRC numerics are three-digit numbers, possibly with leading 0s. ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o)) - (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n)) + (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n)) ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index b81d0c15558..8f0c8f9ccf4 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -31,10 +31,14 @@ erc-fill-tests--time-vals (defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) - (let ((msg (erc-format-privmessage speaker - (apply #'concat msg-parts) nil t))) - (put-text-property 0 (length msg) 'erc-command 'PRIVMSG msg) - (erc-display-message nil nil (current-buffer) msg))) + (let* ((msg (erc-format-privmessage speaker + (apply #'concat msg-parts) nil t)) + ;; (erc--msg-prop-overrides '((erc-msg . msg) (erc-cmd . PRIVMSG))) + (parsed (make-erc-response :unparsed msg :sender speaker + :command "PRIVMSG" + :command-args (list "#chan" msg) + :contents msg))) + (erc-display-message parsed nil (current-buffer) msg))) (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) @@ -75,8 +79,8 @@ erc-fill-tests--wrap-populate (erc-fill-tests--insert-privmsg "alice" "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.") + "What was done to Elbow's wife, that he hath cause to complain of?" + " Come me to what was done to her.") ;; Introduce an artificial gap in properties `line-prefix' and ;; `wrap-prefix' and later ensure they're not incremented twice. @@ -111,6 +115,14 @@ erc-fill-tests--wrap-check-prefixes (should (get-text-property (pos-bol) 'line-prefix)) (should (get-text-property (1- (pos-eol)) 'line-prefix)) (should-not (get-text-property (pos-eol) 'line-prefix)) + ;; Spans entire line uninterrupted. + (let* ((val (get-text-property (pos-bol) 'line-prefix)) + (end (text-property-not-all (pos-bol) (point-max) + 'line-prefix val))) + (when (and (/= end (pos-eol)) (= ?? (char-before end))) + (setq end (text-property-not-all (1+ end) (point-max) + 'line-prefix val))) + (should (eq end (pos-eol)))) (should (equal (get-text-property (pos-bol) 'wrap-prefix) '(space :width erc-fill--wrap-value))) (should-not (get-text-property (pos-eol) 'wrap-prefix)) @@ -145,7 +157,7 @@ erc-fill-tests--compare (number-to-string erc-fill--wrap-value) (prin1-to-string got)))) (with-current-buffer (generate-new-buffer name) - (push name erc-fill-tests--buffers) + (push (current-buffer) erc-fill-tests--buffers) (with-silent-modifications (insert (setq got (read repr)))) (erc-mode)) @@ -153,15 +165,31 @@ erc-fill-tests--compare (with-temp-file expect-file (insert repr)) (if (file-exists-p expect-file) - ;; Compare set-equal over intervals. This comparison is - ;; less useful for messages treated by other modules because - ;; it doesn't compare "nested" props belonging to - ;; string-valued properties, like timestamps. - (should (equal-including-properties - (read repr) - (read (with-temp-buffer - (insert-file-contents-literally expect-file) - (buffer-string))))) + ;; Ensure string-valued properties, like timestamps, aren't + ;; recursive (signals `max-lisp-eval-depth' exceeded). + (named-let assert-equal + ((latest (read repr)) + (expect (read (with-temp-buffer + (insert-file-contents-literally expect-file) + (buffer-string))))) + (pcase latest + ((or "" 'nil) t) + ((pred stringp) + (should (equal-including-properties latest expect)) + (let ((latest-intervals (object-intervals latest)) + (expect-intervals (object-intervals expect))) + (while-let ((l-iv (pop latest-intervals)) + (x-iv (pop expect-intervals)) + (l-tab (map-into (nth 2 l-iv) 'hash-table)) + (x-tab (map-into (nth 2 x-iv) 'hash-table))) + (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab)) + (assert-equal l-v (gethash l-k x-tab)) + (remhash l-k x-tab)) + (should (zerop (hash-table-count x-tab)))))) + ((pred sequencep) + (assert-equal (seq-first latest) (seq-first expect)) + (assert-equal (seq-rest latest) (seq-rest expect))) + (_ (should (equal latest expect))))) (message "Snapshot file missing: %S" expect-file))))) ;; To inspect variable pitch, set `erc-mode-hook' to diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index fd030d90c2f..f7e7d61c92e 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -81,6 +81,7 @@ erc-scenarios-log--kill-hook (ert-deftest erc-scenarios-log--clear-stamp () :tags '(:expensive-test) + (require 'erc-stamp) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/assoc/bouncer-history") (dumb-server (erc-d-run "localhost" t 'foonet)) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index cd899fddb98..3da55572cf7 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -55,7 +55,8 @@ erc-scenarios-match--stamp-left-current-nick :nick "tester") ;; Module `timestamp' follows `match' in insertion hooks. (should (memq 'erc-add-timestamp - (memq 'erc-match-message erc-insert-modify-hook))) + (memq 'erc-match-message + (default-value 'erc-insert-modify-hook)))) ;; The "match type" is `current-nick'. (funcall expect 5 "tester") (should (eq (get-text-property (1- (point)) 'font-lock-face) @@ -91,7 +92,8 @@ erc-scenarios-match--invisible-stamp :nick "tester") ;; Module `timestamp' follows `match' in insertion hooks. (should (memq 'erc-add-timestamp - (memq 'erc-match-message erc-insert-modify-hook))) + (memq 'erc-match-message + (default-value 'erc-insert-modify-hook)))) (funcall expect 5 "This server is in debug mode"))) (ert-info ("Ensure lines featuring \"bob\" are invisible") @@ -151,29 +153,13 @@ erc-scenarios-match--stamp-left-fools-invisible (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) (pos-eol)))))))) -(defun erc-scenarios-match--find-bol () - (save-excursion - (should (get-text-property (1- (point)) 'erc-command)) - (goto-char (should (previous-single-property-change (point) 'erc-command))) - (pos-bol))) - -(defun erc-scenarios-match--find-eol () - (save-excursion - (if-let ((next (next-single-property-change (point) 'erc-command))) - (goto-char next) - ;; We're already at the end of the message. - (should (get-text-property (1- (point)) 'erc-command))) - (pos-eol))) - ;; In most cases, `erc-hide-fools' makes line endings invisible. (defun erc-scenarios-match--stamp-right-fools-invisible () - :tags '(:expensive-test) (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) (erc-scenarios-match--invisible-stamp (lambda () - (let ((beg (erc-scenarios-match--find-bol)) - (end (erc-scenarios-match--find-eol))) + (pcase-let ((`(,beg . ,end) (erc--get-inserted-msg-bounds))) ;; The end of the message is a newline. (should (= ?\n (char-after end))) @@ -205,7 +191,7 @@ erc-scenarios-match--stamp-right-fools-invisible (should (= (next-single-property-change msg-end 'invisible) end))))) (lambda () - (let ((end (erc-scenarios-match--find-eol))) + (let ((end (erc--get-inserted-msg-bounds 'end))) ;; This message has a time stamp like all the others. (should (eq (field-at-pos (1- end)) 'erc-timestamp)) @@ -271,7 +257,172 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) -(defun erc-scenarios-match--stamp-both-invisible-fill-static () +(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point) + (pcase (get-text-property point 'line-prefix) + (`(space :width (- erc-fill--wrap-value (,n))) + (if (display-graphic-p) (< 100 n 200) (< 10 n 30))) + (`(space :width (- erc-fill--wrap-value ,n)) + (< 10 n 30)))) + +(ert-deftest erc-scenarios-match--hide-fools/stamp-both/fill-wrap () + + ;; Rewind the clock to known date artificially. We should probably + ;; use a ticks/hz cons on 29+. + (let ((erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-fill-function #'erc-fill-wrap) + (bob-utterance-counter 0)) + + (erc-scenarios-match--invisible-stamp + + (lambda () + (ert-info ("Baseline check") + ;; False date printed initially before anyone speaks. + (when (zerop bob-utterance-counter) + (save-excursion + (goto-char (point-min)) + (search-forward "[Wed Apr 29 1992]") + ;; First stamp in a buffer is not invisible from previous + ;; newline (before stamp's own leading newline). + (should (= 4 (match-beginning 0))) + (should (get-text-property 3 'invisible)) + (should-not (get-text-property 2 'invisible)) + (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4)) + (search-forward "[23:59]")))) + + (ert-info ("Line endings in Bob's messages are invisible") + ;; The message proper has the `invisible' property `match-fools'. + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) + (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds))) + (should (= (char-after mend) ?\n)) + (should-not (field-at-pos mend)) + (should-not (field-at-pos mbeg)) + + (when (= bob-utterance-counter 1) + (let ((right-stamp (field-end mbeg))) + (should (eq 'erc-timestamp (field-at-pos right-stamp))) + (should (= mend (field-end right-stamp))) + (should (eq (field-at-pos (1- mend)) 'erc-timestamp)))) + + ;; The `erc-ts' property is present in prop stack. + (should (get-text-property (pos-bol) 'erc-ts)) + (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts)) + + ;; Line ending has the `invisible' property `match-fools'. + (should (eq (get-text-property mbeg 'invisible) 'match-fools)) + (should-not (get-text-property mend 'invisible)))) + + ;; Only the message right after Alice speaks contains stamps. + (when (= 1 bob-utterance-counter) + + (ert-info ("Date stamp occupying previous line is invisible") + (should (eq 'match-fools (get-text-property (point) 'invisible))) + (save-excursion + (forward-line -1) + (goto-char (pos-bol)) + (should (looking-at (rx "[Mon May 4 1992]"))) + (ert-info ("Stamp's NL `invisible' as fool, not timestamp") + (let ((end (match-end 0))) + (should (eq (char-after end) ?\n)) + (should (eq 'timestamp + (get-text-property (1- end) 'invisible))) + (should (eq 'match-fools + (get-text-property end 'invisible))))) + (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point))) + ;; Date stamp has a combined `invisible' property value + ;; that starts at the previous message's trailing newline + ;; and extends until the start of the message proper. + (should (equal ?\n (char-before (point)))) + (should (equal ?\n (char-before (1- (point))))) + (let ((val (get-text-property (- (point) 2) 'invisible))) + (should (equal val 'timestamp)) + (should (= (text-property-not-all (- (point) 2) (point-max) + 'invisible val) + (pos-eol)))))) + + (ert-info ("Current message's RHS stamp is hidden") + ;; Right stamp has `match-fools' property. + (save-excursion + (should-not (field-at-pos (point))) + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))) + + ;; Stamp invisibility starts where message's ends. + (let ((msgend (next-single-property-change (pos-bol) 'invisible))) + ;; Stamp has a combined `invisible' property value. + (should (equal (get-text-property msgend 'invisible) + '(timestamp match-fools))) + + ;; Combined `invisible' property spans entire timestamp. + (should (= (next-single-property-change msgend 'invisible) + (pos-eol)))))) + + (cl-incf bob-utterance-counter)) + + ;; Alice. + (lambda () + ;; Set clock ahead a week or so. + (setq erc-stamp--current-time 704962800) + + ;; This message has no time stamp and is completely visible. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (should-not (next-single-property-change (pos-bol) 'invisible)))))) + +;; This asserts that speaker hiding by `erc-fill-wrap-merge' doesn't +;; take place after a series of hidden fool messages with an +;; intervening outgoing message followed immediately by a non-fool +;; message from the last non-hidden speaker (other than the user). +(ert-deftest erc-scenarios-match--hide-fools/stamp-both/fill-wrap/speak () + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "match/fools") + (erc-stamp--current-time 704591940) + (dumb-server (erc-d-run "localhost" t 'fill-wrap)) + (erc-stamp--tz t) + (erc-fill-function #'erc-fill-wrap) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (erc-timestamp-only-if-changed-flag nil) + (erc-fools '("bob")) + (erc-text-matched-hook '(erc-hide-fools)) + (erc-autojoin-channels-alist '((FooNet "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :password "changeme" + :nick "tester") + ;; Module `timestamp' follows `match' in insertion hooks. + (should (memq 'erc-add-timestamp + (memq 'erc-match-message + (default-value 'erc-insert-modify-hook)))) + (funcall expect 5 "This server is in debug mode"))) + + (ert-info ("Ensure lines featuring \"bob\" are invisible") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (should (funcall expect 10 " None better than")) + (should (funcall expect 10 " bob: Still we went")) + (should (funcall expect 10 " alice: Give me your hand")) + (erc-scenarios-common-say "hey") + (should (funcall expect 10 " You have paid the heavens")) + (should (funcall expect 10 " bob: In the sick air")) + (should (funcall expect 10 " The web of our life")) + + ;; Regression (see leading comment). + (should-not (equal "" (get-text-property (pos-bol) 'display))) + + ;; No remaining meta-data positions, no more timestamps. + (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts)) + ;; No remaining invisible messages. + (should-not (text-property-not-all (pos-bol) erc-insert-marker + 'invisible nil)) + + (should (funcall expect 10 "ERC>")) + (should-not (get-text-property (pos-bol) 'invisible)) + (should-not (get-text-property (point) 'invisible)))))) + +(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds) (should (eq erc-insert-timestamp-function #'erc-insert-timestamp-left-and-right)) @@ -295,21 +446,20 @@ erc-scenarios-match--stamp-both-invisible-fill-static (ert-info ("Line endings in Bob's messages are invisible") ;; The message proper has the `invisible' property `match-fools'. (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) - (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) - (mend (next-single-property-change mbeg 'erc-command))) + (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds))) - (if (/= 1 bob-utterance-counter) - (should-not (field-at-pos mend)) + (should (= (char-after mend) ?\n)) + (should-not (field-at-pos mbeg)) + (should-not (field-at-pos mend)) + (when (= 1 bob-utterance-counter) ;; For Bob's stamped message, check newline after stamp. - (should (eq (field-at-pos mend) 'erc-timestamp)) - (setq mend (field-end mend))) + (should (eq (field-at-pos (field-end mbeg)) 'erc-timestamp)) + (should (eq (field-at-pos (1- mend)) 'erc-timestamp))) - ;; The `erc-timestamp' property spans entire messages, - ;; including stamps and filled text, which makes for - ;; convenient traversal when `erc-stamp-mode' is enabled. - (should (get-text-property (pos-bol) 'erc-timestamp)) - (should (= (next-single-property-change (pos-bol) 'erc-timestamp) - mend)) + ;; The `erc-ts' property is present in the message's + ;; width 1 prop collection at its first char. + (should (get-text-property (pos-bol) 'erc-ts)) + (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts)) ;; Line ending has the `invisible' property `match-fools'. (should (= (char-after mend) ?\n)) @@ -327,12 +477,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static (forward-line -1) (goto-char (pos-bol)) (should (looking-at (rx "[Mon May 4 1992]"))) - ;; Date stamp has a combined `invisible' property value - ;; that extends until the start of the message proper. - (should (equal (get-text-property (point) 'invisible) - '(timestamp match-fools))) - (should (= (next-single-property-change (point) 'invisible) - (1+ (pos-eol)))))) + (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n + (funcall assert-ds))) ; "assert date stamp" (ert-info ("Folding preserved despite invisibility") ;; Message has a trailing time stamp, but it's been folded @@ -365,13 +511,45 @@ erc-scenarios-match--stamp-both-invisible-fill-static (ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () :tags '(:expensive-test) - (erc-scenarios-match--stamp-both-invisible-fill-static)) + (erc-scenarios-match--stamp-both-invisible-fill-static + + (lambda () + ;; Date stamp has an `invisible' property that starts from the + ;; newline delimiting the current and previous messages and + ;; extends until the stamp's final newline. It is not combined + ;; with the old value, `match-fools'. + (let ((delim-pos (- (point) 2))) + (should (equal 'timestamp (get-text-property delim-pos 'invisible))) + ;; Stamp-only invisibility ends before its last newline. + (should (= (text-property-not-all delim-pos (point-max) + 'invisible 'timestamp) + (match-end 0))))))) ; pos-eol (ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset () :tags '(:expensive-test) (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) - (erc-scenarios-match--stamp-both-invisible-fill-static)))) + (erc-scenarios-match--stamp-both-invisible-fill-static + + (lambda () + ;; Date stamp has an `invisible' property that covers its + ;; format string exactly. It is not combined with the old + ;; value, `match-fools'. + (let ((delim-prev (- (point) 2))) + (should-not (get-text-property delim-prev 'invisible)) + (should (eq 'erc-timestamp (field-at-pos (point)))) + (should (= (next-single-property-change delim-prev 'invisible) + (field-beginning (point)))) + (should (equal 'timestamp + (get-text-property (1- (point)) 'invisible))) + ;; Field stops before final newline because the date stamp + ;; is (now, as of ERC 5.6) its own standalone message. + (should (= ?\n (char-after (field-end (point))))) + ;; Stamp-only invisibility includes last newline. + (should (= (text-property-not-all (1- (point)) (point-max) + 'invisible 'timestamp) + (1+ (field-end (point))))))))))) ;;; erc-scenarios-match.el ends here diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 46a05729066..cc61d599387 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -279,7 +279,7 @@ erc-echo-timestamp (should-not erc-echo-timestamps) (should-not erc-stamp--last-stamp) - (insert (propertize "abc" 'erc-timestamp 433483200)) + (insert (propertize "a" 'erc-ts 433483200 'erc-msg 'msg) "bc") (goto-char (point-min)) (let ((inhibit-message t) (erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index ed89fd01d93..39135a8c2df 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -292,6 +292,8 @@ erc--refresh-prompt (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook + (erc-modules (remq 'stamp erc-modules)) + (erc-send-input-line-function #'ignore) (erc--input-review-functions erc--input-review-functions) erc-send-completed-hook) @@ -356,7 +358,8 @@ erc--refresh-prompt (should (looking-back "#chan@ServNet 11> ")) (should (= (point) erc-input-marker)) (insert "/query bob") - (erc-send-current-line) + (let (erc-modules) + (erc-send-current-line)) ;; Last command not inserted (save-excursion (forward-line -1) (should (looking-at " Howdy"))) @@ -1431,6 +1434,44 @@ erc-process-input-line (should-not calls)))))) +(ert-deftest erc--order-text-properties-from-hash () + (let ((table (map-into '((a . 1) + (erc-ts . 0) + (erc-msg . s005) + (b . 2) + (erc-cmd . 5) + (c . 3)) + 'hash-table))) + (with-temp-buffer + (erc-mode) + (insert "abc\n") + (add-text-properties 1 2 (erc--order-text-properties-from-hash table)) + (should (equal '( erc-msg s005 + erc-ts 0 + erc-cmd 5 + a 1 + b 2 + c 3) + (text-properties-at (point-min))))))) + +(ert-deftest erc--check-msg-prop () + (let ((erc--msg-props (map-into '((a . 1) (b . x)) 'hash-table))) + (should (eq 1 (erc--check-msg-prop 'a))) + (should (erc--check-msg-prop 'a 1)) + (should-not (erc--check-msg-prop 'a 2)) + + (should (eq 'x (erc--check-msg-prop 'b))) + (should (erc--check-msg-prop 'b 'x)) + (should-not (erc--check-msg-prop 'b 1)) + + (should (erc--check-msg-prop 'a '(1 42))) + (should-not (erc--check-msg-prop 'a '(2 42))) + + (let ((props '(42 x))) + (should (erc--check-msg-prop 'b props))) + (let ((v '(42 y))) + (should-not (erc--check-msg-prop 'b v))))) + (defmacro erc-tests--equal-including-properties (a b) (list (if (< emacs-major-version 29) 'ert-equal-including-properties 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 689bacc7012..238d8cc73c2 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 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 27 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 27 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 27 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 27 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 474 475 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 27 (8))) erc-command PRIVMSG) 475 480 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 480 486 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 487 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 27 0)) display #11="" erc-command PRIVMSG) 488 493 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 493 495 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 495 499 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 500 501 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 27 (6))) erc-command PRIVMSG) 501 504 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 504 512 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 513 514 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13=(space :width (- 27 0)) display #11# erc-command PRIVMSG) 514 517 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 517 519 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 519 524 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# erc-command PRIVMSG) 525 526 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14=(space :width (- 27 (8))) erc-command PRIVMSG) 526 531 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 531 538 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 539 540 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15=(space :width (- 27 0)) display #11# erc-command PRIVMSG) 540 545 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 545 547 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 547 551 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# erc-command PRIVMSG)) \ 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 unknown 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-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-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 1680332400 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-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-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-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-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-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-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-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 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 9fa23a7d332..d1ce9198e69 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 20 (erc-timestamp 0 line-prefix (space :width (- 29 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 29 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 29 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 29 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 29 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 474 475 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 29 (8))) erc-command PRIVMSG) 475 480 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 480 486 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 487 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 29 0)) display #11="" erc-command PRIVMSG) 488 493 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 493 495 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 495 499 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 500 501 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 29 (6))) erc-command PRIVMSG) 501 504 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 504 512 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 513 514 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13=(space :width (- 29 0)) display #11# erc-command PRIVMSG) 514 517 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 517 519 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 519 524 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# erc-command PRIVMSG) 525 526 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14=(space :width (- 29 (8))) erc-command PRIVMSG) 526 531 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 531 538 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 539 540 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15=(space :width (- 29 0)) display #11# erc-command PRIVMSG) 540 545 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 545 547 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 547 551 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# erc-command PRIVMSG)) \ 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 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown 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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg erc-ts 0 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-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#) 436 437 (erc-msg datestamp erc-ts 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 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-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (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-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 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 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 a3d533c87b5..d70184724ba 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* bob one\n two.\n* bob three\n four.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 27 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 27 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 27 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 27 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# invisible timestamp font-lock-face erc-timestamp-face)))) 474 476 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 27 (6))) erc-ctcp ACTION erc-command PRIVMSG) 476 479 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 479 483 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 484 485 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 27 (6))) erc-command PRIVMSG) 485 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 488 494 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 495 497 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11=(space :width (- 27 (2))) erc-ctcp ACTION erc-command PRIVMSG) 497 500 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 500 506 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 507 508 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 27 (6))) erc-command PRIVMSG) 508 511 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 511 518 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG)) \ 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* bob one\n two.\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 unknown 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-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-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 1680332400 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-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-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#)) \ 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 80c9e1d80f5..def97738ce6 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 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 27 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 27 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG)) \ 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 unknown 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-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-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 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 e675695f660..be3e2b33cfd 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 20 (erc-timestamp 0 line-prefix (space :width (- 29 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 29 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 29 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG)) \ 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 unknown 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-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-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 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 a6070c2e3ff..098257d0b49 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 20 (erc-timestamp 0 line-prefix (space :width (- 25 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 25 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 25 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG)) \ 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 unknown 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-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-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 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 80c9e1d80f5..def97738ce6 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 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 27 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 27 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG)) \ 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 unknown 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-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-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 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 2b8766c27f4..360b3dafafd 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 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (line-spacing 0.5) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 27 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 348 349 (line-spacing 0.5) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 27 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 435 436 (line-spacing 0.5) 436 437 (erc-timestamp 0 wrap-prefix #2# line-prefix #6=(space :width (- 27 0)) display #7="" erc-command PRIVMSG) 437 440 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# display #7# erc-command PRIVMSG) 440 442 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# display #7# erc-command PRIVMSG) 442 466 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 467 (line-spacing 0.5) 467 484 (erc-timestamp 0 wrap-prefix #2# line-prefix (space :width (- 27 (4)))) 485 502 (erc-timestamp 0 wrap-prefix #2# line-prefix (space :width (- 27 (4)))) 502 503 (line-spacing 0.5) 503 504 (erc-timestamp 0 wrap-prefix #2# line-prefix #8=(space :width (- 27 (6))) erc-command PRIVMSG) 504 507 (erc-timestamp 0 wrap-prefix #2# line-prefix #8# erc-command PRIVMSG) 507 525 (erc-timestamp 0 wrap-prefix #2# line-prefix #8# erc-command PRIVMSG)) \ 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 unknown 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-cmd PRIVMSG erc-ts 0 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-cmd PRIVMSG erc-ts 0 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-cmd PRIVMSG erc-ts 0 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 unknown 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 unknown 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-cmd PRIVMSG erc-ts 0 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#)) diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld index f62b65cd170..cd3537d3c94 100644 --- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld @@ -1 +1 @@ -#("\n\n[00:00]*** 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.\n[00:00] 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[00:00] alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG)) \ No newline at end of file +#("\n\n[00:00]*** 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.\n[00:00] 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[00:00] alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/match/fools/fill-wrap.eld b/test/lisp/erc/resources/match/fools/fill-wrap.eld new file mode 100644 index 00000000000..dff75ef9cd2 --- /dev/null +++ b/test/lisp/erc/resources/match/fools/fill-wrap.eld @@ -0,0 +1,41 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :changeme")) +((nick 1 "NICK tester")) +((user 1 "USER user 0 * :tester") + (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 6 "JOIN #chan") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan") + (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob") + (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")) + +((mode 5 "MODE #chan") + (0 ":irc.foonet.org 324 tester #chan +nt") + (0 ":irc.foonet.org 329 tester #chan 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!") + (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :None better than to let him fetch off his drum, which you hear him so confidently undertake to do.") + (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Still we went coupled and inseparable.") + (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Give me your hand. This hand is moist, my lady.")) + +((privmsg 5 "PRIVMSG #chan :hey") + (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 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: In the sick air: let not thy sword skip one.") + (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :The web of our life is of a mingled yarn, good and ill together: our virtues would be proud if our faults whipped them not; and our crimes would despair if they were not cherished by our virtues.")) commit a4bae965e06c982871cf01bb0fc3afc43c915bc5 Author: F. Jason Park Date: Tue Oct 3 23:15:40 2023 -0700 Easily excise list-valued text prop members in ERC * lisp/erc/erc.el (erc--remove-from-prop-value-list): New function for removing `invisible' and `face' prop members cleanly. * test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list, erc--remove-from-prop-value-list/many): New tests. (Bug#60936) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3a0337eae9a..c3312000ffd 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3079,6 +3079,30 @@ erc--merge-prop old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defun erc--remove-from-prop-value-list (from to prop val &optional object) + "Remove VAL from text prop value between FROM and TO. +If current value is VAL itself, remove the property entirely. +When VAL is a list, act as if this function were called +repeatedly with VAL set to each of VAL's members." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (when old + (if (setq new (and (consp old) (if (consp val) + (seq-difference old val) + (remq val old)))) + (put-text-property pos end prop + (if (cdr new) new (car new)) object) + (when (pcase val + ((pred consp) (or (consp old) (memq old val))) + (_ (if (consp old) (memq val old) (eq old val)))) + (remove-text-properties pos end (list prop nil) object)))) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + (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 0b88ad9cfa9..ed89fd01d93 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1475,6 +1475,175 @@ erc--merge-prop (when noninteractive (kill-buffer)))) +(ert-deftest erc--remove-from-prop-value-list () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Non-list match. + (insert "abc\n") + (put-text-property 1 2 'erc-test 'a) + (put-text-property 2 3 'erc-test 'b) + (put-text-property 3 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 1 2 (erc-test b) + 2 3 (erc-test c)))) + + (erc--remove-from-prop-value-list 1 4 'erc-test 'b) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'a) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "abc")) + + ;; List match. + (goto-char (point-min)) + (insert "def\n") + (put-text-property 1 2 'erc-test '(d x)) + (put-text-property 2 3 'erc-test '(e y)) + (put-text-property 3 4 'erc-test '(f z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x)) + 1 2 (erc-test (e y)) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x)) + 1 2 (erc-test e) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'd) + (erc--remove-from-prop-value-list 1 4 'erc-test 'f) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test x) + 1 2 (erc-test e) + 2 3 (erc-test z)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'e) + (erc--remove-from-prop-value-list 1 4 'erc-test 'z) + (erc--remove-from-prop-value-list 1 4 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "def")) + + ;; List match. + (goto-char (point-min)) + (insert "ghi\n") + (put-text-property 1 2 'erc-test '(g x)) + (put-text-property 2 3 'erc-test '(h x)) + (put-text-property 3 4 'erc-test '(i y)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test (g x)) + 1 2 (erc-test (h x)) + 2 3 (erc-test (i y))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test g) + 1 2 (erc-test h) + 2 3 (erc-test (i y))))) + (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed + (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 1 2 (erc-test h) + 2 3 (erc-test y)))) + + ;; Pathological (,c) case (hopefully not created by ERC) + (goto-char (point-min)) + (insert "jkl\n") + (put-text-property 1 2 'erc-test '(j x)) + (put-text-property 2 3 'erc-test '(k)) + (put-text-property 3 4 'erc-test '(k)) + (erc--remove-from-prop-value-list 1 4 'erc-test 'k) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x))))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc--remove-from-prop-value-list/many () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Non-list match. + (insert "abc\n") + (put-text-property 1 2 'erc-test 'a) + (put-text-property 2 3 'erc-test 'b) + (put-text-property 3 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 1 2 (erc-test b) + 2 3 (erc-test c)))) + + (erc--remove-from-prop-value-list 1 4 'erc-test '(a b)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'a) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(c)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "abc")) + + ;; List match. + (goto-char (point-min)) + (insert "def\n") + (put-text-property 1 2 'erc-test '(d x y)) + (put-text-property 2 3 'erc-test '(e y)) + (put-text-property 3 4 'erc-test '(f z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x y)) + 1 2 (erc-test (e y)) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test x) + 1 2 (erc-test e) + 2 3 (erc-test z)))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "def")) + + ;; Narrowed beg. + (goto-char (point-min)) + (insert "ghi\n") + (put-text-property 1 2 'erc-test '(g x)) + (put-text-property 2 3 'erc-test '(h x)) + (put-text-property 3 4 'erc-test '(i x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test (g x)) + 1 2 (erc-test (h x)) + 2 3 (erc-test (i x))))) + (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 1 2 (erc-test h) + 2 3 (erc-test (i x))))) + + ;; Narrowed middle. + (goto-char (point-min)) + (insert "jkl\n") + (put-text-property 1 2 'erc-test '(j x)) + (put-text-property 2 3 'erc-test '(k)) + (put-text-property 3 4 'erc-test '(l y z)) + (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" + 0 1 (erc-test (j x)) + 1 2 (erc-test (k)) + 2 3 (erc-test l)))) + + (when noninteractive + (kill-buffer)))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space commit f97fdf5e50ebf1aab236b4b8bbd09c203a56aac5 Author: F. Jason Park Date: Tue Oct 3 00:00:19 2023 -0700 Deprecate option erc-remove-parsed-property * etc/ERC-NEWS: Add entry for `erc-remove-parsed-property'. * lisp/erc/erc.el (erc-remove-parsed-property): Deprecate option because the potential for inadvertent self harm outweighs the potential benefits. Additionally, replicating this functionality via hooks is trivial. (erc-display-line-1): Remove quasi-deprecated `tags' property because the preferred format for `erc-response.tags' has changed, and ERC has never supported IRCv3 tags. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index dca9fff4e65..7c287b9de23 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -220,6 +220,14 @@ atop any message. The new companion option 'erc-echo-timestamp-zone' determines the default timezone when not specified with a prefix argument. +** Option 'erc-remove-parsed-property' deprecated. +This option's nil behavior serves no practical purpose yet has the +potential to degrade the user experience by competing for space with +forthcoming features powered by next generation extensions. Anyone +with a legitimate use for this option likely also possesses the +knowledge to rig up a suitable analog with minimal effort. That said, +the road to removal is long. + ** Option 'erc-warn-about-blank-lines' is more informative. Enabled by default, this option now produces more useful feedback whenever ERC rejects prompt input containing whitespace-only lines. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 60cce750355..3a0337eae9a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2893,9 +2893,18 @@ erc-remove-parsed-property The default is to remove it, since it causes ERC to take up extra memory. If you have code that relies on this property, then set -this option to nil." +this option to nil. + +Note that this option is deprecated because a value of nil is +impractical in prolonged sessions with more than a few channels. +Use `erc-insert-post-hook' or similar and the helper function +`erc-find-parsed-property' and friends to stash the current +`erc-response' object as needed. And instead of using this for +debugging purposes, try `erc-debug-irc-protocol'." :type 'boolean :group 'erc) +(make-obsolete-variable 'erc-remove-parsed-property + "impractical when non-nil" "30.1") (define-inline erc--assert-input-bounds () (inline-quote @@ -2972,7 +2981,7 @@ erc-display-line-1 (run-hooks 'erc-insert-post-hook) (when erc-remove-parsed-property (remove-text-properties (point-min) (point-max) - '(erc-parsed nil)))) + '(erc-parsed nil tags nil)))) (erc--refresh-prompt))))) (run-hooks 'erc-insert-done-hook) (erc-update-undo-list (- (or (marker-position (or erc--insert-marker commit 9c2f99b7d7325149c6926fa7ccc4e84fa7a695f6 Author: F. Jason Park Date: Wed Oct 4 20:39:03 2023 -0700 Use erc-display-message instead of erc-make-notice * lisp/erc/erc-backend.el (erc-server-JOIN): Let `erc-display-message' handle formatting instead of baking out a string. The text ultimately inserted remains unchanged, but forwarding the original `format-spec' arguments now has the side effect of influencing text properties, which conveys richer meaning for modules to act upon when doing things like deciding whether to hide a given message. * lisp/erc/erc.el (erc-cmd-IGNORE, erc-cmd-UNIGNORE, erc--unignore-user, erc-cmd-IDLE, erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Use `erc-display-message' with `notice' for the TYPE parameter instead of composing `erc-make-notice' and `erc-display-line'. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 2fb140f57ce..3d34fc97d00 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -164,7 +164,6 @@ erc-whowas-on-nosuchnick (declare-function erc-is-message-ctcp-p "erc" (message)) (declare-function erc-log-irc-protocol "erc" (string &optional outbound)) (declare-function erc-login "erc" nil) -(declare-function erc-make-notice "erc" (message)) (declare-function erc-network "erc-networks" nil) (declare-function erc-networks--id-given "erc-networks" (arg &rest args)) (declare-function erc-networks--id-reload "erc-networks" (arg &rest args)) @@ -1718,7 +1717,7 @@ erc--server-determine-join-display-context (if (string-match "^\\(.*\\)\^g.*$" chnl) (setq chnl (match-string 1 chnl))) (save-excursion - (let* ((str (cond + (let ((args (cond ;; If I have joined a channel ((erc-current-nick-p nick) (let ((erc--display-context @@ -1735,18 +1734,15 @@ erc--server-determine-join-display-context (erc-channel-begin-receiving-names)) (erc-update-mode-line) (run-hooks 'erc-join-hook) - (erc-make-notice - (erc-format-message 'JOIN-you ?c chnl))) + (list 'JOIN-you ?c chnl)) (t (setq buffer (erc-get-buffer chnl proc)) - (erc-make-notice - (erc-format-message - 'JOIN ?n nick ?u login ?h host ?c chnl)))))) + (list 'JOIN ?n nick ?u login ?h host ?c chnl))))) (when buffer (set-buffer buffer)) (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login) ;; on join, we want to stay in the new channel buffer ;;(set-buffer ob) - (erc-display-message parsed nil buffer str)))))) + (apply #'erc-display-message parsed 'notice buffer args)))))) (define-erc-response-handler (KICK) "Handle kick messages received from the server." nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 79b4544a3e4..60cce750355 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3609,16 +3609,14 @@ erc-cmd-IGNORE (run-at-time timeout nil (lambda () (erc--unignore-user user buffer)))) - (erc-display-line - (erc-make-notice (format "Now ignoring %s" user)) - 'active) + (erc-display-message nil 'notice 'active + (format "Now ignoring %s" user)) (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))) (if (null (erc-with-server-buffer erc-ignore-list)) - (erc-display-line (erc-make-notice "Ignore list is empty") 'active) - (erc-display-line (erc-make-notice "Ignore list:") 'active) + (erc-display-message nil 'notice 'active "Ignore list is empty") + (erc-display-message nil 'notice 'active "Ignore list:") (mapc (lambda (item) - (erc-display-line (erc-make-notice item) - 'active)) + (erc-display-message nil 'notice 'active item)) (erc-with-server-buffer erc-ignore-list)))) t) @@ -3632,9 +3630,8 @@ erc-cmd-UNIGNORE (unless (y-or-n-p (format "Remove this regexp (%s)? " ignored-nick)) (setq ignored-nick nil)) - (erc-display-line - (erc-make-notice (format "%s is not currently ignored!" user)) - 'active))) + (erc-display-message nil 'notice 'active + (format "%s is not currently ignored!" user)))) (when ignored-nick (erc--unignore-user user (current-buffer)))) t) @@ -3642,9 +3639,8 @@ erc-cmd-UNIGNORE (defun erc--unignore-user (user buffer) (when (buffer-live-p buffer) (with-current-buffer buffer - (erc-display-line - (erc-make-notice (format "No longer ignoring %s" user)) - 'active) + (erc-display-message nil 'notice 'active + (format "No longer ignoring %s" user)) (erc-with-server-buffer (setq erc-ignore-list (delete user erc-ignore-list)))))) @@ -4129,12 +4125,10 @@ erc-cmd-IDLE (string-to-number (cl-third (erc-response.command-args parsed))))) - (erc-display-line - (erc-make-notice + (erc-display-message nil 'notice origbuf (format "%s has been idle for %s." (erc-string-no-properties nick) (erc-seconds-to-string idleseconds))) - origbuf) t))) 'erc-server-317-functions) symlist) @@ -4683,8 +4677,7 @@ erc-cmd-BANLIST (cond ((not (erc-channel-p chnl)) - (erc-display-line (erc-make-notice "You're not on a channel\n") - 'active)) + (erc-display-message nil 'notice 'active "You're not on a channel\n")) ((not (get 'erc-channel-banlist 'received-from-server)) (let ((old-367-hook erc-server-367-functions)) @@ -4703,9 +4696,8 @@ erc-cmd-BANLIST (erc-server-send (format "MODE %s b" chnl))))) ((null erc-channel-banlist) - (erc-display-line (erc-make-notice - (format "No bans for channel: %s\n" chnl)) - 'active) + (erc-display-message nil 'notice 'active + (format "No bans for channel: %s\n" chnl)) (put 'erc-channel-banlist 'received-from-server nil)) (t @@ -4719,10 +4711,9 @@ erc-cmd-BANLIST "%-" (number-to-string (/ erc-fill-column 2)) "s" "%" (number-to-string (/ erc-fill-column 2)) "s"))) - (erc-display-line - (erc-make-notice (format "Ban list for channel: %s\n" - (erc-default-target))) - 'active) + (erc-display-message + nil 'notice 'active + (format "Ban list for channel: %s\n" (erc-default-target))) (erc-display-line separator 'active) (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) @@ -4739,8 +4730,7 @@ erc-cmd-BANLIST 'active)) erc-channel-banlist) - (erc-display-line (erc-make-notice "End of Ban list") - 'active) + (erc-display-message nil 'notice 'active "End of Ban list") (put 'erc-channel-banlist 'received-from-server nil))))) t) @@ -4754,9 +4744,7 @@ erc-cmd-MASSUNBAN (cond ((not (erc-channel-p chnl)) - (erc-display-line - (erc-make-notice "You're not on a channel\n") - 'active)) + (erc-display-message nil 'notice 'active "You're not on a channel\n")) ((not (get 'erc-channel-banlist 'received-from-server)) (let ((old-367-hook erc-server-367-functions)) commit 1950ddebacb73fdc17ebec4da24d74b628c3e0ae Author: F. Jason Park Date: Mon Oct 2 22:59:22 2023 -0700 Allow spoofing process marker in erc-display-line-1 * lisp/erc/erc.el (erc--insert-marker): New internal variable for overriding `erc-insert-marker' when displaying messages at a non-default location in the buffer. (erc-display-line-1): Favor `erc--insert-marker' over `erc-insert-marker' when non-nil. ; * test/lisp/erc/resources/base/assoc/multi-net/barnet.eld: Timeouts. ; * test/lisp/erc/resources/base/assoc/multi-net/foonet.eld: Timeouts. ; * test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld: Timeouts. ; * test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld: Timeouts. ; * test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld: Timeouts. ; * test/lisp/erc/resources/sasl/scram-sha-1.eld: Timeouts. ; * test/lisp/erc/resources/sasl/scram-sha-256.eld: Timeouts. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 87abe2a133b..79b4544a3e4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2925,6 +2925,9 @@ erc--refresh-prompt (delete-region (point) (1- erc-input-marker)))) (run-hooks 'erc--refresh-prompt-hook))) +(defvar erc--insert-marker nil + "Internal override for `erc-insert-marker'.") + (defun erc-display-line-1 (string buffer) "Display STRING in `erc-mode' BUFFER. Auxiliary function used in `erc-display-line'. The line gets filtered to @@ -2948,6 +2951,8 @@ erc-display-line-1 (format "%s" buffer))) (setq erc-insert-this t) (run-hook-with-args 'erc-insert-pre-hook string) + (setq insert-position (marker-position (or erc--insert-marker + erc-insert-marker))) (if (null erc-insert-this) ;; Leave erc-insert-this set to t as much as possible. Fran ;; Litterio has seen erc-insert-this set to nil while @@ -2970,7 +2975,8 @@ erc-display-line-1 '(erc-parsed nil)))) (erc--refresh-prompt))))) (run-hooks 'erc-insert-done-hook) - (erc-update-undo-list (- (or (marker-position erc-insert-marker) + (erc-update-undo-list (- (or (marker-position (or erc--insert-marker + erc-insert-marker)) (point-max)) insert-position)))))) diff --git a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld index c62a22a11c7..4c2b1d61e24 100644 --- a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld +++ b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld @@ -1,7 +1,7 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (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") @@ -18,16 +18,16 @@ (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 8 "MODE tester +i") +((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 2 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #chan") (0 ":irc.barnet.org 353 tester = #chan :@mike joe tester") (0 ":irc.barnet.org 366 tester #chan :End of NAMES list")) -((mode 2 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620104779") (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :tester, welcome!") diff --git a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld index f30b7deca11..bfa324642ce 100644 --- a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld +++ b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld @@ -1,7 +1,7 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (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") @@ -18,16 +18,16 @@ (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 8 "MODE tester +i") +((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 2 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan") (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob") (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")) -((mode 2 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620104779") (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!") diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld index 686a47f68a3..04959954c4f 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld @@ -22,14 +22,14 @@ (0 ":irc.znc.in 306 tester :You have been marked as being away") (0 ":irc.barnet.org 305 tester :You are no longer marked as being away")) -((join 1 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan") (0 ":irc.barnet.org 353 tester = #chan :@joe mike tester") (0 ":irc.barnet.org 366 tester #chan :End of NAMES list") (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!") (0 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!")) -((mode 1 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620805269") (0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: But you have outfaced them all.") diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld index b99621cc311..d0445cd1dd5 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :foonet:changeme")) +((pass 10 "PASS :foonet:changeme")) ((nick 1 "NICK tester")) ((user 1 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") @@ -22,14 +22,14 @@ (0 ":irc.znc.in 306 tester :You have been marked as being away") (0 ":irc.foonet.org 305 tester :You are no longer marked as being away")) -((join 1 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":tester!~u@ertp7idh9jtgi.irc JOIN #chan") (0 ":irc.foonet.org 353 tester = #chan :@alice bob tester") (0 ":irc.foonet.org 366 tester #chan :End of NAMES list") (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!") (0 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!")) -((mode 1 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620805271") (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: He cannot be heard of. Out of doubt he is transported.") 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 4855c178861..e5532980644 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld @@ -24,7 +24,7 @@ (0 ":irc.foonet.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") (0 ":irc.foonet.org 366 alice #chan :End of NAMES list")) -((mode 2 "MODE #chan") +((mode 3 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620805269") (0.1 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: Yes, a dozen; and as many to the vantage, as would store the world they played for.") diff --git a/test/lisp/erc/resources/sasl/scram-sha-1.eld b/test/lisp/erc/resources/sasl/scram-sha-1.eld index 49980e9e12a..d6adf529c5d 100644 --- a/test/lisp/erc/resources/sasl/scram-sha-1.eld +++ b/test/lisp/erc/resources/sasl/scram-sha-1.eld @@ -42,6 +42,6 @@ (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") (0 ":jaguar.test 376 jilles :End of message of the day.")) -((mode-user 1.2 "MODE jilles +i") +((mode-user 10 "MODE jilles +i") (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri") (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/erc/resources/sasl/scram-sha-256.eld b/test/lisp/erc/resources/sasl/scram-sha-256.eld index 74de9a23ecf..8b16f7109cf 100644 --- a/test/lisp/erc/resources/sasl/scram-sha-256.eld +++ b/test/lisp/erc/resources/sasl/scram-sha-256.eld @@ -42,6 +42,6 @@ (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") (0 ":jaguar.test 376 jilles :End of message of the day.")) -((mode-user 1.2 "MODE jilles +i") +((mode-user 10 "MODE jilles +i") (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri") (0 ":jaguar.test 306 jilles :You have been marked as being away")) commit d46c016fbd09cbce9ef23fe2b49d4fb5fc3b2b16 Author: F. Jason Park Date: Fri Oct 6 17:34:04 2023 -0700 Sort and dedupe when loading modules in erc-open * doc/misc/erc.texi: Add new subheading "Module Loading" under the "Modules" chapter. * lisp/erc/erc.el (erc--sort-modules): New utility function to sort and dedupe modules. (erc-modules): In `custom-set' function, factor out collation into separate utility `erc--sort-modules'. (erc-update-modules): Call `erc--update-modules' with an argument, the current value of `erc-modules'. (erc--aberrant-modules): New variable, a list of symbols whose modules ERC suspects of being incorrectly defined. (erc--warn-about-aberrant-modules): New function to print an error message and emit a warning prior to connecting when `erc--aberrant-modules' is non-nil. (erc--find-mode): Make heuristic more robust by always checking for a mode activation command rather than just a state variable. This fixes a compatibility bug, new in 5.6, affecting third-party modules that autoload module definitions instead of their corresponding mode-activation commands. (erc--update-modules): Add new positional argument `modules'. (erc--setup-buffer-hook): Add new default member, `erc--warn-about-aberrant-modules'. (erc-open): Pass sorted `erc-modules' to `erc--update-modules'. * test/lisp/erc/erc-tests.el (erc--sort-modules): New test. (erc-tests--update-modules): New fixture. (erc--update-modules): Remove and rework as three separate tests dedicated to specific contexts. The existing one had poor coverage and was difficult, if not impossible, to follow. (erc--update-modules/unknown, erc--update-modules/local, erc--update-modules/realistic): New tests. (Bug#57955) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3297d8b17f0..3bfa240cacc 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -653,6 +653,41 @@ Modules @code{erc-modules}. +@anchor{Module Loading} +@subheading Module Loading +@cindex module loading + +ERC loads internal modules in alphabetical order and third-party +modules as they appear in @code{erc-modules}. When defining your own +module, take care to ensure ERC can find it. An easy way to do that +is by mimicking the example in the doc string for +@code{define-erc-module}. For historical reasons, ERC also falls back +to @code{require}ing features. For example, if some module +@code{} in @code{erc-modules} lacks a corresponding +@code{erc--mode} command, ERC will attempt to load the library +@code{erc-} prior to connecting. If this fails, ERC signals an +error. Users wanting to define modules in an init files should +@code{(provide 'erc-)} somewhere to placate ERC. Dynamically +generating modules on the fly is not supported. + +Sometimes, packages attempt to autoload a module's definition instead +of its minor-mode command, which breaks the link between the library +and the module. This means that enabling the mode by invoking its +command toggle isn't enough to load its defining library. Such +packages should instead only supply autoload cookies featuring an +explicit @code{autoload} form for their module's minor-mode command. +As mentioned above, packages can also usually avoid autoload cookies +entirely so long as their module's prefixed name matches that of its +defining library and the latter's provided feature. + +Packages have also been seen to specify unnecessary top-level +@code{eval-after-load} forms, which end up being ineffective in most +cases. Another unfortunate practice is mutating @code{erc-modules} +itself in an autoloaded form. Doing this tricks Customize into +displaying the widget for @code{erc-modules} incorrectly, with +built-in modules moved from the predefined checklist to the +user-provided free-form area. + @c PRE5_4: Document every option of every module in its own subnode diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 16651b41eef..87abe2a133b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2004,6 +2004,14 @@ erc-migrate-modules ;; each item is in the format '(old . new) (delete-dups (mapcar #'erc--normalize-module-symbol mods))) +(defun erc--sort-modules (modules) + "Return a copy of MODULES, deduped and led by sorted built-ins." + (let (built-in third-party) + (dolist (mod modules) + (setq mod (erc--normalize-module-symbol mod)) + (cl-pushnew mod (if (get mod 'erc--module) built-in third-party))) + `(,@(sort built-in #'string-lessp) ,@(nreverse third-party)))) + (defcustom erc-modules '( autojoin button completion fill imenu irccontrols list match menu move-to-prompt netsplit networks noncommands readonly ring stamp track) @@ -2039,16 +2047,10 @@ erc-modules (when (symbol-value f) (funcall f 0)) (kill-local-variable f))))))))) - (let (built-in third-party) - (dolist (v val) - (setq v (erc--normalize-module-symbol v)) - (if (get v 'erc--module) - (push v built-in) - (push v third-party))) - ;; Calling `set-default-toplevel-value' complicates testing - (set sym (append (sort built-in #'string-lessp) - (nreverse third-party)))) + ;; Calling `set-default-toplevel-value' complicates testing. + (set sym (erc--sort-modules val)) ;; this test is for the case where erc hasn't been loaded yet + ;; FIXME explain how this ^ can occur or remove comment. (when (fboundp 'erc-update-modules) (unless erc--inside-mode-toggle-p (erc-update-modules)))) @@ -2112,15 +2114,29 @@ erc-modules (defun erc-update-modules () "Enable minor mode for every module in `erc-modules'. Except ignore all local modules, which were introduced in ERC 5.5." - (erc--update-modules) + (erc--update-modules erc-modules) nil) +(defvar erc--aberrant-modules nil + "Modules suspected of being improperly loaded.") + +(defun erc--warn-about-aberrant-modules () + (when (and erc--aberrant-modules (not erc--target)) + (erc-button--display-error-notice-with-keys-and-warn + "The following modules exhibited strange loading behavior: " + (mapconcat (lambda (s) (format "`%s'" s)) erc--aberrant-modules ", ") + ". Please contact ERC with \\[erc-bug] if you believe this to be untrue." + " See Info:\"(erc) Module Loading\" for more.") + (setq erc--aberrant-modules nil))) + (defun erc--find-mode (sym) (setq sym (erc--normalize-module-symbol sym)) - (if-let* ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode"))) - ((or (boundp mode) - (and (fboundp mode) - (autoload-do-load (symbol-function mode) mode))))) + (if-let ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode"))) + ((and (fboundp mode) + (autoload-do-load (symbol-function mode) mode))) + ((or (get sym 'erc--module) + (symbol-file mode) + (ignore (cl-pushnew sym erc--aberrant-modules))))) mode (and (require (or (get sym 'erc--feature) (intern (concat "erc-" (symbol-name sym)))) @@ -2129,9 +2145,9 @@ erc--find-mode (fboundp mode) mode))) -(defun erc--update-modules () +(defun erc--update-modules (modules) (let (local-modes) - (dolist (module erc-modules local-modes) + (dolist (module modules local-modes) (if-let ((mode (erc--find-mode module))) (if (custom-variable-p mode) (funcall mode 1) @@ -2158,7 +2174,7 @@ erc--updating-modules-p confidently call (erc-foo-mode 1) without having to learn anything about the dependency's implementation.") -(defvar erc--setup-buffer-hook nil +(defvar erc--setup-buffer-hook '(erc--warn-about-aberrant-modules) "Internal hook for module setup involving windows and frames.") (defvar erc--display-context nil @@ -2315,7 +2331,8 @@ erc-open (setq old-point (point)) (setq delayed-modules (erc--merge-local-modes (let ((erc--updating-modules-p t)) - (erc--update-modules)) + (erc--update-modules + (erc--sort-modules erc-modules))) (or erc--server-reconnecting erc--target-priors))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 64b503832f3..0b88ad9cfa9 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2293,65 +2293,130 @@ erc--find-group--real (should (eq (erc--find-group 'smiley nil) 'erc)) (should (eq (erc--find-group 'unmorse nil) 'erc))) -(ert-deftest erc--update-modules () - (let (calls - erc-modules - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) +(ert-deftest erc--sort-modules () + (should (equal (erc--sort-modules '(networks foo fill bar fill stamp bar)) + ;; Third-party mods appear in original order. + '(fill networks stamp foo bar)))) + +(defun erc-tests--update-modules (fn) + (let* ((calls nil) + (custom-modes nil) + (on-load nil) + + (get-calls (lambda () (prog1 (nreverse calls) (setq calls nil)))) + + (add-onload (lambda (m k v) + (put (intern m) 'erc--feature k) + (push (cons k (lambda () (funcall v m))) on-load))) - ;; This `lbaz' module is unknown, so ERC looks for it via the - ;; symbol proerty `erc--feature' and, failing that, by - ;; `require'ing its "erc-" prefixed symbol. - (should-not (intern-soft "erc-lbaz-mode")) + (mk-cmd (lambda (module) + (let ((mode (intern (format "erc-%s-mode" module)))) + (fset mode (lambda (n) (push (cons mode n) calls)))))) + + (mk-builtin (lambda (module-string) + (let ((s (intern module-string))) + (put s 'erc--module s)))) + + (mk-global (lambda (module) + (push (intern (format "erc-%s-mode" module)) + custom-modes)))) (cl-letf (((symbol-function 'require) (lambda (s &rest _) - (when (eq s 'erc--lbaz-feature) - (fset (intern "erc-lbaz-mode") ; local module - (lambda (n) (push (cons 'lbaz n) calls)))) - (push s calls))) - - ;; Local modules - ((symbol-function 'erc-lbar-mode) - (lambda (n) (push (cons 'lbar n) calls))) - ((get 'lbaz 'erc--feature) 'erc--lbaz-feature) - - ;; Global modules - ((symbol-function 'erc-gfoo-mode) - (lambda (n) (push (cons 'gfoo n) calls))) - ((get 'erc-gfoo-mode 'standard-value) 'ignore) + ;; Simulate library being loaded, things defined. + (when-let ((h (alist-get s on-load))) (funcall h)) + (push (cons 'req s) calls))) + + ;; Spoof global module detection. + ((symbol-function 'custom-variable-p) + (lambda (v) (memq v custom-modes)))) + + (funcall fn get-calls add-onload mk-cmd mk-builtin mk-global)) + (should-not erc--aberrant-modules))) + +(ert-deftest erc--update-modules/unknown () + (erc-tests--update-modules + + (lambda (get-calls _ mk-cmd _ mk-global) + + (ert-info ("Baseline") + (let* ((erc-modules '(foo)) + (obarray (obarray-make)) + (err (should-error (erc--update-modules erc-modules)))) + (should (equal (cadr err) "`foo' is not a known ERC module")) + (should (equal (funcall get-calls) + `((req . ,(intern-soft "erc-foo"))))))) + + ;; Module's mode command exists but lacks an associated file. + (ert-info ("Bad autoload flagged as suspect") + (should-not erc--aberrant-modules) + (let* ((erc--aberrant-modules nil) + (obarray (obarray-make)) + (erc-modules (list (intern "foo")))) + + ;; Create a mode activation command. + (funcall mk-cmd "foo") + + ;; Make the mode var global. + (funcall mk-global "foo") + + ;; No local modules to return. + (should-not (erc--update-modules erc-modules)) + (should (equal (mapcar #'prin1-to-string erc--aberrant-modules) + '("foo"))) + ;; ERC requires the library via prefixed module name. + (should (equal (mapcar #'prin1-to-string (funcall get-calls)) + `("(req . erc-foo)" "(erc-foo-mode . 1)")))))))) + +;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to +;; load its defining library, first via the symbol property +;; `erc--feature', and then via an "erc-" prefixed symbol. +(ert-deftest erc--update-modules/local () + (erc-tests--update-modules + + (lambda (get-calls add-onload mk-cmd mk-builtin mk-global) + + (let* ((obarray (obarray-make 20)) + (erc-modules (mapcar #'intern '("glo" "lo1" "lo2")))) + + ;; Create a global and a local module. + (mapc mk-cmd '("glo" "lo1")) + (mapc mk-builtin '("glo" "lo1")) + (funcall mk-global "glo") + (funcall add-onload "lo2" 'explicit-feature-lib mk-cmd) + + ;; Returns local modules. + (should (equal (mapcar #'symbol-name (erc--update-modules erc-modules)) + '("erc-lo2-mode" "erc-lo1-mode"))) + + ;; Requiring `erc-lo2' defines `erc-lo2-mode'. + (should (equal (mapcar #'prin1-to-string (funcall get-calls)) + `("(erc-glo-mode . 1)" + "(req . explicit-feature-lib)"))))))) + +(ert-deftest erc--update-modules/realistic () + (let ((calls nil) + ;; Module `pcomplete' "resolves" to `completion'. + (erc-modules '(pcomplete autojoin networks))) + (cl-letf (((symbol-function 'require) + (lambda (s &rest _) (push (cons 'req s) calls))) + + ;; Spoof global module detection. + ((symbol-function 'custom-variable-p) + (lambda (v) + (memq v '(erc-autojoin-mode erc-networks-mode + erc-completion-mode)))) + ;; Mock and spy real builtins. ((symbol-function 'erc-autojoin-mode) (lambda (n) (push (cons 'autojoin n) calls))) - ((get 'erc-autojoin-mode 'standard-value) 'ignore) ((symbol-function 'erc-networks-mode) (lambda (n) (push (cons 'networks n) calls))) - ((get 'erc-networks-mode 'standard-value) 'ignore) ((symbol-function 'erc-completion-mode) - (lambda (n) (push (cons 'completion n) calls))) - ((get 'erc-completion-mode 'standard-value) 'ignore)) - - (ert-info ("Unknown module") - (setq erc-modules '(lfoo)) - (should-error (erc--update-modules)) - (should (equal (pop calls) 'erc-lfoo)) - (should-not calls)) + (lambda (n) (push (cons 'completion n) calls)))) - (ert-info ("Local modules") - (setq erc-modules '(gfoo lbar lbaz)) - ;; Don't expose the mode here - (should (equal (mapcar #'symbol-name (erc--update-modules)) - '("erc-lbaz-mode" "erc-lbar-mode"))) - ;; Lbaz required because unknown. - (should (equal (nreverse calls) '((gfoo . 1) erc--lbaz-feature))) - (fmakunbound (intern "erc-lbaz-mode")) - (unintern (intern "erc-lbaz-mode") obarray) - (setq calls nil)) - - (ert-info ("Global modules") ; `pcomplete' resolved to `completion' - (setq erc-modules '(pcomplete autojoin networks)) - (should-not (erc--update-modules)) ; no locals - (should (equal (nreverse calls) - '((completion . 1) (autojoin . 1) (networks . 1)))) - (setq calls nil))))) + (should-not (erc--update-modules erc-modules)) ; no locals + (should (equal (nreverse calls) + '((completion . 1) (autojoin . 1) (networks . 1))))))) (ert-deftest erc--merge-local-modes () (cl-letf (((get 'erc-b-mode 'erc-module) 'b) commit 9120d7a32ea4906d7c9460add31d37c3ca38931e Author: F. Jason Park Date: Thu Oct 5 00:16:46 2023 -0700 Honor nil values in erc--restore-initialize-priors * lisp/erc/erc.el (erc--restore-initialize-priors): Don't produce invalid "empty" `setq' form when parameter VARS contains defaults that initialize to nil. This function is mainly used by local modules, which were first made usable in ERC 5.5 (bug#57955). * test/lisp/erc/erc-tests.el (erc--restore-initialize-priors): Fix expected expansion, which is now slightly leaner. (Bug#60936) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fb236f1f189..16651b41eef 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1366,16 +1366,15 @@ erc--target-priors (defmacro erc--restore-initialize-priors (mode &rest vars) "Restore local VARS for MODE from a previous session." (declare (indent 1)) - (let ((existing (make-symbol "existing")) + (let ((priors (make-symbol "priors")) + (initp (make-symbol "initp")) ;; - restore initialize) - (while-let ((k (pop vars)) (v (pop vars))) - (push `(,k (alist-get ',k ,existing)) restore) - (push `(,k ,v) initialize)) - `(if-let* ((,existing (or erc--server-reconnecting erc--target-priors)) - ((alist-get ',mode ,existing))) - (setq ,@(mapcan #'identity (nreverse restore))) - (setq ,@(mapcan #'identity (nreverse initialize)))))) + forms) + (while-let ((k (pop vars))) + (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)))) + (setq ,@(mapcan #'identity (nreverse forms)))))) (defun erc--target-from-string (string) "Construct an `erc--target' variant from STRING." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8a68eca6196..64b503832f3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -796,18 +796,15 @@ erc--valid-local-channel-p (should (erc--valid-local-channel-p "&local"))))) (ert-deftest erc--restore-initialize-priors () - ;; This `pcase' expands to 100+k. Guess we could do something like - ;; (and `(,_ ((,e . ,_) . ,_) . ,_) v) first and then return a - ;; (equal `(if-let* ((,e ...)...)...) v) to cut it down to < 1k. (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode foo (ignore 1 2 3) - bar #'spam)) - (`(if-let* ((,e (or erc--server-reconnecting erc--target-priors)) - ((alist-get 'erc-my-mode ,e))) - (setq foo (alist-get 'foo ,e) - bar (alist-get 'bar ,e)) - (setq foo (ignore 1 2 3) - bar #'spam)) + bar #'spam + baz nil)) + (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) + (,q (and ,p (alist-get 'erc-my-mode ,p)))) + (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))) t)))) (ert-deftest erc--target-from-string () commit 328a985651aaa020cda343d3589561c42ac94284 Author: F. Jason Park Date: Tue Oct 10 18:14:53 2023 -0700 Skip post-minibuffer restore in erc-scrolltobottom-all * etc/ERC-NEWS: Remove mention of `erc-scrolltobottom-relaxed' in entry for module `scrolltobottom'. * lisp/erc/erc-goodies.el (erc-input-line-position): Fix mention of abandoned option `erc-scrolltobottom-relaxed'. (erc-scrolltobottom-all): Subsume option `erc-scrolltobottom-relaxed' by recognizing a third value state, `relaxed'. A separate option would make more sense if other options also depended on `erc-scrolltobottom-all'. (erc-scrolltobottom-relaxed): Remove redundant option, which was to be new in ERC 5.6. (erc-scrolltobottom-enable, erc-scrolltobottom-mode): Warn if user attempts to enable `erc-scrolltobottom-all' on Emacs 27, which is not supported. (erc--scrolltobottom-relaxed-commands, erc--scrolltobottom-post-force-commands, erc--scrolltobottom-relaxed-skip-commands): Remove unused variables. (erc--scrolltobottom-on-pre-command, erc--scrolltobottom-on-pre-command-relaxed, erc--scrolltobottom-on-post-command-relaxed): Remove unused functions. (erc--scrolltobottom-on-post-command): Remove conditional branch for dealing with a non-nil `erc--scrolltobottom-window-info'. (erc--scrolltobottom-setup): Convert from generic to normal function and remove setup and teardown for unused hooks. Set variable `read-minibuffer-restore-windows' locally when option `erc-scrolltobottom-all' is non-nil. (erc--scrolltobottom-on-pre-insert): Replace reference to subsumed option `erc-scrolltobottom-relaxed' with new value `relaxed' for existing option `erc-scrolltobottom-all'. * test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el (erc-scenarios-scrolltobottom--relaxed): Replace option `erc-scrolltobottom-relaxed' with new value `relaxed' for `erc-scrolltobottom-all'. (Bug#64855) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index fadd97b65df..dca9fff4e65 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -178,14 +178,13 @@ been restored with a slightly revised role contingent on a few assumptions explained in its doc string. For clarity, it has been renamed 'erc-ensure-target-buffer-on-privmsg'. -** Module 'scrolltobottom' can attempt to be more aggressive. -Enabling the experimental option 'erc-scrolltobottom-all' tells -'scrolltobottom' to be more vigilant about staking down the input area -and to do so in all ERC windows. The dependent option -'erc-scrolltobottom-relaxed', also experimental, makes ERC's prompt -stationary wherever it happens to reside instead of forcing it to the -bottom of a window. That is, new input appears above the prompt, -scrolling existing messages upward to compensate. +** Module 'scrolltobottom' now optionally more aggressive. +Enabling the experimental option 'erc-scrolltobottom-all' makes ERC +more vigilant about staking down the input area in all ERC windows. +And the option's 'relaxed' variant makes ERC's prompt stationary +wherever it happens to reside instead of forcing it to the bottom of a +window, meaning new input appears above the prompt, scrolling existing +messages upward to compensate. ** Subtle changes in two fundamental faces. Users of the default theme may notice that 'erc-action-face' and diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index b77176d8ac7..863429de202 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -44,45 +44,46 @@ erc-input-line-position This should be an integer specifying the line of the buffer on which the input line should stay. A value of \"-1\" would keep the input line positioned on the last line in the buffer. This is passed as an -argument to `recenter', unless `erc-scrolltobottom-relaxed' is -non-nil, in which case, ERC interprets it as additional lines to -scroll down by per message insertion (minus one for the prompt)." +argument to `recenter', unless `erc-scrolltobottom-all' is +`relaxed', in which case, ERC interprets it as additional lines +to scroll down by per message insertion (minus one for the +prompt)." :group 'erc-display :type '(choice integer (const nil))) (defcustom erc-scrolltobottom-all nil "Whether to scroll all windows or just the selected one. -A value of nil preserves pre-5.6 behavior, in which scrolling -only affects the selected window. Users should consider its -non-nil behavior experimental for the time being. Note also that ERC expects this option to be configured before module -initialization." +initialization. A value of nil preserves pre-5.6 behavior, in +which scrolling only affects the selected window. A value of t +means ERC attempts to recenter all visible windows whose point +resides in the input area. + +A value of `relaxed' tells ERC to forgo forcing prompt to the +bottom of the window. When point is at the prompt, ERC scrolls +the window up when inserting messages, making the prompt appear +stationary. Users who find this effect too \"stagnant\" can +adjust the option `erc-input-line-position', borrowed here to +express a scroll step offset. Setting that value to zero lets +the prompt drift toward the bottom by one line per message, which +is generally slow enough not to distract while composing input. +Of course, this doesn't apply when receiving a large influx of +messages, such as after typing \"/msg NickServ help\". + +Note that users should consider this option's non-nil behavior to +be experimental. It currently only works with Emacs 28+." :group 'erc-display :package-version '(ERC . "5.6") ; FIXME sync on release - :type 'boolean) - -(defcustom erc-scrolltobottom-relaxed nil - "Whether to forgo forcing prompt to the bottom of the window. -When non-nil, and point is at the prompt, ERC scrolls the window -up when inserting messages, making the prompt appear stationary. -Users who find this effect too \"stagnant\" can adjust the option -`erc-input-line-position', which ERC borrows to express a scroll -step offset when this option is non-nil. Setting that value to -zero lets the prompt drift toward the bottom by one line per -message, which is generally slow enough not to distract while -composing input. Of course, this doesn't apply when receiving a -large influx of messages, such as after typing \"/msg NickServ -help\". Note that ERC only considers this option when the -experimental companion option `erc-scrolltobottom-all' is enabled -and, only then, during module setup." - :group 'erc-display - :package-version '(ERC . "5.6") ; FIXME sync on release - :type 'boolean) + :type '(choice boolean (const relaxed))) ;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) (define-erc-module scrolltobottom nil "This mode causes the prompt to stay at the end of the window." ((add-hook 'erc-mode-hook #'erc--scrolltobottom-setup) + (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)) (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn @@ -93,25 +94,17 @@ scrolltobottom (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) ((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup) (erc-buffer-do #'erc--scrolltobottom-setup) - (if erc-scrolltobottom-all - (progn - (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) - (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) - (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) - (remove-hook 'erc-pre-send-functions - #'erc--scrolltobottom-on-pre-insert)) - (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom)))) + (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) + (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) + (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) + (remove-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert) + (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) (defun erc-possibly-scroll-to-bottom () "Like `erc-add-scroll-to-bottom', but only if window is selected." (when (eq (selected-window) (get-buffer-window)) (erc-scroll-to-bottom))) -(defvar-local erc--scrolltobottom-relaxed-commands '(end-of-buffer) - "Commands triggering a forced scroll to prompt. -Only applies with `erc-scrolltobottom-relaxed' while away from -prompt.") - (defvar-local erc--scrolltobottom-window-info nil "Alist with windows as keys and lists of window-related info as values. Values are lists containing the last window start position and @@ -119,34 +112,12 @@ erc--scrolltobottom-window-info may be nil, is the number of lines between `window-start' and `window-point', inclusive.") -(defvar erc--scrolltobottom-post-force-commands - '(beginning-of-buffer - electric-newline-and-maybe-indent - newline - default-indent-new-line) - "Commands that force a scroll after execution at prompt. -That is, ERC recalculates the window's start instead of blindly -restoring it.") - -;; Unfortunately, this doesn't work when `erc-scrolltobottom-relaxed' -;; is enabled (scaling up still moves the prompt). +;; FIXME treat `end-of-buffer' specially and always recenter -1. +;; FIXME make this work when `erc-scrolltobottom-all' is set to +;; `relaxed'. (defvar erc--scrolltobottom-post-ignore-commands '(text-scale-adjust) "Commands to skip instead of force-scroll on `post-command-hook'.") -(defvar erc--scrolltobottom-relaxed-skip-commands - '(recenter-top-bottom scroll-down-command) - "Commands exempt from triggering a stash and restore of `window-start'. -Only applies with `erc-scrolltobottom-relaxed' while in the input -area.") - -(defun erc--scrolltobottom-on-pre-command () - (when (and (eq (selected-window) (get-buffer-window)) - (>= (point) erc-input-marker)) - (setq erc--scrolltobottom-window-info - (list (list (selected-window) - (window-start) - (count-screen-lines (window-start) (point-max))))))) - (defun erc--scrolltobottom-on-post-command () "Restore window start or scroll to prompt and recenter. When `erc--scrolltobottom-window-info' is non-nil and its first @@ -154,55 +125,8 @@ erc--scrolltobottom-on-post-command window so long as prompt hasn't moved. Expect buffer to be unnarrowed." (when (eq (selected-window) (get-buffer-window)) - (if-let (((not (input-pending-p))) - (erc--scrolltobottom-window-info) - (found (car erc--scrolltobottom-window-info)) - ((eq (car found) (selected-window))) - ((not (memq this-command - erc--scrolltobottom-post-force-commands))) - ((= (nth 2 found) - (count-screen-lines (window-start) (point-max))))) - (set-window-start (selected-window) (nth 1 found)) - (unless (memq this-command erc--scrolltobottom-post-ignore-commands) - (erc--scrolltobottom-confirm))) - (setq erc--scrolltobottom-window-info nil))) - -(defun erc--scrolltobottom-on-pre-command-relaxed () - "Maybe scroll to bottom when away from prompt. -When `erc-scrolltobottom-relaxed' is active, only scroll when -prompt is past window's end and the command is `end-of-buffer' or -`self-insert-command' (assuming `move-to-prompt' is active). -When at prompt and current command does not appear in -`erc--scrolltobottom-relaxed-skip-commands', stash -`erc--scrolltobottom-window-info' for the selected window. -Assume an unnarrowed buffer." - (when (eq (selected-window) (get-buffer-window)) - (when (and (not (input-pending-p)) - (< (point) erc-input-marker) - (memq this-command erc--scrolltobottom-relaxed-commands) - (< (window-end nil t) erc-input-marker)) - (save-excursion - (goto-char (point-max)) - (recenter (or erc-input-line-position -1)))) - (when (and (>= (point) erc-input-marker) - (not (memq this-command - erc--scrolltobottom-relaxed-skip-commands))) - (setq erc--scrolltobottom-window-info - (list (list (selected-window) - (window-start) - (count-screen-lines (window-start) (point-max)))))))) - -(defun erc--scrolltobottom-on-post-command-relaxed () - "Set window start or scroll when data was captured on pre-command." - (when-let (((eq (selected-window) (get-buffer-window))) - (erc--scrolltobottom-window-info) - (found (car erc--scrolltobottom-window-info)) - ((eq (car found) (selected-window)))) - (if (and (not (memq this-command erc--scrolltobottom-post-force-commands)) - (= (nth 2 found) - (count-screen-lines (window-start) (point-max)))) - (set-window-start (selected-window) (nth 1 found)) - (recenter (nth 2 found))) + (unless (memq this-command erc--scrolltobottom-post-ignore-commands) + (erc--scrolltobottom-confirm)) (setq erc--scrolltobottom-window-info nil))) ;; It may be desirable to also restore the relative line position of @@ -246,54 +170,33 @@ erc-add-scroll-to-bottom (declare (obsolete erc--scrolltobottom-setup "30.1")) (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t)) -(cl-defgeneric erc--scrolltobottom-setup () - "Arrange for scrolling to bottom on window configuration changes. -Undo that arrangement when disabling `erc-scrolltobottom-mode'." - (if erc-scrolltobottom-mode - (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t) - (remove-hook 'post-command-hook #'erc-scroll-to-bottom t))) - -(cl-defmethod erc--scrolltobottom-setup (&context - (erc-scrolltobottom-all (eql t))) - "Add and remove local hooks specific to `erc-scrolltobottom-all'." +(defun erc--scrolltobottom-setup () + "Perform buffer-local setup for module `scrolltobottom'." (if erc-scrolltobottom-mode - (if erc-scrolltobottom-relaxed + (if erc-scrolltobottom-all (progn - (when (or (bound-and-true-p erc-move-to-prompt-mode) - (memq 'move-to-prompt erc-modules)) - (cl-pushnew 'self-insert-command - erc--scrolltobottom-relaxed-commands)) - (add-hook 'post-command-hook - #'erc--scrolltobottom-on-post-command-relaxed 60 t) - (add-hook 'pre-command-hook ; preempt `move-to-prompt' - #'erc--scrolltobottom-on-pre-command-relaxed 60 t)) - (add-hook 'window-configuration-change-hook - #'erc--scrolltobottom-at-prompt-minibuffer-active nil t) - (add-hook 'pre-command-hook - #'erc--scrolltobottom-on-pre-command 60 t) - (add-hook 'post-command-hook - #'erc--scrolltobottom-on-post-command 60 t)) + (setq-local read-minibuffer-restore-windows nil) + (unless (eq erc-scrolltobottom-all 'relaxed) + (add-hook 'window-configuration-change-hook + #'erc--scrolltobottom-at-prompt-minibuffer-active 50 t) + (add-hook 'post-command-hook + #'erc--scrolltobottom-on-post-command 50 t))) + (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t)) + (remove-hook 'post-command-hook #'erc-scroll-to-bottom t) + (remove-hook 'post-command-hook #'erc--scrolltobottom-on-post-command t) (remove-hook 'window-configuration-change-hook #'erc--scrolltobottom-at-prompt-minibuffer-active t) - (remove-hook 'pre-command-hook - #'erc--scrolltobottom-on-pre-command t) - (remove-hook 'post-command-hook - #'erc--scrolltobottom-on-post-command t) - (remove-hook 'pre-command-hook - #'erc--scrolltobottom-on-pre-command-relaxed t) - (remove-hook 'post-command-hook - #'erc--scrolltobottom-on-post-command-relaxed t) - (kill-local-variable 'erc--scrolltobottom-relaxed-commands) + (kill-local-variable 'read-minibuffer-restore-windows) (kill-local-variable 'erc--scrolltobottom-window-info))) (defun erc--scrolltobottom-on-pre-insert (_) - "Remember the `window-start' before inserting a message." + "Remember `window-start' before inserting a message." (setq erc--scrolltobottom-window-info (mapcar (lambda (w) (list w (window-start w) (and-let* - ((erc-scrolltobottom-relaxed) + (((eq erc-scrolltobottom-all 'relaxed)) (c (count-screen-lines (window-start w) (point-max) nil w))) (if (= ?\n (char-before (point-max))) (1+ c) c)))) diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el index 7d256bf711b..68ea0b1b070 100644 --- a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el +++ b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-scrolltobottom-relaxed.el --- erc-scrolltobottom-relaxed -*- lexical-binding: t -*- +;;; erc-scenarios-scrolltobottom-relaxed.el --- erc-scrolltobottom-all relaxed -*- lexical-binding: t -*- ;; Copyright (C) 2023 Free Software Foundation, Inc. @@ -40,8 +40,7 @@ erc-scenarios-scrolltobottom--relaxed (dumb-server (erc-d-run "localhost" t 'help)) (port (process-contact dumb-server :service)) (erc-modules `(scrolltobottom fill-wrap ,@erc-modules)) - (erc-scrolltobottom-all t) - (erc-scrolltobottom-relaxed t) + (erc-scrolltobottom-all 'relaxed) (erc-server-flood-penalty 0.1) (expect (erc-d-t-make-expecter)) lower upper) commit bd297132016ab2fbf7371617a29e2408220eb289 Author: Mattias Engdegård Date: Fri Oct 13 16:36:46 2023 +0200 Fix `ls-lisp-verbosity` custom type * lisp/ls-lisp.el (ls-lisp-verbosity): Include `modes` in the type and doc string. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index efc06ffbbf8..5b264554005 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -169,7 +169,7 @@ ls-lisp-verbosity Concepts come from UNIX: `links' means count of names associated with the file; `uid' means user (owner) identifier; `gid' means group -identifier. +identifier; `modes' means Unix-style permission bits (drwxrwxrwx). If emulation is MacOS then default is nil; if emulation is MS-Windows then default is `(links)' if platform is @@ -180,7 +180,8 @@ ls-lisp-verbosity ;; Functionality suggested by Howard Melman :type '(set (const :tag "Show Link Count" links) (const :tag "Show User" uid) - (const :tag "Show Group" gid)) + (const :tag "Show Group" gid) + (const :tag "Show Modes" modes)) :group 'ls-lisp) (defcustom ls-lisp-use-insert-directory-program commit 97959349651a8fb170c1c754e73a4d86ed24d018 Author: Alan Mackenzie Date: Fri Oct 13 14:27:18 2023 +0000 Fix c-in-knr-argdecl to avoid false recognition of K&R In the OP's test case, the type of a declaration was a macro with parentheses, which confused c-in-knr-argdecl. * lisp/progmodes/cc-engine.el (c-in-knr-argdecl): Amend this function to return nil if a "parameter declaration" can't be parsed as a declaration. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index e687f44d657..f5e0d21108f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12266,11 +12266,14 @@ c-in-knr-argdecl ;; Each time around the following checks one ;; declaration (which may contain several identifiers). (while (and - (consp (setq decl-or-cast - (c-forward-decl-or-cast-1 - after-prec-token - nil ; Or 'arglist ??? - nil))) + (not (eq (char-after) ?{)) + (or + (consp (setq decl-or-cast + (c-forward-decl-or-cast-1 + after-prec-token + nil ; Or 'arglist ??? + nil))) + (throw 'knr nil)) (memq (char-after) '(?\; ?\,)) (goto-char (car decl-or-cast)) (save-excursion commit bbccef3ceb63bc17ab9d2aee5326df5d70ce4ab3 Merge: d40f9668f9c c8ea14e7825 Author: Michael Albinus Date: Fri Oct 13 16:18:06 2023 +0200 Merge from origin/emacs-29 c8ea14e7825 Handle quoted tilde in Tramp 30239759ee4 ; Set maintainer for elint.el to emacs-devel eedd9db6190 Update to Org 9.6.10 # Conflicts: # lisp/net/tramp-gvfs.el commit d40f9668f9cf1dedaef3ce435498f89fe2c36385 Merge: 9f83b46beeb 73ccd9d2959 Author: Michael Albinus Date: Fri Oct 13 16:16:22 2023 +0200 ; Merge from origin/emacs-29 The following commit was skipped: 73ccd9d2959 Don't call font-lock-mode in treesit-major-mode-setup (bu... commit 9f83b46beeb26997fb9fa9c357bda8e88fa0f182 Merge: fde5f1a1a39 53292c5d818 Author: Michael Albinus Date: Fri Oct 13 16:16:19 2023 +0200 Merge from origin/emacs-29 53292c5d818 Fix treesit-query-validate for string input (bug#66400) 81a0c1ed2e4 ; Improve documentation of VC commands 0590e3e69a9 Recommend `M-x man` in woman.el docs 809da7fc9a1 ; * doc/lispref/processes.texi (Process Buffers): More ac... 8f23a02a9ea Fix updating process-mark position in 'set-process-buffer' commit fde5f1a1a390f26d70121898bb2456153f2640fb Merge: 77daafbb365 247743bd1e9 Author: Michael Albinus Date: Fri Oct 13 16:16:11 2023 +0200 ; Merge from origin/emacs-29 The following commit was skipped: 247743bd1e9 ; * lisp/treesit.el (treesit-language-at-point-function):... commit c8ea14e7825d536f41a230fc1298341a2462635e Author: Michael Albinus Date: Fri Oct 13 16:09:51 2023 +0200 Handle quoted tilde in Tramp * lisp/net/tramp.el (tramp-handle-expand-file-name): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name): * lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name): * lisp/net/tramp-smb.el (tramp-smb-handle-expand-file-name): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-expand-file-name): Handle quoted tilde. (Bug#65685) * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name-tilde): New test. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 46342042880..07390b50df2 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1176,10 +1176,13 @@ tramp-gvfs-handle-expand-file-name (tramp-run-real-handler #'expand-file-name (list name)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil + ;; Tilde expansion shall be possible also for quoted localname. + (when (string-prefix-p "~" (file-name-unquote localname)) + (setq localname (file-name-unquote localname))) ;; If there is a default location, expand tilde. (when (string-match (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 59d5c00515f..74b1638f120 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2831,6 +2831,9 @@ tramp-sh-handle-expand-file-name (tramp-run-real-handler #'expand-file-name (list name))) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "~/" localname))) + ;; Tilde expansion shall be possible also for quoted localname. + (when (string-prefix-p "~" (file-name-unquote localname)) + (setq localname (file-name-unquote localname))) ;; Tilde expansion if necessary. This needs a shell which ;; groks tilde expansion! The function `tramp-find-shell' is ;; supposed to find such a shell on the remote host. Please diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 7249fa266ac..0ba24352a3d 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -731,6 +731,9 @@ tramp-smb-handle-expand-file-name (tramp-run-real-handler #'expand-file-name (list name)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil + ;; Tilde expansion shall be possible also for quoted localname. + (when (string-prefix-p "~" (file-name-unquote localname)) + (setq localname (file-name-unquote localname))) ;; Tilde expansion if necessary. (when (string-match (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index d167bf13b14..9939d93ba35 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -380,6 +380,9 @@ tramp-sudoedit-handle-expand-file-name ;; but to the root home directory. (when (tramp-string-empty-or-nil-p localname) (setq localname "~")) + ;; Tilde expansion shall be possible also for quoted localname. + (when (string-prefix-p "~" (file-name-unquote localname)) + (setq localname (file-name-unquote localname))) (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) (when (string-match diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 02051736cc5..d1b38cfeb93 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3982,6 +3982,9 @@ tramp-handle-expand-file-name (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) + ;; Tilde expansion shall be possible also for quoted localname. + (when (string-prefix-p "~" (file-name-unquote localname)) + (setq localname (file-name-unquote localname))) ;; Expand tilde. Usually, the methods applying this handler do ;; not support tilde expansion. But users could declare a ;; respective connection property. (Bug#53847) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0648fe9e80f..e74837b926a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2335,6 +2335,17 @@ tramp-test05-expand-file-name-top (should (string-equal (expand-file-name local dir) dir)) (should (string-equal (expand-file-name (concat dir local)) dir))))) +;; The following test is inspired by Bug#65685. +(ert-deftest tramp-test05-expand-file-name-tilde () + "Check `expand-file-name'." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-ange-ftp-p))) + + (let ((dir (file-remote-p ert-remote-temporary-file-directory)) + (tramp-tolerate-tilde t)) + (should (string-equal (expand-file-name (concat dir "~")) + (expand-file-name (concat dir "/:~")))))) + (ert-deftest tramp-test06-directory-file-name () "Check `directory-file-name'. This checks also `file-name-as-directory', `file-name-directory', commit 77daafbb3657d301f864b969cdfe8da17ab5a62d Author: Mattias Engdegård Date: Fri Oct 13 15:21:26 2023 +0200 Add convenience wrapper for regexp disassembly * lisp/emacs-lisp/disass.el (re-disassemble): New. * etc/NEWS: Describe the new function instead of the internal `re--describe-compiled`. diff --git a/etc/NEWS b/etc/NEWS index 0e93faebb84..0f9b5f98ebf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1018,7 +1018,7 @@ Use 'define-minor-mode' and 'define-globalized-minor-mode' instead. * Lisp Changes in Emacs 30.1 -** New function 're--describe-compiled' to see the innards of a regexp. +** New function 're-disassemble' to see the innards of a regexp. If you compiled with '--enable-checking', you can use this to help debug either your regexp performance problems or the regexp engine. diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 73777d7e701..d9295686e9f 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -301,6 +301,23 @@ disassemble-1 (insert "\n"))))) nil) +(defun re-disassemble (regexp &optional case-table) + "Describe the compiled form of REGEXP in a separate window. +If CASE-TABLE is non-nil, use it as translation table for case-folding. + +This function is mainly intended for maintenance of Emacs itself +and may change at any time. It requires Emacs to be built with +`--enable-checking'." + (interactive "XRegexp (Lisp expression): ") + (let ((desc (with-temp-buffer + (when case-table + (set-case-table case-table)) + (let ((case-fold-search (and case-table t))) + (re--describe-compiled regexp))))) + (with-output-to-temp-buffer "*Regexp-disassemble*" + (with-current-buffer standard-output + (insert desc))))) + (provide 'disass) ;;; disass.el ends here commit 5a32e5ce48f01180603841194881562ee70fa0db Author: Mattias Engdegård Date: Fri Oct 13 15:12:03 2023 +0200 verilog-mode.el: remove impossible cond clause * lisp/progmodes/verilog-mode.el (verilog-set-auto-endcomments): Remove can't-happen clause. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 855ba4b50cf..2eec4bcd21a 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -5374,10 +5374,7 @@ verilog-set-auto-endcomments (goto-char (match-end 0)) (setq there (point)) (setq err nil) - (setq str (concat " // " cntx (verilog-get-expr)))) - - (;-- otherwise... - (setq str " // auto-endcomment confused ")))) + (setq str (concat " // " cntx (verilog-get-expr)))))) ((and (verilog-in-case-region-p) ;-- handle case item differently commit a52d627b37eb439a748161a82fdcd50d6cbc0248 Author: Mattias Engdegård Date: Fri Oct 13 14:31:18 2023 +0200 Separate `docstrings-wide` warning identifier This allows the docstring line width warning to be disabled without also disabling the one checking for curly quotes etc. * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-types) (byte-compile-warnings, byte-compile-docstring-style-warn): Add `docstrings-wide`. * etc/NEWS: Annonuce. diff --git a/etc/NEWS b/etc/NEWS index d21d1b4bad5..0e93faebb84 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1266,6 +1266,10 @@ 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'). +--- +*** The warning about wide docstrings can now be disabled separately. +Its warning name is 'docstrings-wide'. + +++ ** New function declaration and property 'important-return-value'. The declaration '(important-return-value t)' sets the diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 72697fb73e1..5ce053c0d6e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -295,7 +295,7 @@ byte-compile-warning-types '(redefine callargs free-vars unresolved obsolete noruntime interactive-only make-local mapcar constants suspicious lexical lexical-dynamic - docstrings docstrings-non-ascii-quotes not-unused + docstrings docstrings-wide docstrings-non-ascii-quotes not-unused empty-body) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t @@ -322,12 +322,15 @@ byte-compile-warnings is likely to be a mistake not-unused warning about using variables with symbol names starting with _. constants let-binding of, or assignment to, constants/nonvariables. - docstrings docstrings that are too wide (longer than - `byte-compile-docstring-max-column' or - `fill-column' characters, whichever is bigger) or - have other stylistic issues. - docstrings-non-ascii-quotes docstrings that have non-ASCII quotes. - This depends on the `docstrings' warning type. + docstrings various docstring stylistic issues, such as incorrect use + of single quotes + docstrings-wide + 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-non-ascii-quotes + docstrings that have non-ASCII quotes. + Only enabled when `docstrings' also is. suspicious constructs that usually don't do what the coder wanted. empty-body body argument to a special form or macro is empty. mutate-constant @@ -1756,7 +1759,8 @@ byte-compile-docstring-style-warn (setq docs (nth 2 form)))) (when (and kind docs (stringp docs)) (let ((col (max byte-compile-docstring-max-column fill-column))) - (when (byte-compile--wide-docstring-p docs col) + (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))) commit 963e3dd28daaf335bceaec6deef157467c5ae6d0 Author: Po Lu Date: Fri Oct 13 12:57:30 2023 +0800 Clarify java/INSTALL * java/INSTALL: Correct erroneous include exports and also introduce those omitted within patches to external libraries. (bug#66507) diff --git a/java/INSTALL b/java/INSTALL index b6c31483dd3..fb221c5e2b4 100644 --- a/java/INSTALL +++ b/java/INSTALL @@ -299,6 +299,8 @@ work, along with what has to be patched to make them work: the following three dependencies.) libpackagelistparser https://android.googlesource.com/platform/system/core/+/refs/heads/nougat-mr1-dev/libpackagelistparser/ + (You must add LOCAL_EXPORT_C_INCLUDE_DIRS := $(LOCAL_PATH)/include before + its Android.mk includes $(BUILD_SHARED_LIBRARY)) libpcre - https://android.googlesource.com/platform/external/pcre libcrypto - https://android.googlesource.com/platform/external/boringssl (You must apply the patch at the end of this file when building for @@ -404,14 +406,14 @@ libxml2 before it can be built for Emacs. In addition, you must also revert the commit `edb5870767fed8712a9b77ef34097209b61ab2db'. diff --git a/Android.mk b/Android.mk -index 07c7b372..24f67e49 100644 +index 07c7b372..2494274f 100644 --- a/Android.mk +++ b/Android.mk @@ -80,6 +80,7 @@ LOCAL_SHARED_LIBRARIES := libicuuc LOCAL_MODULE:= libxml2 LOCAL_CLANG := true LOCAL_ADDITIONAL_DEPENDENCIES += $(LOCAL_PATH)/Android.mk -+LOCAL_EXPORT_C_INCLUDES += $(LOCAL_PATH) ++LOCAL_EXPORT_C_INCLUDES += $(LOCAL_PATH)/include include $(BUILD_SHARED_LIBRARY) # For the host commit 29095d0b1cc5e5b0e4ee089deb59f44f950872ff Author: Po Lu Date: Fri Oct 13 11:57:46 2023 +0800 Try harder to generate tombstones upon emacs_abort * src/android.c (HAS_BUILTIN_TRAP): New macro definition. (emacs_abort) [HAS_BUILTIN_TRAP]: Call __builtin_trap to abort, in place of dereferencing NULL. * src/androidterm.c (android_draw_fringe_bitmap): Correct comment transplanted from X code. diff --git a/src/android.c b/src/android.c index 98ace1156d7..fa7bfe6c0f0 100644 --- a/src/android.c +++ b/src/android.c @@ -5542,22 +5542,40 @@ android_toggle_on_screen_keyboard (android_window window, bool show) +#if defined __clang_major__ && __clang_major__ < 5 +# define HAS_BUILTIN_TRAP 0 +#elif 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)) +# define HAS_BUILTIN_TRAP 1 +#elif defined __has_builtin +# define HAS_BUILTIN_TRAP __has_builtin (__builtin_trap) +#else /* !__has_builtin */ +# define HAS_BUILTIN_TRAP 0 +#endif /* defined __clang_major__ && __clang_major__ < 5 */ + /* emacs_abort implementation for Android. This logs a stack trace. */ void emacs_abort (void) { +#ifndef HAS_BUILTIN_TRAP volatile char *foo; +#endif /* !HAS_BUILTIN_TRAP */ __android_log_print (ANDROID_LOG_FATAL, __func__, - "emacs_abort called, please review the ensuing" + "emacs_abort called, please review the following" " stack trace"); - /* Cause a NULL pointer dereference to make debuggerd generate a +#ifndef HAS_BUILTIN_TRAP + /* Induce a NULL pointer dereference to make debuggerd generate a tombstone. */ foo = NULL; *foo = '\0'; +#else /* HAS_BUILTIN_TRAP */ + /* Crash through __builtin_trap instead. This appears to more + uniformly elicit crash reports from debuggerd. */ + __builtin_trap (); +#endif /* !HAS_BUILTIN_TRAP */ abort (); } diff --git a/src/androidterm.c b/src/androidterm.c index 9b00ad85642..ef3c20f4e0f 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -2529,7 +2529,8 @@ android_draw_fringe_bitmap (struct window *w, struct glyph_row *row, /* Intersect the destination rectangle with that of the row. Setting a clip mask overrides the clip rectangles provided by - x_clip_to_row, so clipping must be performed by hand. */ + android_clip_to_row, so clipping must be performed by + hand. */ image_rect.x = p->x; image_rect.y = p->y; commit e58b1d371fbbb3d9a7a1898fce2d35766493aab0 Author: Jim Porter Date: Thu Oct 12 18:23:46 2023 -0700 Reset the Eshell prompt when signaling with no foreground process This fixes a small regression from commit eef32d13da5. * lisp/eshell/esh-proc.el (eshell-reset): Declare here. (eshell-reset-after-proc): Move implementation to... (eshell--reset-after-signal): ... here... (eshell-interrupt-process, eshell-kill-process eshell-quit-process) (eshell-stop-process, eshell-continue-process): ... and call it. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 126c7d0f26e..bc3776259a7 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -113,6 +113,7 @@ eshell-process-list To add or remove elements of this list, see `eshell-record-process-object' and `eshell-remove-process-entry'.") +(declare-function eshell-reset "esh-mode" (&optional no-hooks)) (declare-function eshell-send-eof-to-process "esh-mode") (declare-function eshell-interactive-filter "esh-mode" (buffer string)) (declare-function eshell-tail-process "esh-cmd") @@ -150,16 +151,8 @@ eshell-proc-initialize (make-local-variable 'eshell-process-list) (eshell-proc-mode)) -(defun eshell-reset-after-proc (status) - "Reset the command input location after a process terminates. -The signals which will cause this to happen are matched by -`eshell-reset-signals'." - (declare (obsolete nil "30.1")) - (when (and (stringp status) - (string-match eshell-reset-signals status)) - (require 'esh-mode) - (declare-function eshell-reset "esh-mode" (&optional no-hooks)) - (eshell-reset))) +(define-obsolete-function-alias 'eshell-reset-after-proc + 'eshell--reset-after-signal "30.1") (defun eshell-process-active-p (process) "Return non-nil if PROCESS is active. @@ -649,29 +642,41 @@ eshell-query-kill-processes (kill-buffer buf))) (message nil)))) +(defun eshell--reset-after-signal (status) + "Reset the prompt after a signal when necessary. +STATUS is the status associated with the signal; if +`eshell-reset-signals' matches status, reset the prompt. + +This is really only useful when \"signaling\" while there's no +foreground process. Otherwise, `eshell-resume-command' handles +everything." + (when (and (stringp status) + (string-match eshell-reset-signals status)) + (eshell-reset))) + (defun eshell-interrupt-process () "Interrupt a process." (interactive) (unless (eshell-process-interact 'interrupt-process) - (run-hook-with-args 'eshell-kill-hook nil "interrupt"))) + (eshell--reset-after-signal "interrupt\n"))) (defun eshell-kill-process () "Kill a process." (interactive) (unless (eshell-process-interact 'kill-process) - (run-hook-with-args 'eshell-kill-hook nil "killed"))) + (eshell--reset-after-signal "killed\n"))) (defun eshell-quit-process () "Send quit signal to process." (interactive) (unless (eshell-process-interact 'quit-process) - (run-hook-with-args 'eshell-kill-hook nil "quit"))) + (eshell--reset-after-signal "quit\n"))) ;(defun eshell-stop-process () ; "Send STOP signal to process." ; (interactive) ; (unless (eshell-process-interact 'stop-process) -; (run-hook-with-args 'eshell-kill-hook nil "stopped"))) +; (eshell--reset-after-signal "stopped\n"))) ;(defun eshell-continue-process () ; "Send CONTINUE signal to process." @@ -680,7 +685,7 @@ eshell-quit-process ; ;; jww (1999-09-17): this signal is not dealt with yet. For ; ;; example, `eshell-reset' will be called, and so will ; ;; `eshell-resume-eval'. -; (run-hook-with-args 'eshell-kill-hook nil "continue"))) +; (eshell--reset-after-signal "continue\n"))) (provide 'esh-proc) ;;; esh-proc.el ends here commit ce3ed6e019cdb5f8fd831e35c04832aaa2c768b6 Author: Mauro Aranda Date: Thu Oct 12 10:17:57 2023 -0300 Fix a defcustom :type * lisp/progmodes/ruby-mode.el (ruby-insert-encoding-magic-comment): Allow always-utf8. (Bug#66498) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 9d80bbd72dd..5c34ddc562b 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -516,7 +516,9 @@ ruby-insert-encoding-magic-comment When set to `always-utf8' an utf-8 comment will always be added, even if it's not required." - :type 'boolean :group 'ruby) + :type '(choice (const :tag "Don't insert" nil) + (const :tag "Insert utf-8 comment always" always-utf8) + (const :tag "Insert only when required" t))) (defcustom ruby-encoding-magic-comment-style 'ruby "The style of the magic encoding comment to use." commit 57ffdfb59bded3284859b715a87f3fd35c81ff1a Author: Po Lu Date: Thu Oct 12 22:04:34 2023 +0800 ; Correct typo * etc/NEWS: Fix typo. diff --git a/etc/NEWS b/etc/NEWS index ac6193caf1d..d21d1b4bad5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -198,7 +198,7 @@ displayed on the mode line when 'appt-display-mode-line' is non-nil. * Editing Changes in Emacs 30.1 +++ -** New user option 'gud-highlight-current-line-overlay'. +** New user option 'gud-highlight-current-line'. When enabled, Gud will visually emphasize the line being executed upon pauses in the debugee's execution, such as those occasioned by breakpoints being hit. commit c6f07e13eef93af8b25064bb1bc975e8fafad591 Author: Po Lu Date: Thu Oct 12 21:46:54 2023 +0800 Enable highlighting Gud execution lines without hl-line-mode * doc/emacs/building.texi (Debugger Operation): Mention two new options and the relationship between Gud and HL Line Mode. * etc/NEWS (Editing Changes in Emacs 30.1): Mention the new option. * lisp/progmodes/gud.el (gud-highlight-current-line-overlay): New variable. (gud-sentinel) : Delete that overlay if set. (gud-highlight-current-line, gud-highlight-current-line-face): New user options. (gud-display-line): Create and move an overlay without employing hl-line-mode, if so enjoined by the user. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index d6610099460..2a98bffdc2d 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -698,6 +698,20 @@ Debugger Operation debugger subprocess. To update this information, you typically have to recompile and restart the program. +@cindex GUD and hl-line-mode +@cindex highlighting execution lines in GUD +@vindex gud-highlight-current-line + Moreover, GUD is capable of visually demarcating the current +execution line within the window text itself in one of two fashions: +the first takes effect when the user option +@code{gud-highlight-current-line} is enabled, and displays that line +in an overlay whose appearance is provided by the face +@code{gud-highlight-current-line-face}. The other takes effect when +HL Line Mode (@pxref{Cursor Display}) is enabled, and moves the +overlay introduced by HL Line Mode briefly to the execution line, +until a subsequent editing command repositions it back beneath the +cursor. + @cindex GUD Tooltip mode @cindex mode, GUD Tooltip @findex gud-tooltip-mode diff --git a/etc/NEWS b/etc/NEWS index 8b2bcaaf01d..ac6193caf1d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -197,6 +197,12 @@ displayed on the mode line when 'appt-display-mode-line' is non-nil. * Editing Changes in Emacs 30.1 ++++ +** New user option 'gud-highlight-current-line-overlay'. +When enabled, Gud will visually emphasize the line being executed upon +pauses in the debugee's execution, such as those occasioned by +breakpoints being hit. + --- ** New global minor mode 'kill-ring-deindent-mode'. When enabled, text being saved to the kill ring will be de-indented by diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 3cc63aab84f..d4b954a7203 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2942,6 +2942,10 @@ gud-overlay-arrow-position (declare-function speedbar-change-initial-expansion-list "speedbar" (new)) (defvar speedbar-previously-used-expansion-list-name) +(defvar gud-highlight-current-line-overlay nil + "Overlay created for `gud-highlight-current-line'. +It is nil if not yet present.") + (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed @@ -2958,6 +2962,10 @@ gud-sentinel ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (setq gud-overlay-arrow-position nil) + ;; And any highlight overlays. + (when gud-highlight-current-line-overlay + (delete-overlay gud-highlight-current-line-overlay) + (setq gud-highlight-current-line-overlay nil)) (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdbmi) (gdb-reset) @@ -3024,6 +3032,24 @@ gud-display-frame ;; region-restriction if that's possible. We use an explicit display-buffer ;; to get around the fact that this is called inside a save-excursion. +(defcustom gud-highlight-current-line nil + "Whether Gud should highlight the source line being debugged. +If non-nil, Gud will accentuate the source code line previously +executed upon each pause in the debugee's execution with an +overlay in the face `gud-highlight-current-line-face'. + +If nil, yet one of `hl-line-mode' or `global-hl-line-mode' (which +see) is enabled, then the emphasis imposed by either of those +major modes is instead momentarily moved to the aforesaid source +line, until it is displaced by subsequent cursor motion." + :version "30.1" + :type 'boolean) + +(defface gud-highlight-current-line-face + '((t :inherit highlight :extend t)) + "Face for highlighting the source code line being executed." + :version "30.1") + (defun gud-display-line (true-file line) (let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. (buffer @@ -3053,14 +3079,32 @@ gud-display-line (or gud-overlay-arrow-position (setq gud-overlay-arrow-position (make-marker))) (set-marker gud-overlay-arrow-position (point) (current-buffer)) - ;; If they turned on hl-line, move the hl-line highlight to - ;; the arrow's line. - (when (featurep 'hl-line) - (cond - (global-hl-line-mode - (global-hl-line-highlight)) - ((and hl-line-mode hl-line-sticky-flag) - (hl-line-highlight))))) + (if gud-highlight-current-line + (progn + (unless gud-highlight-current-line-overlay + ;; Create the highlight overlay if it does not yet + ;; exist. + (let ((overlay (make-overlay (point) (point)))) + (overlay-put overlay 'priority -45) ; 5 less than hl-line. + (overlay-put overlay 'face 'gud-highlight-current-line-face) + (setq gud-highlight-current-line-overlay overlay))) + ;; Next, move the overlay to the current line. + (move-overlay gud-highlight-current-line-overlay + (line-beginning-position) + (line-beginning-position 2) + (current-buffer))) + ;; Delete any overlay introduced if g-h-c-l-f has changed. + (when gud-highlight-current-line-overlay + (delete-overlay gud-highlight-current-line-overlay) + (setq gud-highlight-current-line-overlay nil)) + ;; If they turned on hl-line, move the hl-line highlight to + ;; the arrow's line. + (when (featurep 'hl-line) + (cond + (global-hl-line-mode + (global-hl-line-highlight)) + ((and hl-line-mode hl-line-sticky-flag) + (hl-line-highlight)))))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) commit 30239759ee45b5077caf95ce5aa47b3af885afbe Author: Stefan Kangas Date: Thu Oct 12 13:23:38 2023 +0200 ; Set maintainer for elint.el to emacs-devel * lisp/emacs-lisp/elint.el: Set maintainer to emacs-devel. diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 9812c663ea8..c04b15dd237 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -1,8 +1,9 @@ ;;; elint.el --- Lint Emacs Lisp -*- lexical-binding: t -*- -;; Copyright (C) 1997, 2001-2023 Free Software Foundation, Inc. +;; Copyright (C) 1997-2023 Free Software Foundation, Inc. ;; Author: Peter Liljenberg +;; Maintainer: emacs-devel@gnu.org ;; Created: May 1997 ;; Keywords: lisp @@ -27,7 +28,7 @@ ;; misspellings and undefined variables, although it can also catch ;; function calls with the wrong number of arguments. -;; To use, call `elint-current-buffer' or `elint-defun' to lint a buffer +;; To use it, call `elint-current-buffer' or `elint-defun' to lint a buffer ;; or defun. The first call runs `elint-initialize' to set up some ;; argument data, which may take a while. @@ -37,9 +38,9 @@ ;;; To do: -;; * Adding type checking. (Stop that sniggering!) +;; * Adding type checking. (Stop that sniggering!) ;; * Make eval-when-compile be sensitive to the difference between -;; funcs and macros. +;; functions and macros. ;; * Requires within function bodies. ;; * Handle defstruct. ;; * Prevent recursive requires. commit 088dd67f891553e1a27e65c97e386d0dd8dc4f64 Author: Michael Albinus Date: Thu Oct 12 11:02:53 2023 +0200 New filenotify tests * src/inotify.c (Finotify_watch_list, Finotify_allocated_p): Fix argument list. * test/lisp/filenotify-tests.el (file-notify-test04-autorevert): Use `skip-when'. (file-notify-test12-unmount, file-notify-test12-unmount-remote): New tests. diff --git a/src/inotify.c b/src/inotify.c index 247d9f03055..f50b9ddcaa7 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -517,12 +517,14 @@ DEFUN ("inotify-valid-p", Finotify_valid_p, Sinotify_valid_p, 1, 1, 0, #ifdef INOTIFY_DEBUG DEFUN ("inotify-watch-list", Finotify_watch_list, Sinotify_watch_list, 0, 0, 0, doc: /* Return a copy of the internal watch_list. */) + (void) { return Fcopy_sequence (watch_list); } DEFUN ("inotify-allocated-p", Finotify_allocated_p, Sinotify_allocated_p, 0, 0, 0, doc: /* Return non-nil, if an inotify instance is allocated. */) + (void) { return inotifyfd < 0 ? Qnil : Qt; } diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 57099add08b..eb485a10a92 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -973,8 +973,7 @@ file-notify-test04-autorevert (setq file-notify--test-desc auto-revert-notify-watch-descriptor) ;; GKqueueFileMonitor does not report the `changed' event. - (skip-unless - (not (eq (file-notify--test-monitor) 'GKqueueFileMonitor))) + (skip-when (eq (file-notify--test-monitor) 'GKqueueFileMonitor)) ;; Check, that file notification has been used. (should auto-revert-mode) @@ -1708,6 +1707,71 @@ file-notify-test11-symlinks (file-notify--deftest-remote file-notify-test11-symlinks "Check `file-notify-test11-symlinks' for remote files.") +(ert-deftest file-notify-test12-unmount () + "Check that file notification stop after unmounting the filesystem." + :tags '(:expensive-test) + (skip-unless (file-notify--test-local-enabled)) + ;; This test does not work for w32notify. + (skip-when (string-equal (file-notify--test-library) "w32notify")) + + (unwind-protect + (progn + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + ;; File monitors like kqueue insist, that the watched file + ;; exists. Directory monitors are not bound to this + ;; restriction. + (when (string-equal (file-notify--test-library) "kqueue") + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message)) + + (should + (setq file-notify--test-desc + (file-notify--test-add-watch + file-notify--test-tmpfile + '(attribute-change change) #'file-notify--test-event-handler))) + (should (file-notify-valid-p file-notify--test-desc)) + + ;; Unmounting the filesystem should stop watching. + (file-notify--test-with-actions '(stopped) + ;; We emulate unmounting by calling + ;; `file-notify-handle-event' with a corresponding event. + (file-notify-handle-event + (make-file-notify + :-event + (list file-notify--test-desc + (pcase (file-notify--test-library) + ((or "inotify" "inotifywait") '(unmount isdir)) + ((or "gfilenotify" "gio") '(unmounted)) + ("kqueue" '(revoke)) + (err (ert-fail (format "Library %s not supported" err)))) + (pcase (file-notify--test-library) + ("kqueue" (file-local-name file-notify--test-tmpfile)) + (_ (file-local-name file-notify--test-tmpdir))) + ;; In the inotify case, there is a 4th slot `cookie'. + ;; Since it is unused for `unmount', we ignore it. + ) + :-callback + (pcase (file-notify--test-library) + ("inotify" #'file-notify--callback-inotify) + ("gfilenotify" #'file-notify--callback-gfilenotify) + ("kqueue" #'file-notify--callback-kqueue) + ((or "inotifywait" "gio") #'file-notify-callback) + (err (ert-fail (format "Library %s not supported" err))))))) + + ;; The watch has been stopped. + (should-not (file-notify-valid-p file-notify--test-desc)) + + ;; The environment shall be cleaned up. + (when (string-equal (file-notify--test-library) "kqueue") + (delete-file file-notify--test-tmpfile)) + (file-notify--test-cleanup-p)) + + ;; Cleanup. + (file-notify--test-cleanup))) + +(file-notify--deftest-remote file-notify-test12-unmount + "Check `file-notify-test12-unmount' for remote files.") + (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." (interactive "p") commit 963ccc05acf2939c95524de9175a1fc3053b0f6f Author: Po Lu Date: Thu Oct 12 08:43:56 2023 +0800 Respond to JNI errors around drawing operations * src/android.c (android_fill_polygon, android_draw_rectangle) (android_draw_point, android_draw_line, android_lock_bitmap): Check or clear errors around potential JNI errors; the penalty incurred to performance is not as significant as was expected. diff --git a/src/android.c b/src/android.c index d1182698669..98ace1156d7 100644 --- a/src/android.c +++ b/src/android.c @@ -4409,6 +4409,7 @@ android_fill_polygon (android_drawable drawable, struct android_gc *gc, service_class.fill_polygon, drawable_object, gcontext, array); + android_exception_check_1 (array); ANDROID_DELETE_LOCAL_REF (array); } @@ -4431,6 +4432,10 @@ android_draw_rectangle (android_drawable handle, struct android_gc *gc, drawable, gcontext, (jint) x, (jint) y, (jint) width, (jint) height); + + /* In lieu of android_exception_check, clear all exceptions after + calling this frequently called graphics operation. */ + (*android_java_env)->ExceptionClear (android_java_env); } void @@ -4451,6 +4456,10 @@ android_draw_point (android_drawable handle, struct android_gc *gc, service_class.draw_point, drawable, gcontext, (jint) x, (jint) y); + + /* In lieu of android_exception_check, clear all exceptions after + calling this frequently called graphics operation. */ + (*android_java_env)->ExceptionClear (android_java_env); } void @@ -4472,6 +4481,10 @@ android_draw_line (android_drawable handle, struct android_gc *gc, drawable, gcontext, (jint) x, (jint) y, (jint) x2, (jint) y2); + + /* In lieu of android_exception_check, clear all exceptions after + calling this frequently called graphics operation. */ + (*android_java_env)->ExceptionClear (android_java_env); } android_pixmap @@ -5279,7 +5292,7 @@ android_wc_lookup_string (android_key_pressed_event *event, The caller must take care to unlock the bitmap data afterwards. */ unsigned char * -android_lock_bitmap (android_window drawable, +android_lock_bitmap (android_drawable drawable, AndroidBitmapInfo *bitmap_info, jobject *bitmap_return) { @@ -5295,9 +5308,15 @@ android_lock_bitmap (android_window drawable, object, drawable_class.get_bitmap); if (!bitmap) - /* NULL is returned when the bitmap does not currently exist due - to ongoing reconfiguration on the main thread. */ - return NULL; + { + /* Report any exception signaled. */ + android_exception_check (); + + /* If no exception was signaled, then NULL was returned as the + bitmap does not presently exist due to window reconfiguration + on the main thread. */ + return NULL; + } memset (bitmap_info, 0, sizeof *bitmap_info); commit 60f695285331dcf723dc9ce69c8bffc3b3d606c9 Author: Jim Porter Date: Wed Oct 11 11:38:27 2023 -0700 Fix behavior of Eshell prompt when yanking output into it * lisp/eshell/esh-util.el (eshell--unmark-string-as-output): New function... * lisp/eshell/esh-mode.el (eshell-mode): ... use it. * test/lisp/eshell/eshell-tests.el (eshell-test/yank-output): New test (bug#66469). diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 2b560afb92c..9d2cd1e67eb 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -361,6 +361,9 @@ eshell-mode (setq-local eshell-last-output-end (point-marker)) (setq-local eshell-last-output-block-begin (point)) + (add-function :filter-return (local 'filter-buffer-substring-function) + #'eshell--unmark-string-as-output) + (let ((modules-list (copy-sequence eshell-modules-list))) (setq-local eshell-modules-list modules-list)) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 4c251a29269..ca2f775318a 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -234,6 +234,14 @@ eshell--mark-yanked-as-output (eshell--mark-as-output start1 end1))))) (add-hook 'after-change-functions hook nil t))) +(defun eshell--unmark-string-as-output (string) + "Unmark STRING as Eshell output." + (remove-list-of-text-properties + 0 (length string) + '(rear-nonsticky front-sticky field insert-in-front-hooks) + string) + string) + (defun eshell-find-delimiter (open close &optional bound reverse-p backslash-p) "From point, find the CLOSE delimiter corresponding to OPEN. diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index b02e5fca592..d2ef44ae507 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -195,6 +195,25 @@ eshell-test/get-old-input/run-output (eshell-send-input) (eshell-match-output "(\"hello\" \"there\")"))) +(ert-deftest eshell-test/yank-output () + "Test that yanking a line of output into the next prompt works (bug#66469)." + (with-temp-eshell + (eshell-insert-command "echo hello") + ;; Go to the output and kill the line of text. + (forward-line -1) + (kill-line) + ;; Go to the last prompt and yank the previous output. + (goto-char (point-max)) + (yank) + ;; Go to the beginning of the prompt and add some text. + (move-beginning-of-line 1) + (insert-and-inherit "echo ") + ;; Make sure when we go to the beginning of the line, we go to the + ;; right spot (before the "echo"). + (move-end-of-line 1) + (move-beginning-of-line 1) + (should (looking-at "echo hello")))) + (provide 'eshell-tests) ;;; eshell-tests.el ends here commit cfed3bb395030662059d560f94ea0318f820f00f Author: Alan Mackenzie Date: Wed Oct 11 15:03:43 2023 +0000 Document cl-print.el in cl.texi. * doc/misc/cl.texi: (Printing): New chapter which documents cl-print.el. * NEWS (cl-print): Add "+++" markings to all the subitems, which have now been documented. diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 5de33350f4f..e5a29cbcffb 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -55,6 +55,7 @@ Top @menu * Overview:: Basics, usage, organization, naming conventions. +* Printing:: Human friendly printing with @code{cl-prin1}. * Program Structure:: Arglists, @code{cl-eval-when}. * Predicates:: Type predicates and equality predicates. * Control Structure:: Assignment, conditionals, blocks, looping. @@ -258,6 +259,160 @@ Naming Conventions @noindent [3] Only for one sequence argument or two list arguments. +@node Printing +@chapter Printing + +@noindent +This chapter describes some enhancements to Emacs Lisp's +@dfn{printing}, the action of representing Lisp objects in text form. +The functions documented here are intended to produce output more for +human readers than the standard printing functions such as +@code{prin1} and @code{princ} (@pxref{Output Functions,,,elisp,GNU +Emacs Lisp Reference Manual}). + +Several of these functions have a parameter @var{stream}; this +specifies what to do with the characters printing produces. For +example, it might be a buffer, a marker, @code{nil} (meaning use +standard output), or @code{t} (use the echo area). @xref{Output +Streams,,,elisp,GNU Emacs Lisp Reference Manual}, for a full +description. + +@defvar cl-print-readably +When this variable is non-@code{nil}, @code{cl-prin1} and other +functions described here try to produce output which can later be read +by the Lisp reader (@pxref{Input Functions,,,elisp,GNU Emacs Lisp +Reference Manual}). +@end defvar + +@defvar cl-print-compiled +This variable controls how to print byte-compiled functions. Valid +values are: +@table @code +@item nil +The default: Just an internal hex identifier is printed. +@item static +The internal hex identifier together with the function's constant +vector are printed. +@item disassemble +The byte code gets disassembled. +@item raw +The raw form of the function is printed by @code{prin1}. +@end table + +Sometimes, a button is set on the output to allow you to disassemble +the function. See @code{cl-print-compile-button}. +@end defvar + +@defvar cl-print-compile-button +When this variable is non-@code{nil} and a byte-compiled function has +been printed to a buffer, you can click with the mouse or type +@key{RET} on that output to disassemble the code. This doesn't apply +when @code{cl-print-compiled} is set to @code{disassemble}. +@end defvar + +@defvar cl-print-string-length +The maximum length of a string to print before abbreviating it. A +value of @code{nil}, the default, means no limit. + +When the CL printing functions abbreviate a string, they print the +first @code{cl-print-string-length} characters of the string, followed +by ``@enddots{}''. When the printing is to a buffer, you can click +with the mouse or type @key{RET} on this ellipsis to expand the +string. + +This variable has effect only in the @code{cl-prin*} functions, not in +primitives such as @code{prin1}. +@end defvar + +@defun cl-prin1 object &option stream +@code{cl-print1} prints @var{object} on @var{stream} (see above) +according to its type and the settings described above. The variables +@code{print-length} and @code{print-level} and the other standard +Emacs settings also affect the printing (@pxref{Output +Variables,,,elisp,GNU Emacs Lisp Reference Manual}). +@end defun + +@defun cl-prin1-to-string object +This function is like @code{cl-prin1}, except the output characters +are returned as a string from this function rather than being passed +to a stream. +@end defun + +@defun cl-print-to-string-with-limit print-function value limit +This function returns a string containing a printed representation of +@var{value}. It attempts to get the length of the returned string +under @var{limit} characters with successively more restrictive +settings of @code{print-level}, @code{print-length}, and +@code{cl-print-string-length}. It uses @var{print-function} to print, +a function which should take the arguments @var{value} and a stream +(see above), and which should respect @code{print-length}, +@code{print-level}, and @code{cl-print-string-length}. @var{limit} +may be @code{nil} or zero, in which case @var{print-function} will be +called with these settings bound to @code{nil}; it can also be +@code{t}, in which case @var{print-function} will be called with their +current values. + +Use this function with @code{cl-prin1} to print an object, possibly +abbreviating it with one or more ellipses to fit within the size +limit. +@end defun + +@defun cl-print-object object stream +This function prints @var{object} on @var{stream} (see above). It is +actually a @code{cl-defgeneric} (@pxref{Generic Functions,,,elisp,GNU +Emacs Lisp Reference Manual}), which is defined for several types of +@var{object}. Normally, you just call @code{cl-prin1} to print an +@var{object} rather than calling this function directly. + +You can write @code{cl-print-object} @code{cl-defmethod}s for other +types of @var{object}, thus extending @code{cl-prin1}. If such a +method uses ellipses, you should also write a +@code{cl-print-object-contents} method for the same type. For +examples of these methods, see @file{emacs-lisp/cl-print.el} in the +Emacs source directory. +@end defun + +@defun cl-print-object-contents object start stream +This function replaces an ellipsis in @var{stream} beginning at +@var{start} with the text from the partially printed @var{object} it +represents. It is also a @code{cl-defgeneric} defined for several +types of @var{object}. @var{stream} is a buffer containing the text +with the ellipsis. @var{start} specifies the starting position of the +ellipsis in a manner dependent on the type; it will have been obtained +from a text property on the ellipsis, having been put there by +@code{cl-print-insert-ellipsis}. +@end defun + +@defun cl-print-insert-ellipsis object start stream +This function prints an ellipsis (``@dots{}'') to @var{stream} (see +above). When @var{stream} is a buffer, the ellipsis will be given the +@code{cl-print-ellipsis} text property. The value of the text +property will contain state (including @var{start}) in order to print +the elided part of @var{object} later. @var{start} should be nil if +the whole @var{object} is being elided, otherwise it should be an +index or other pointer into the internals of @var{object} which can be +passed to `cl-print-object-contents' at a later time. +@end defun + +@defvar cl-print-expand-ellipsis-function +This variable holds a function which expands an ellipsis in the +current buffer. The function takes four arguments: @var{begin} and +@var{end}, which are the bounds of the ellipsis; @var{value}, which is +the value of the @code{cl-print-ellipsis} text property on the +ellipsis (typically set earlier by @code{cl-prin1}); and +@var{line-length}, the desired maximum length of the output. Its +return value is the buffer position after the expanded text. +@end defvar + +@deffn Command cl-print-expand-ellipsis &optional button +This command expands the ellipsis at point. Non-interactively, if +@var{button} is non-@code{nil}, it should be either a buffer position +or a button made by @code{cl-print-insert-ellipsis} +(@pxref{Buttons,,,elisp,GNU Emacs Lisp Reference Manual}), which +indicates the position of the ellipsis. The return value is the +buffer position after the expanded text. +@end deffn + @node Program Structure @chapter Program Structure diff --git a/etc/NEWS b/etc/NEWS index 6637a5c87e2..8b2bcaaf01d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -150,22 +150,31 @@ executable, if it exists. This should remove the need to change its value when installing GNU coreutils using something like ports or Homebrew. ++++ ** cl-print ++++ *** You can expand the "..." truncation everywhere. The code that allowed "..." to be expanded in the "*Backtrace*" buffer should now work anywhere the data is generated by 'cl-print'. ++++ *** The 'backtrace-ellipsis' button is replaced by 'cl-print-ellipsis'. ++++ *** hash-tables' contents can be expanded via the ellipsis. ++++ *** Modes can control the expansion via 'cl-print-expand-ellipsis-function'. ++++ *** There is a new setting 'raw' for 'cl-print-compiled' which causes byte-compiled functions to be printed in full by 'prin1'. A button on this output can be activated to disassemble the function. ++++ +*** There is a new chapter in the CL manual documenting cl-print.el. + ** Modeline elements can now be right-aligned. Anything following the symbol 'mode-line-format-right-align' in 'mode-line-format' will be right-aligned. Exactly where it is commit aa45ea8a33132f3a95b1e2c085776919febd5458 Author: Alan Mackenzie Date: Wed Oct 11 13:26:01 2023 +0000 In cl-prin1, enable raw printing for a byte-compiled function * lisp/emacs-lisp/cl-print.el (cl-print-compiled): document the new option `raw'. (cl-print-object/compiled-function): when cl-print-compiled is `raw', just print the function using `prin1'. Apply a button to this output which, when activated disassembles the function. * etc/NEWS (cl-print): Add an entry for this new feature. diff --git a/etc/NEWS b/etc/NEWS index 220568429fd..6637a5c87e2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -162,6 +162,10 @@ should now work anywhere the data is generated by 'cl-print'. *** Modes can control the expansion via 'cl-print-expand-ellipsis-function'. +*** There is a new setting 'raw' for 'cl-print-compiled' which causes +byte-compiled functions to be printed in full by 'prin1'. A button on +this output can be activated to disassemble the function. + ** Modeline elements can now be right-aligned. Anything following the symbol 'mode-line-format-right-align' in 'mode-line-format' will be right-aligned. Exactly where it is diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index b6d1f13bb2f..56e35078d39 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -165,6 +165,7 @@ 'help-byte-code (defvar cl-print-compiled nil "Control how to print byte-compiled functions. Acceptable values include: +- `raw' to print out the full contents of the function using `prin1'. - `static' to print the vector of constants. - `disassemble' to print the disassembly of the code. - nil to skip printing any details about the code.") @@ -187,42 +188,54 @@ cl-print-object (if args (prin1 args stream) (princ "()" stream))) - (pcase (help-split-fundoc (documentation object 'raw) object) - ;; Drop args which `help-function-arglist' already printed. - (`(,_usage . ,(and doc (guard (stringp doc)))) - (princ " " stream) - (prin1 doc stream))) - (let ((inter (interactive-form object))) - (when inter - (princ " " stream) - (cl-print-object - (if (eq 'byte-code (car-safe (cadr inter))) - `(interactive ,(make-byte-code nil (nth 1 (cadr inter)) - (nth 2 (cadr inter)) - (nth 3 (cadr inter)))) - inter) - stream))) - (if (eq cl-print-compiled 'disassemble) - (princ - (with-temp-buffer - (insert "\n") - (disassemble-1 object 0) - (buffer-string)) - stream) - (princ " " stream) - (let ((button-start (and cl-print-compiled-button - (bufferp stream) - (with-current-buffer stream (point))))) - (princ (format "#" (sxhash object)) stream) - (when (eq cl-print-compiled 'static) + (if (eq cl-print-compiled 'raw) + (let ((button-start + (and cl-print-compiled-button + (bufferp stream) + (with-current-buffer stream (1+ (point)))))) + (princ " " stream) + (prin1 object stream) + (when button-start + (with-current-buffer stream + (make-text-button button-start (point) + :type 'help-byte-code + 'byte-code-function object)))) + (pcase (help-split-fundoc (documentation object 'raw) object) + ;; Drop args which `help-function-arglist' already printed. + (`(,_usage . ,(and doc (guard (stringp doc)))) + (princ " " stream) + (prin1 doc stream))) + (let ((inter (interactive-form object))) + (when inter (princ " " stream) - (cl-print-object (aref object 2) stream)) - (when button-start - (with-current-buffer stream - (make-text-button button-start (point) - :type 'help-byte-code - 'byte-code-function object))))) - (princ ")" stream)) + (cl-print-object + (if (eq 'byte-code (car-safe (cadr inter))) + `(interactive ,(make-byte-code nil (nth 1 (cadr inter)) + (nth 2 (cadr inter)) + (nth 3 (cadr inter)))) + inter) + stream))) + (if (eq cl-print-compiled 'disassemble) + (princ + (with-temp-buffer + (insert "\n") + (disassemble-1 object 0) + (buffer-string)) + stream) + (princ " " stream) + (let ((button-start (and cl-print-compiled-button + (bufferp stream) + (with-current-buffer stream (point))))) + (princ (format "#" (sxhash object)) stream) + (when (eq cl-print-compiled 'static) + (princ " " stream) + (cl-print-object (aref object 2) stream)) + (when button-start + (with-current-buffer stream + (make-text-button button-start (point) + :type 'help-byte-code + 'byte-code-function object))))) + (princ ")" stream))) ;; This belongs in oclosure.el, of course, but some load-ordering issues make it ;; complicated. commit 41b83e899392b2b01f4b934d9f34b92a97ecbffd Author: Po Lu Date: Wed Oct 11 18:48:27 2023 +0800 Remedy typo in android.texi * doc/emacs/android.texi (Android Fonts): Replace @xref with @pxref. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 5177d9e473e..d4ce762e7a0 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -767,7 +767,7 @@ Android Fonts @code{sfnt-default-family-alist}; then, restart Emacs. Bear in mind that this is usually unwarranted, with customizations to the default or @code{variable-pitch} faces better made through modifying their -definitions (@xref{Face Customization}). +definitions (@pxref{Face Customization}). @node Android Troubleshooting @section Troubleshooting Startup Problems on Android commit 6265b7195d10150ad6948f45f4e33869be580d1c Author: Po Lu Date: Wed Oct 11 16:58:01 2023 +0800 Update Android keysym list * src/keyboard.c (lispy_function_keys): Introduce entries for scroll lock, num lock, and input method keys. diff --git a/src/keyboard.c b/src/keyboard.c index f756f163e87..76dec637cb1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4999,6 +4999,7 @@ #define FUNCTION_KEY_OFFSET 0 function keys that Emacs recognizes. */ [111] = "escape", [112] = "delete", + [116] = "scroll", [120] = "sysrq", [121] = "break", [122] = "home", @@ -5019,15 +5020,19 @@ #define FUNCTION_KEY_OFFSET 0 [140] = "f10", [141] = "f11", [142] = "f12", + [143] = "kp-numlock", [160] = "kp-ret", [164] = "volume-mute", + [165] = "info", [19] = "up", [20] = "down", + [211] = "zenkaku-hankaku", [213] = "muhenkan", [214] = "henkan", [215] = "hiragana-katakana", [218] = "kana", [21] = "left", + [223] = "sleep", [22] = "right", [23] = "select", [24] = "volume-up", @@ -5035,6 +5040,7 @@ #define FUNCTION_KEY_OFFSET 0 [25] = "volume-down", [268] = "kp-up-left", [269] = "kp-down-left", + [26] = "power", [270] = "kp-up-right", [271] = "kp-down-right", [272] = "media-skip-forward", @@ -5042,7 +5048,9 @@ #define FUNCTION_KEY_OFFSET 0 [277] = "cut", [278] = "copy", [279] = "paste", + [285] = "browser-refresh", [28] = "clear", + [300] = "XF86Forward", [4] = "XF86Back", [61] = "tab", [66] = "return", @@ -5056,6 +5064,7 @@ #define FUNCTION_KEY_OFFSET 0 [89] = "media-rewind", [92] = "prior", [93] = "next", + [95] = "mode-change", }; #elif defined HAVE_NTGUI commit 960c98ce3ac8e032db0c0293fa577094258600b8 Author: Juri Linkov Date: Wed Oct 11 09:27:28 2023 +0300 * lisp/progmodes/project.el (project-mode-line-face): New variable. (project-mode-line-format): Use it (bug#66317). diff --git a/etc/NEWS b/etc/NEWS index ececb7e8459..220568429fd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -894,6 +894,7 @@ showcases all their customization options. ** Project ++++ *** New user option 'project-mode-line'. When non-nil, display the name of the current project on the mode line. Clicking 'mouse-1' on the project name pops up the project diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 3c469d0e51f..fd9c146a1fd 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2030,6 +2030,9 @@ project-mode-line-map (define-key map [mode-line down-mouse-1] project-menu-entry) map)) +(defvar project-mode-line-face nil + "Face name to use for the project name on the mode line.") + (defvar project-mode-line-format '(:eval (project-mode-line-format))) (put 'project-mode-line-format 'risky-local-variable t) @@ -2040,6 +2043,7 @@ project-mode-line-format " " (propertize (project-name project) + 'face project-mode-line-face 'mouse-face 'mode-line-highlight 'help-echo "mouse-1: Project menu" 'local-map project-mode-line-map)))) commit cdf369b0129eb196684dad5d290c076392997770 Author: Mauro Aranda Date: Tue Oct 10 20:22:06 2023 -0300 Fix erc-server-prevent-duplicates :type * lisp/erc/erc-backend.el (erc-server-prevent-duplicates): Change :type to allow a variable-length list of strings. (Bug#66456) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index fb10ee31c78..2fb140f57ce 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -511,7 +511,7 @@ erc-server-prevent-duplicates "Either nil or a list of strings. Each string is a IRC message type, like PRIVMSG or NOTICE. All Message types in that list of subjected to duplicate prevention." - :type '(choice (const nil) (list string))) + :type '(repeat string)) (defcustom erc-server-duplicate-timeout 60 "The time allowed in seconds between duplicate messages. commit 239db5d5162f6f9a4a6735e176c8d306f18e50e7 Author: Jim Porter Date: Tue Sep 5 18:27:21 2023 -0700 Revert commits dafa6d6badd6 and 72c45fa9109a These were there to work around deficiencies in how Eshell produces completions for 'pcomplete-argument' (Eshell passed various non-string objects to Pcomplete, which broke things). Now, Eshell always returns a stringified form of the argument, with the original value stored via the text property 'pcomplete-arg-value'. * lisp/pcomplete.el (pcomplete-arg): Revert changes back to a simpler form. diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 0457f1b00c0..3dde001328d 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -685,35 +685,13 @@ pcomplete-arg The OFFSET argument is added to/taken away from the index that will be used. This is really only useful with `first' and `last', for -accessing absolute argument positions. - -When the argument has been transformed into something that is not -a string by `pcomplete-parse-arguments-function', the text -representation of the argument, namely what the user actually -typed in, is returned, and the value of the argument is stored in -the pcomplete-arg-value text property of that string." - (let ((arg - (nth (+ (pcase index - ('first 0) - ('last pcomplete-last) - (_ (- pcomplete-index (or index 0)))) - (or offset 0)) - pcomplete-args))) - (if (or (stringp arg) - ;; FIXME: 'last' is handled specially in Emacs 29, because - ;; 'pcomplete-parse-arguments' accepts a list of strings - ;; (which are completion candidates) as return value for - ;; (pcomplete-arg 'last). See below: "it means it's a - ;; list of completions computed during parsing, - ;; e.g. Eshell uses that to turn globs into lists of - ;; completions". This special case will be dealt with - ;; differently in Emacs 30: the pcomplete-arg-value - ;; property will be used by 'pcomplete-parse-arguments'. - (eq index 'last)) - arg - (propertize - (car (split-string (pcomplete-actual-arg index offset))) - 'pcomplete-arg-value arg)))) +accessing absolute argument positions." + (nth (+ (pcase index + ('first 0) + ('last pcomplete-last) + (_ (- pcomplete-index (or index 0)))) + (or offset 0)) + pcomplete-args)) (defun pcomplete-begin (&optional index offset) "Return the beginning position of the INDEXth argument. commit f7185ca29b5086b1b0f32e64b7a5ba0bc21152c8 Author: Michael Albinus Date: Tue Oct 10 19:51:22 2023 +0200 File notifications report unmount events (bug#66381) * doc/lispref/os.texi (File Notifications): Unmounting a watched filesystem is reported now. * etc/NEWS: File notifications report unmount events now. Fix typos. * lisp/filenotify.el (file-notify--callback-inotify) (file-notify--add-watch-inotify): Handle `unmount'. (file-notify--callback-kqueue, file-notify--add-watch-kqueue): Handle `revoke'. (file-notify--callback-gfilenotify): Handle `unmounted'. (file-notify-callback): Handle `unmount' and `unmounted'. (file-notify--add-watch-inotify): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): Handle `unmounted'. * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch): Handle `unmount' and `unmounted'. * src/gfilenotify.c (dir_monitor_callback): Handle Qunmounted. * src/inotify.c (symbol_to_inotifymask): Handle IN_IGNORED and IN_UNMOUNT. * src/kqueue.c (kqueue_callback, Fkqueue_add_watch): Handle NOTE_REVOKE. (Fkqueue_add_watch): Adapt docstring. (syms_of_kqueue): Declare `revoke. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 5400d492f0a..f92709f1f9b 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3355,7 +3355,8 @@ File Notifications The @code{stopped} event means that watching the file has been discontinued. This could be because @code{file-notify-rm-watch} was called (see below), or because the file being watched was deleted, or -due to another error reported from the underlying library which makes +because the filesystem of the file being watched was unmounted, or due +to another error reported from the underlying library which makes further watching impossible. @var{file} and @var{file1} are the name of the file(s) whose event is diff --git a/etc/NEWS b/etc/NEWS index 70110768c97..ececb7e8459 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -144,9 +144,7 @@ can use this to distinguish between buffers visiting files with the same base name that belong to different projects by using the provided transform function 'project-uniquify-dirname-transform'. -** 'insert-directory-program' is now a defcustom. - -** 'insert-directory-program' prefers "gls" on *BSD and macOS. +** 'insert-directory-program' is now a user option. On *BSD and macOS systems, this user option now defaults to the "gls" executable, if it exists. This should remove the need to change its value when installing GNU coreutils using something like ports or @@ -267,6 +265,7 @@ functions in CJK locales. * Changes in Specialized Modes and Packages in Emacs 30.1 ** gdb-mi + --- *** Variable order and truncation can now be configured in 'gdb-many-windows'. The new user option 'gdb-locals-table-row-config' allows users to @@ -285,7 +284,7 @@ If you want to get back the old behavior, set the user option to the value --- *** New user option 'gdb-display-io-buffer'. -If this is nil, "M-x gdb" will neither create nor display a separate +If this is nil, 'M-x gdb' will neither create nor display a separate buffer for the I/O of the program being debugged, but will instead redirect the program's interaction to the GDB execution buffer. The default is t, to preserve previous behavior. @@ -299,9 +298,9 @@ equivalent to the "--heading" option of some tools such as 'git grep' and 'rg'. The headings are displayed using the new 'grep-heading' face. ---- ** Compilation mode +--- *** The 'omake' matching rule is now disabled by default. This is because it partly acts by modifying other rules which may occasionally be surprising. It can be re-enabled by adding 'omake' to @@ -548,6 +547,11 @@ buffer must either visit a file, or it must run 'dired-mode'. Another method but "sudo" can be configured with user option 'tramp-file-name-with-method'. +** File Notifications + ++++ +*** All backends except w32notify detect unmounting of a watched filesystem now. + ** EWW +++ @@ -809,7 +813,8 @@ You can now configure how a thumbnail is named using this option. ** ERT -*** New macro `skip-when' to skip 'ert-deftest' tests. ++++ +*** New macro 'skip-when' to skip 'ert-deftest' tests. This can help avoid some awkward skip conditions. For example '(skip-unless (not noninteractive))' can be changed to the easier to read '(skip-when noninteractive)'. @@ -831,18 +836,19 @@ neither of which have been supported by Emacs since version 23.1. The user option 'url-gateway-nslookup-program' and the function 'url-gateway-nslookup-host' are consequently also obsolete. -+++ ** Edmacro ++++ *** New command 'edmacro-set-macro-to-region-lines'. Bound to 'C-c C-r', this command replaces the macro text with the lines of the region. If needed, the region is extended to include whole lines. If the region ends at the beginning of a line, that last line is excluded. ++++ *** New user option 'edmacro-reverse-macro-lines'. When this is non-nil, the lines of key sequences are displayed with -the most recent line fist. This is can be useful when working with +the most recent line first. This is can be useful when working with macros with many lines, such as from 'kmacro-edit-lossage'. @@ -861,8 +867,11 @@ A major mode based on the tree-sitter library for editing HEEx files. --- *** New major mode 'elixir-ts-mode'. -A major mode based on the tree-sitter library for editing Elixir -files. +A major mode based on the tree-sitter library for editing Elixir files. + +--- +*** New major mode 'lua-ts-mode'. +A major mode based on the tree-sitter library for editing Lua files. +++ ** New global minor mode 'minibuffer-regexp-mode'. @@ -871,10 +880,6 @@ It highlights parens via ‘show-paren-mode’ and ‘blink-matching-paren’ in a user-friendly way, avoids reporting alleged paren mismatches and makes sexp navigation more intuitive. ---- -*** New major mode 'lua-ts-mode'. -A major mode based on the tree-sitter library for editing Lua files. - --- ** The highly accessible Modus themes collection has eight items. The 'modus-operandi' and 'modus-vivendi' are the main themes that have @@ -913,7 +918,7 @@ the file listing's performance is still optimized. * Incompatible Lisp Changes in Emacs 30.1 -** 'post-gc-hook' runs after updating 'gcs-done' and `'gcs-elapsed'. +** 'post-gc-hook' runs after updating 'gcs-done' and 'gcs-elapsed'. --- ** The escape sequence '\x' not followed by hex digits is now an error. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index e9f8d4e515d..03bd4e51485 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -138,7 +138,7 @@ file-notify--callback-inotify ((memq action '(delete delete-self move-self)) 'deleted) ((eq action 'moved-from) 'renamed-from) ((eq action 'moved-to) 'renamed-to) - ((eq action 'ignored) 'stopped))) + ((memq action '(ignored unmount)) 'stopped))) actions)) file file1-or-cookie)) @@ -153,7 +153,8 @@ file-notify--callback-kqueue ((eq action 'write) 'changed) ((memq action '(attrib link)) 'attribute-changed) ((eq action 'delete) 'deleted) - ((eq action 'rename) 'renamed))) + ((eq action 'rename) 'renamed) + ((eq action 'revoke) 'stopped))) actions)) file file1-or-cookie)) @@ -179,7 +180,8 @@ file-notify--callback-gfilenotify ((memq action '(created changed attribute-changed deleted)) action) - ((eq action 'moved) 'renamed))) + ((eq action 'moved) 'renamed) + ((eq action 'unmounted) 'stopped))) (if (consp actions) actions (list actions)))) file file1-or-cookie)) @@ -195,6 +197,7 @@ file-notify-callback ((memq action '(created changed attribute-changed deleted)) action) ((eq action 'moved) 'renamed) + ((eq action 'unmounted) 'stopped) ;; inotify actions: ((eq action 'create) 'created) ((eq action 'modify) 'changed) @@ -202,7 +205,7 @@ file-notify-callback ((memq action '(delete delete-self move-self)) 'deleted) ((eq action 'moved-from) 'renamed-from) ((eq action 'moved-to) 'renamed-to) - ((eq action 'ignored) 'stopped))) + ((memq action '(ignored unmount)) 'stopped))) (if (consp actions) actions (list actions)))) file file1-or-cookie)) @@ -339,7 +342,7 @@ file-notify--add-watch-inotify "Add a watch for FILE in DIR with FLAGS, using inotify." (inotify-add-watch dir (append - '(dont-follow) + '(dont-follow ignored unmount) (and (memq 'change flags) '(create delete delete-self modify move-self move)) (and (memq 'attribute-change flags) @@ -352,6 +355,7 @@ file-notify--add-watch-kqueue ;; directories, so we watch each file directly. (kqueue-add-watch file (append + '(revoke) (and (memq 'change flags) '(create delete write extend rename)) (and (memq 'attribute-change flags) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 577760f806c..227571b148b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1490,10 +1490,10 @@ tramp-gvfs-handle-file-notify-add-watch (cond ((and (memq 'change flags) (memq 'attribute-change flags)) '(created changed changes-done-hint moved deleted - attribute-changed)) + attribute-changed unmounted)) ((memq 'change flags) - '(created changed changes-done-hint moved deleted)) - ((memq 'attribute-change flags) '(attribute-changed)))) + '(created changed changes-done-hint moved deleted unmounted)) + ((memq 'attribute-change flags) '(attribute-changed unmounted)))) (p (apply #'start-process "gvfs-monitor" (generate-new-buffer " *gvfs-monitor*") diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 95c27626166..4a5840cca4c 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3802,11 +3802,12 @@ tramp-sh-handle-file-notify-add-watch (cond ((and (memq 'change flags) (memq 'attribute-change flags)) (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self,attrib,ignored")) + "delete,delete_self,attrib")) ((memq 'change flags) (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self,ignored")) - ((memq 'attribute-change flags) "attrib,ignored")) + "delete,delete_self")) + ((memq 'attribute-change flags) "attrib")) + events (concat events ",ignored,unmount") ;; "-P" has been added to version 3.21, so we cannot assume it yet. sequence `(,command "-mq" "-e" ,events ,localname) ;; Make events a list of symbols. @@ -3821,10 +3822,10 @@ tramp-sh-handle-file-notify-add-watch (cond ((and (memq 'change flags) (memq 'attribute-change flags)) '(created changed changes-done-hint moved deleted - attribute-changed)) + attribute-changed unmounted)) ((memq 'change flags) - '(created changed changes-done-hint moved deleted)) - ((memq 'attribute-change flags) '(attribute-changed))) + '(created changed changes-done-hint moved deleted unmounted)) + ((memq 'attribute-change flags) '(attribute-changed unmounted))) sequence `(,command "monitor" ,localname))) ;; None. (t (tramp-error diff --git a/src/gfilenotify.c b/src/gfilenotify.c index de09ffe5fd3..3dd6390db10 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -88,7 +88,9 @@ dir_monitor_callback (GFileMonitor *monitor, && !NILP (Fmember (symbol, list5 (Qchanged, Qchanges_done_hint, Qdeleted, Qcreated, Qmoved)))) || (!NILP (Fmember (Qattribute_change, flags)) - && EQ (symbol, Qattribute_changed))) + && EQ (symbol, Qattribute_changed)) + || (!NILP (Fmember (Qwatch_mounts, flags)) + && EQ (symbol, Qunmounted))) { /* Construct an event. */ EVENT_INIT (event); @@ -105,8 +107,8 @@ dir_monitor_callback (GFileMonitor *monitor, /* XD_DEBUG_MESSAGE ("%s", XD_OBJECT_TO_STRING (event.arg)); */ } - /* Cancel monitor if file or directory is deleted. */ - if (!NILP (Fmember (symbol, list2 (Qdeleted, Qmoved))) + /* Cancel monitor if file or directory is deleted or unmounted. */ + if (!NILP (Fmember (symbol, list3 (Qdeleted, Qmoved, Qunmounted))) && strcmp (name, SSDATA (XCAR (XCDR (watch_object)))) == 0 && !g_file_monitor_is_cancelled (monitor)) g_file_monitor_cancel (monitor); diff --git a/src/inotify.c b/src/inotify.c index 105ff5a9d8a..247d9f03055 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -148,6 +148,11 @@ symbol_to_inotifymask (Lisp_Object symb) else if (EQ (symb, Qonlydir)) return IN_ONLYDIR; + else if (EQ (symb, Qignored)) + return IN_IGNORED; + else if (EQ (symb, Qunmount)) + return IN_UNMOUNT; + else if (EQ (symb, Qt) || EQ (symb, Qall_events)) return IN_ALL_EVENTS; else diff --git a/src/kqueue.c b/src/kqueue.c index 22c279b7ce3..43d5f40624b 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -320,13 +320,16 @@ kqueue_callback (int fd, void *data) directory is monitored. */ if (kev.fflags & NOTE_RENAME) actions = Fcons (Qrename, actions); + if (kev.fflags & NOTE_REVOKE) + actions = Fcons (Qrevoke, actions); /* Create the event. */ if (! NILP (actions)) kqueue_generate_event (watch_object, actions, file, Qnil); - /* Cancel monitor if file or directory is deleted or renamed. */ - if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) + /* Cancel monitor if file or directory is deleted or renamed or + the file system is unmounted. */ + if (kev.fflags & (NOTE_DELETE | NOTE_RENAME | NOTE_REVOKE)) Fkqueue_rm_watch (descriptor); } return; @@ -351,6 +354,7 @@ DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0, `attrib' -- a FILE attribute was changed `link' -- a FILE's link count was changed `rename' -- FILE was moved to FILE1 + `revoke' -- FILE was unmounted When any event happens, Emacs will call the CALLBACK function passing it a single argument EVENT, which is of the form @@ -437,6 +441,7 @@ DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0, if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB; if (! NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK; if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME; + if (! NILP (Fmember (Qrevoke, flags))) fflags |= NOTE_REVOKE; /* Register event. */ EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, @@ -526,6 +531,7 @@ syms_of_kqueue (void) DEFSYM (Qattrib, "attrib"); /* NOTE_ATTRIB */ DEFSYM (Qlink, "link"); /* NOTE_LINK */ DEFSYM (Qrename, "rename"); /* NOTE_RENAME */ + DEFSYM (Qrevoke, "revoke"); /* NOTE_REVOKE */ staticpro (&watch_list); commit 294567d171c9f1fbc961ea43c899269f46140570 Author: Ulrich Müller Date: Tue Oct 10 16:31:53 2023 +0200 ; Fix spelling of my name in all source files diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index ec32c72cb7b..c651b007173 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -1196,7 +1196,7 @@ History and Acknowledgments including modulo forms, primality testing, and float-to-fraction conversion. Units were added at the eager insistence of Mass Sivilotti. Later, -Ulrich Mueller at CERN and Przemek Klosowski at NIST provided invaluable +Ulrich Müller at CERN and Przemek Klosowski at NIST provided invaluable expert assistance with the units table. As far as I can remember, the idea of using algebraic formulas and variables to represent units dates back to an ancient article in Byte magazine about muMath, an early diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index 4f90470d4fb..4ef179003de 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -60,8 +60,7 @@ ;;; History: -;; 07/28/2008: version 0.2. Added VM interface, written by Ulrich -;; Mueller. +;; 07/28/2008: version 0.2. Added VM interface, written by Ulrich Müller. ;; 07/14/2008: Initial release @@ -288,7 +287,7 @@ mairix-gnus-fetch-field (message-field-value field))) ;;; VM -;;; written by Ulrich Mueller +;;; written by Ulrich Müller (declare-function vm-quit "ext:vm-folder" (&optional no-change)) (declare-function vm-visit-folder "ext:vm-startup" diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 32cb56ababd..02c40943ebf 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -37,7 +37,7 @@ ;; We acknowledge many contributions and valuable suggestions by ;; Lawrence R. Dodd, Ralf Fassel, Ralph Finch, Stephen Gildea, -;; Dr. Anil Gokhale, Ulrich Mueller, Mark Neale, Eric Prestemon, +;; Dr. Anil Gokhale, Ulrich Müller, Mark Neale, Eric Prestemon, ;; Gary Sabot and Richard Stallman. ;;; Code: commit 7f60267cc2e6984078bb0fb7fd01cb9690396e17 Author: Mattias Engdegård Date: Tue Oct 10 15:18:52 2023 +0200 ; * lisp/calc/calc-units.el (math-standard-units): Doc improvement. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 38e45ff7b9a..3e8f25966ef 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -183,6 +183,8 @@ math-standard-units ;; Temperature ( K nil "*Kelvin" K ) + ;; FIXME: Add °C and °F, but it requires that we sort out input etc for + ;; the ° sign. ( dC "K" "Degree Celsius" C ) ( degC "K" "Degree Celsius" C ) ( dF "(5/9) K" "Degree Fahrenheit" F ) @@ -315,7 +317,9 @@ math-standard-units DEF is a string defining the unit as a Calc expression; nil if base unit. DESC is a string describing the unit (to a human reader). A leading asterisk indicates that the unit is first in its group. -TEMP-UNIT is an additional symbol tabulated for temperature units (?) or nil. +TEMP-UNIT is `K', `C' or `F' for temperature units and is used to identify + the unit when doing absolute temperature conversion + (`calc-convert-temperature'). For other units, nil. HUMAN-DEF is a string defining the unit (to a human reader). If absent or nil, DEF is used. commit 1e250df590b3415a365f6620aba8431a3e255207 Author: Ulrich Müller Date: Tue Oct 10 11:59:15 2023 +0200 ; * lisp/calc/calc-units.el: Fix spelling of my name. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index b0f31633bbb..38e45ff7b9a 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -32,7 +32,7 @@ ;;; Units operations. -;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch) +;;; Units table last updated 9-Jan-91 by Ulrich Müller (ulm@vsnhd1.cern.ch) ;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov) ;;; Updated April 2002 by Jochen Küpper commit 36a8fe4ef211218a61538a41f891308ce1a70bca Author: Ulrich Müller Date: Tue Oct 10 11:58:03 2023 +0200 Update astronomical length units in Calc * lisp/calc/calc-units.el (math-standard-units): Update the astronomical unit and the parsec, using their definitions by the International Astronomical Union. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 480b0bd818d..b0f31633bbb 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -57,12 +57,13 @@ math-standard-units ( ft "12 in" "Foot") ( yd "3 ft" "Yard" ) ( mi "5280 ft" "Mile" ) - ( au "149597870691. m" "Astronomical Unit" nil - "149597870691 m (*)") - ;; (approx) NASA JPL (https://neo.jpl.nasa.gov/glossary/au.html) + ( au "149597870700 m" "Astronomical Unit") + ;; "149 597 870 700 m exactly" + ;; http://www.iau.org/static/resolutions/IAU2012_English.pdf ( lyr "c yr" "Light Year" ) - ( pc "3.0856775854*10^16 m" "Parsec (**)" nil - "3.0856775854 10^16 m (*)") ;; (approx) ESUWM + ( pc "(648000/pi) au" "Parsec (**)") + ;; "The parsec is defined as exactly (648 000/π) au" + ;; http://www.iau.org/static/resolutions/IAU2015_English.pdf ( nmi "1852 m" "Nautical Mile" ) ( fath "6 ft" "Fathom" ) ( fur "660 ft" "Furlong") commit c34a425d4dec9210284b5140a018d71950cac1bd Author: Mattias Engdegård Date: Tue Oct 10 14:20:05 2023 +0200 Correct temperature names in Calc * doc/misc/calc.texi (The Units Table, Predefined Units): * lisp/calc/calc-units.el (math-standard-units): It's just Kelvin, not degree Kelvin. diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 5064f76e7b8..ec32c72cb7b 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -28032,7 +28032,7 @@ The Units Table The @kbd{u e} (@code{calc-explain-units}) command displays an English description of the units of the expression on the stack. For example, for the expression @samp{62 km^2 g / s^2 mol K}, the description is -``Square-Kilometer Gram per (Second-squared Mole Degree-Kelvin).'' This +``Square-Kilometer Gram per (Second-squared Mole Kelvin).'' This command uses the English descriptions that appear in the righthand column of the Units Table. @@ -28066,8 +28066,8 @@ Predefined Units note that @code{oz} is a standard ounce of mass, @code{ozt} is a Troy ounce, and @code{ozfl} is a fluid ounce. -The temperature units corresponding to degrees Kelvin and Centigrade -(Celsius) are the same in this table, since most units commands treat +The temperature units corresponding to Kelvin and degree Celsius +are the same in this table, since most units commands treat temperatures as being relative. The @code{calc-convert-temperature} command has special rules for handling the different absolute magnitudes of the various temperature scales. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index c2f692007d5..480b0bd818d 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -181,9 +181,7 @@ math-standard-units ( hpm "75 m kgf/s" "Metric Horsepower") ;;ESUWM ;; Temperature - ( K nil "*Degree Kelvin" K ) - ( dK "K" "Degree Kelvin" K ) - ( degK "K" "Degree Kelvin" K ) + ( K nil "*Kelvin" K ) ( dC "K" "Degree Celsius" C ) ( degC "K" "Degree Celsius" C ) ( dF "(5/9) K" "Degree Fahrenheit" F ) commit 2c6015437e7fbb1f052a87ea37133b9240018c0d Author: Mattias Engdegård Date: Tue Oct 10 13:50:44 2023 +0200 * lisp/calc/calc-units.el (math-standard-units): Document. Some guesswork, but at least it helps someone trying to make sense of it next time. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 988fef2fcd2..c2f692007d5 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -307,8 +307,22 @@ math-standard-units "22.710947 10^-3 m^3/mol (*)") ;; Logarithmic units ( Np nil "*Neper") - ( dB "(ln(10)/20) Np" "decibel"))) - + ( dB "(ln(10)/20) Np" "decibel")) + "List of predefined units for Calc. + +Each element is (NAME DEF DESC TEMP-UNIT HUMAN-DEF), where: + +NAME is the unit symbol. +DEF is a string defining the unit as a Calc expression; nil if base unit. +DESC is a string describing the unit (to a human reader). + A leading asterisk indicates that the unit is first in its group. +TEMP-UNIT is an additional symbol tabulated for temperature units (?) or nil. +HUMAN-DEF is a string defining the unit (to a human reader). + If absent or nil, DEF is used. + +(*) in HUMAN-DEF means that the definition is approximate, otherwise exact. +(**) in DESC means that the unit name is different in TeX and LaTeX + display modes.") (defvar math-additional-units nil "Additional units table for user-defined units. commit 36d47f24dbb423247ede7b8a1047b4e64b29ac58 Author: Po Lu Date: Tue Oct 10 20:13:50 2023 +0800 * doc/emacs/android.texi (Android Software): Fix typo. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 303d4b8a90d..5177d9e473e 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -822,7 +822,7 @@ Android Software @cindex installing extra software on Android @cindex installing Unix software on Android - An exceptionally limited set of Unix-like command line tools are + An exceptionally limited set of Unix-like command line tools is distributed alongside default installations of Android. Several projects exist to augment this selection, providing options that range from improved reproductions of Unix command-line utilities to package commit d51f3165f7eb471acd3d178ef1b94b19254e8857 Author: Eli Zaretskii Date: Tue Oct 10 14:46:08 2023 +0300 Improve documentation of 'project-mode-line' * etc/NEWS: * doc/emacs/maintaining.texi (Projects): * lisp/progmodes/project.el (project-mode-line): Improve the documentation of 'project-mode-line'. (Bug#66317) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5f9a5d89bf3..d37cefebb01 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1743,6 +1743,14 @@ Projects files by default. That behavior is controllable with the variable @code{project-vc-include-untracked}. +@cindex current project name on mode line +@defopt project-mode-line +If this user option is non-@code{nil}, Emacs displays the name of the +current project (if any) on the mode line; clicking @kbd{mouse-1} on +the project name pops up the menu with the project-related commands. +The default value is @code{nil}. +@end defopt + @menu * Project File Commands:: Commands for handling project files. * Project Buffer Commands:: Commands for handling project buffers. diff --git a/etc/NEWS b/etc/NEWS index 934521ec1b0..70110768c97 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -890,8 +890,9 @@ showcases all their customization options. ** Project *** New user option 'project-mode-line'. -When non-nil, display the name of the current project on -the mode line. Clicking mouse-1 pops up the project menu. +When non-nil, display the name of the current project on the mode +line. Clicking 'mouse-1' on the project name pops up the project +menu. The default value is nil. *** New user option 'project-file-history-behavior'. Customizing it to 'relativize' makes commands like 'project-find-file' diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 9997833ceb1..3c469d0e51f 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2014,9 +2014,10 @@ project-uniquify-dirname-transform ;;;###autoload (defcustom project-mode-line nil - "Show the current project name with the menu on the mode line. + "Whether to show current project name and Project menu on the mode line. This feature requires the presence of the following item in -`mode-line-format': `(project-mode-line project-mode-line-format)'." +`mode-line-format': `(project-mode-line project-mode-line-format)'; it +is part of the default mode line beginning with Emacs 30." :type 'boolean :group 'project :version "30.1") commit 60e3071d57dd4fa59f08c312329033b9c9d32ea8 Author: Po Lu Date: Tue Oct 10 19:34:56 2023 +0800 Revise Android documentation * doc/emacs/android.texi (Android Environment, Android Windowing) (Android Fonts, Android Troubleshooting, Android Software): Correct typos and improve wording. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index bfa58b6cacc..303d4b8a90d 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -554,18 +554,18 @@ Android Environment @node Android Windowing @section The Android Window System - Android has an unusual window system; there, all windows are + Android's window system is unusual, in that all windows are maximized or full-screen, and only one window can be displayed at a -time. On larger devices, the system allows up to four windows to be -tiled on the screen at any time. +time. On larger devices, the system permits simultaneously tiling up +to four windows on the screen. - Windows on Android do not continue to exist indefinitely after they -are created. Instead, the system may choose to close windows that are -not on screen in order to save memory, with the assumption that the -program will save its contents to disk and restore them later, when -the user asks for it to be opened again. As this is obviously not -possible with Emacs, Emacs separates the resources associated with a -frame from its system window. + Windows on Android do not exist indefinitely after they are created. +Instead, the system may choose to close windows that are not on screen +in order to conserve memory, with the assumption that the program will +save its contents to disk and restore them later, when the user asks +for it to be opened again. As this is obviously not possible with +Emacs, Emacs separates the resources associated with a frame from its +system window. Each system window created (including the initial window created during Emacs startup) is appended to a list of windows that do not @@ -679,7 +679,7 @@ Android Windowing modifiers (@pxref{Modifier Keys}) reported within key events, subject to a single exception: if @key{Alt} on your keyboard is depressed, then the @key{Meta} modifier will be reported by Emacs in its place, -and vice versa. This irregularity is since most keyboards posses no +and vice versa. This irregularity is since most keyboards possess no special @key{Meta} key, and the @key{Alt} modifier is seldom employed in Emacs. @@ -713,8 +713,8 @@ Android Fonts @section Font Backends and Selection under Android @cindex fonts, android - Emacs supports two font backends under Android: they are respectively -named @code{sfnt-android} and @code{android}. + Emacs supports two font backends under Android: they are +respectively named @code{sfnt-android} and @code{android}. Upon startup, Emacs enumerates all the TrueType format fonts in the directories @file{/system/fonts} and @file{/product/fonts}, and the @@ -723,17 +723,17 @@ Android Fonts ``Droid Sans Mono'', and then defaults to using this font. These fonts are then displayed by the @code{sfnt-android} font driver. - When running on Android, Emacs currently lacks support for OpenType -fonts. This means that only a subset of the fonts installed on the -system are currently available to Emacs. If you are interested in -lifting this limitation, please contact @email{emacs-devel@@gnu.org}. + This font driver is presently without support for OpenType fonts; +hence, only a subset of the fonts installed on any given system are +available to Emacs. If you are interested in lifting this limitation, +please contact @email{emacs-devel@@gnu.org}. If the @code{sfnt-android} font driver fails to find any fonts at all, Emacs falls back to the @code{android} font driver. This is a -very lousy font driver, because of limitations and inaccuracies in the -font metrics provided by the Android platform. In that case, Emacs -uses the ``Monospace'' typeface configured on your system; this should -always be Droid Sans Mono. +very poor font driver, consequent upon limitations and inaccuracies in +the font metrics provided by the Android platform. In that case, +Emacs uses the ``Monospace'' typeface configured on your system; this +should always be Droid Sans Mono. @cindex TrueType GX fonts, android @cindex distortable fonts, android @@ -741,7 +741,7 @@ Android Fonts As on X systems, Emacs supports distortable fonts under Android. These fonts (also termed ``TrueType GX fonts'', ``variable fonts'', and ``multiple master fonts'') provide multiple different styles -(``Bold'', ``Italic'', etc) using a single font file. +(``Bold'', ``Italic'', and the like) using a single font file. When a user-installed distortable font is found, each style that a previously discovered font provided will no longer be used. In @@ -778,8 +778,8 @@ Android Troubleshooting Since Android has no command line, there is normally no way to specify command-line arguments when starting Emacs. This is very nasty when you make a mistake in your Emacs initialization files that -prevents Emacs from starting up at all, as the system normally -prevents other programs from accessing Emacs's home directory. +prevents Emacs from starting up at all, as the system generally +prohibits other programs from accessing Emacs's home directory. @xref{Initial Options}. However, Emacs can be started with the equivalent of either the @@ -822,11 +822,12 @@ Android Software @cindex installing extra software on Android @cindex installing Unix software on Android - Android includes an extremely limited set of Unix-like command line -tools in a default installation. Several projects exist to argument -this selection, providing options that range from improved -reproductions of Unix command-line utilities to package repositories -containing extensive collections of free GNU and Unix software. + An exceptionally limited set of Unix-like command line tools are +distributed alongside default installations of Android. Several +projects exist to augment this selection, providing options that range +from improved reproductions of Unix command-line utilities to package +repositories providing extensive collections of free GNU and Unix +software. @uref{http://busybox.net, Busybox} provides Unix utilities and limited replicas of certain popular GNU programs such as @@ -838,17 +839,17 @@ Android Software repositories containing substantial amounts of free software for Unix systems, including compilers, debuggers, and runtimes for languages such as C, C++, Java, Python and Common Lisp. These packages are -normally installed from within a purpose-built terminal emulator -application, but Emacs can access them if it is built with the same -application signing key as the Termux terminal emulator, and with its -``shared user ID'' set to the package name of the terminal emulator -program. The file @file{java/INSTALL} within the Emacs distribution -explains how to build Emacs in this fashion. +customarily installed from within a purpose-built terminal emulator +application, but access is also granted to Emacs when it is built with +the same application signing key, and its ``shared user ID'' is set to +the same package name, as that of the terminal emulator program. The +file @file{java/INSTALL} within the Emacs distribution illustrates how +to build Emacs in this fashion. @uref{https://github.com/termux/termux-packages, termux-packages} -provides the package definitions that are used by Termux to generate -their package repositories, which may also be independently compiled -for installation within Emacs's home directory. +provides the package definitions used by Termux to generate their +package repositories, which may also be independently compiled for +installation within Emacs's home directory. In addition to the projects mentioned above, statically linked binaries for most Linux kernel-based systems can also be run on commit b504faf003c507b79cdc7de5109f0f38e817f139 Author: Po Lu Date: Tue Oct 10 16:58:21 2023 +0800 Improve documentation of inhibit-double-buffering * doc/lispref/frames.texi (Management Parameters): Reword joke and mention the precise circumstances where inhibit-double-double-buffering is useful. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 5d6e1809286..75bc4de4f61 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2219,8 +2219,10 @@ Management Parameters @item inhibit-double-buffering If non-@code{nil}, the frame is drawn to the screen without double buffering. Emacs normally attempts to use double buffering, where -available, to reduce flicker. Set this property if you experience -display bugs or pine for that retro, flicker-y feeling. +available, to reduce flicker; nevertheless, this parameter is provided +for circumstances where double-buffering induces display corruption, +and for those eccentrics wistful for the immemorial flicker that once +beset Emacs. @vindex skip-taskbar@r{, a frame parameter} @item skip-taskbar commit 336c3674119f61bd78a056476769ce83b97230bb Author: Po Lu Date: Tue Oct 10 13:11:14 2023 +0800 Implement frame restacking under Android * java/org/gnu/emacs/EmacsActivity.java (invalidateFocus1): Synchronize with window.children for iteration through it. * java/org/gnu/emacs/EmacsService.java (queryTree): Synchronize with windowList for iteration through it. * java/org/gnu/emacs/EmacsView.java (moveChildToBack): Correct formatting mistake. (moveAbove, moveBelow): New functions. * java/org/gnu/emacs/EmacsWindow.java (destroyHandle, reparentTo) (raise, lower): Remedy synchronization blunders. (reconfigure): New function. * src/android.c (android_init_emacs_window): Link with `reconfigure'. (android_reconfigure_wm_window): New wrapper function. * src/androidfns.c (android_frame_restack): New function. (Fandroid_frame_restack): Properly implement this function and expunge outdated comment. * src/androidgui.h (enum android_stack_mode) (enum android_window_changes): New enumerators. diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index cecd9c21d99..f9aa261e355 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -89,8 +89,11 @@ public class EmacsActivity extends Activity if (window.view.isFocused ()) focusedWindow = window; - for (EmacsWindow child : window.children) - invalidateFocus1 (child); + synchronized (window.children) + { + for (EmacsWindow child : window.children) + invalidateFocus1 (child); + } } public static void diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 28b725d0cd0..6fa2ebb3fdb 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -505,15 +505,18 @@ invocation of app_process (through android-emacs) can else windowList = window.children; - array = new short[windowList.size () + 1]; - i = 1; + synchronized (windowList) + { + array = new short[windowList.size () + 1]; + i = 1; - array[0] = (window == null - ? 0 : (window.parent != null - ? window.parent.handle : 0)); + array[0] = (window == null + ? 0 : (window.parent != null + ? window.parent.handle : 0)); - for (EmacsWindow treeWindow : windowList) - array[i++] = treeWindow.handle; + for (EmacsWindow treeWindow : windowList) + array[i++] = treeWindow.handle; + } return array; } diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index d09dcc7e50d..877b1ce2429 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -581,12 +581,12 @@ else if (child.getVisibility () != GONE) /* The view at 0 is the surface view. */ attachViewToParent (child, 1, - child.getLayoutParams()); + child.getLayoutParams ()); } } - /* The following two functions must not be called if the view has no - parent, or is parented to an activity. */ + /* The following four functions must not be called if the view has + no parent, or is parented to an activity. */ public void raise () @@ -615,6 +615,40 @@ else if (child.getVisibility () != GONE) parent.moveChildToBack (this); } + public void + moveAbove (EmacsView view) + { + EmacsView parent; + int index; + + parent = (EmacsView) getParent (); + + if (parent != view.getParent ()) + throw new IllegalStateException ("Moving view above non-sibling"); + + index = parent.indexOfChild (this); + parent.detachViewFromParent (index); + index = parent.indexOfChild (view); + parent.attachViewToParent (this, index + 1, getLayoutParams ()); + } + + public void + moveBelow (EmacsView view) + { + EmacsView parent; + int index; + + parent = (EmacsView) getParent (); + + if (parent != view.getParent ()) + throw new IllegalStateException ("Moving view above non-sibling"); + + index = parent.indexOfChild (this); + parent.detachViewFromParent (index); + index = parent.indexOfChild (view); + parent.attachViewToParent (this, index, getLayoutParams ()); + } + @Override protected void onCreateContextMenu (ContextMenu menu) diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 1f28d5f4f53..8d444aa27f5 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -22,6 +22,7 @@ import java.lang.IllegalStateException; import java.util.ArrayList; import java.util.List; +import java.util.ListIterator; import java.util.HashMap; import java.util.LinkedHashMap; import java.util.Map; @@ -93,7 +94,9 @@ private static class Coordinate public EmacsWindow parent; /* List of all children in stacking order. This must be kept - consistent with their Z order! */ + consistent with their Z order! + + Synchronize access to this list with itself. */ public ArrayList children; /* Map between pointer identifiers and last known position. Used to @@ -165,7 +168,11 @@ private static class Coordinate if (parent != null) { - parent.children.add (this); + synchronized (parent.children) + { + parent.children.add (this); + } + EmacsService.SERVICE.runOnUiThread (new Runnable () { @Override public void @@ -214,7 +221,12 @@ private static class Coordinate destroyHandle () throws IllegalStateException { if (parent != null) - parent.children.remove (this); + { + synchronized (parent.children) + { + parent.children.remove (this); + } + } EmacsActivity.invalidateFocus (); @@ -1163,10 +1175,20 @@ private static class Coordinate /* Reparent this window to the other window. */ if (parent != null) - parent.children.remove (this); + { + synchronized (parent.children) + { + parent.children.remove (this); + } + } if (otherWindow != null) - otherWindow.children.add (this); + { + synchronized (otherWindow.children) + { + otherWindow.children.add (this); + } + } parent = otherWindow; @@ -1239,9 +1261,12 @@ else if (EmacsWindow.this.isMapped) if (parent == null) return; - /* Remove and add this view again. */ - parent.children.remove (this); - parent.children.add (this); + synchronized (parent.children) + { + /* Remove and add this view again. */ + parent.children.remove (this); + parent.children.add (this); + } /* Request a relayout. */ EmacsService.SERVICE.runOnUiThread (new Runnable () { @@ -1261,9 +1286,12 @@ else if (EmacsWindow.this.isMapped) if (parent == null) return; - /* Remove and add this view again. */ - parent.children.remove (this); - parent.children.add (this); + synchronized (parent.children) + { + /* Remove and add this view again. */ + parent.children.remove (this); + parent.children.add (this); + } /* Request a relayout. */ EmacsService.SERVICE.runOnUiThread (new Runnable () { @@ -1276,6 +1304,86 @@ else if (EmacsWindow.this.isMapped) }); } + public synchronized void + reconfigure (final EmacsWindow window, final int stackMode) + { + ListIterator iterator; + EmacsWindow object; + + /* This does nothing here. */ + if (parent == null) + return; + + /* If window is NULL, call lower or upper subject to + stackMode. */ + + if (window == null) + { + if (stackMode == 1) /* ANDROID_BELOW */ + lower (); + else + raise (); + + return; + } + + /* Otherwise, if window.parent is distinct from this, return. */ + if (window.parent != this.parent) + return; + + /* Synchronize with the parent's child list. Iterate over each + item until WINDOW is encountered, before moving this window to + the location prescribed by STACKMODE. */ + + synchronized (parent.children) + { + /* Remove this window from parent.children, for it will be + reinserted before or after WINDOW. */ + parent.children.remove (this); + + /* Create an iterator. */ + iterator = parent.children.listIterator (); + + while (iterator.hasNext ()) + { + object = iterator.next (); + + if (object == window) + { + /* Now place this before or after the cursor of the + iterator. */ + + if (stackMode == 0) /* ANDROID_ABOVE */ + iterator.add (this); + else + { + iterator.previous (); + iterator.add (this); + } + + /* Effect the same adjustment upon the view + hiearchy. */ + + EmacsService.SERVICE.runOnUiThread (new Runnable () { + @Override + public void + run () + { + if (stackMode == 0) + view.moveAbove (window.view); + else + view.moveBelow (window.view); + } + }); + } + } + + /* parent.children does not list WINDOW, which should never + transpire. */ + EmacsNative.emacsAbort (); + } + } + public synchronized int[] getWindowGeometry () { diff --git a/src/android.c b/src/android.c index b9236075a1e..d1182698669 100644 --- a/src/android.c +++ b/src/android.c @@ -104,6 +104,7 @@ Copyright (C) 2023 Free Software Foundation, Inc. jmethodID make_input_focus; jmethodID raise; jmethodID lower; + jmethodID reconfigure; jmethodID get_window_geometry; jmethodID translate_coordinates; jmethodID set_dont_accept_focus; @@ -1755,6 +1756,7 @@ #define FIND_METHOD(c_name, name, signature) \ FIND_METHOD (make_input_focus, "makeInputFocus", "(J)V"); FIND_METHOD (raise, "raise", "()V"); FIND_METHOD (lower, "lower", "()V"); + FIND_METHOD (reconfigure, "reconfigure", "(Lorg/gnu/emacs/EmacsWindow;I)V"); FIND_METHOD (get_window_geometry, "getWindowGeometry", "()[I"); FIND_METHOD (translate_coordinates, "translateCoordinates", @@ -4963,6 +4965,37 @@ android_lower_window (android_window handle) android_exception_check (); } +void +android_reconfigure_wm_window (android_window handle, + enum android_wc_value_mask value_mask, + struct android_window_changes *values) +{ + jobject sibling, window; + + window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); + + if (!(value_mask & ANDROID_CW_STACK_MODE)) + return; + + /* If value_mask & ANDROID_CW_SIBLING, place HANDLE above or below + values->sibling pursuant to values->stack_mode; else, reposition + it at the top or the bottom of its parent. */ + + sibling = NULL; + + if (value_mask & ANDROID_CW_SIBLING) + sibling = android_resolve_handle (values->sibling, + ANDROID_HANDLE_WINDOW); + + (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, + window, + window_class.class, + window_class.reconfigure, + sibling, + (jint) values->stack_mode); + android_exception_check (); +} + int android_query_tree (android_window handle, android_window *root_return, android_window *parent_return, diff --git a/src/androidfns.c b/src/androidfns.c index 3ee9f7634aa..772a4f51e78 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -1591,7 +1591,8 @@ DEFUN ("android-frame-geometry", Fandroid_frame_geometry, #endif } -DEFUN ("android-frame-edges", Fandroid_frame_edges, Sandroid_frame_edges, 0, 2, 0, +DEFUN ("android-frame-edges", Fandroid_frame_edges, + Sandroid_frame_edges, 0, 2, 0, doc: /* Return edge coordinates of FRAME. FRAME must be a live frame and defaults to the selected one. The return value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are @@ -1693,6 +1694,28 @@ DEFUN ("android-frame-list-z-order", Fandroid_frame_list_z_order, #endif } +#ifndef ANDROID_STUBIFY + +static void +android_frame_restack (struct frame *f1, struct frame *f2, + bool above_flag) +{ + android_window window1; + struct android_window_changes wc; + unsigned long mask; + + window1 = FRAME_ANDROID_WINDOW (f1); + wc.sibling = FRAME_ANDROID_WINDOW (f2); + wc.stack_mode = above_flag ? ANDROID_ABOVE : ANDROID_BELOW; + mask = ANDROID_CW_SIBLING | ANDROID_CW_STACK_MODE; + + block_input (); + android_reconfigure_wm_window (window1, mask, &wc); + unblock_input (); +} + +#endif /* !ANDROID_STUBIFY */ + DEFUN ("android-frame-restack", Fandroid_frame_restack, Sandroid_frame_restack, 2, 3, 0, doc: /* Restack FRAME1 below FRAME2. @@ -1709,19 +1732,25 @@ DEFUN ("android-frame-restack", Fandroid_frame_restack, \(stacking) order relative to all other frames excluding FRAME1 remains unaltered. -The Android system refuses to restack windows, so this does not -work. */) - (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object frame3) +Android does not facilitate restacking top-level windows managed by +its own window manager; nor is it possible to restack frames that are +children of different parents. Consequently, this function only +functions when FRAME1 and FRAME2 are both child frames subordinate to +the same parent frame. */) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) { #ifdef ANDROID_STUBIFY error ("Android cross-compilation stub called!"); return Qnil; -#else - /* This is not supported on Android because of limitations in the - platform that prevent ViewGroups from restacking - SurfaceViews. */ - return Qnil; -#endif +#else /* !ANDROID_STUBIFY */ + struct frame *f1 = decode_live_frame (frame1); + struct frame *f2 = decode_live_frame (frame2); + + if (!(FRAME_ANDROID_WINDOW (f1) && FRAME_ANDROID_WINDOW (f2))) + error ("Cannot restack frames"); + android_frame_restack (f1, f2, !NILP (above)); + return Qt; +#endif /* ANDROID_STUBIFY */ } DEFUN ("android-mouse-absolute-pixel-position", diff --git a/src/androidgui.h b/src/androidgui.h index 936706b092e..b58c39a5276 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -564,6 +564,24 @@ #define ANDROID_IS_MODIFIER_KEY(key) \ ANDROID_IC_MODE_TEXT = 2, }; +enum android_stack_mode + { + ANDROID_ABOVE = 0, + ANDROID_BELOW = 1, + }; + +enum android_wc_value_mask + { + ANDROID_CW_SIBLING = 0, + ANDROID_CW_STACK_MODE = 1, + }; + +struct android_window_changes +{ + android_window sibling; + enum android_stack_mode stack_mode; +}; + extern int android_pending (void); extern void android_next_event (union android_event *); extern bool android_check_if_event (union android_event *, @@ -643,6 +661,9 @@ #define ANDROID_IS_MODIFIER_KEY(key) \ extern void android_set_input_focus (android_window, unsigned long); extern void android_raise_window (android_window); extern void android_lower_window (android_window); +extern void android_reconfigure_wm_window (android_window, + enum android_wc_value_mask, + struct android_window_changes *); extern int android_query_tree (android_window, android_window *, android_window *, android_window **, unsigned int *); commit eedd9db6190a7f69403aefe8098a554ef2b51371 Author: Kyle Meyer Date: Mon Oct 9 23:47:52 2023 -0400 Update to Org 9.6.10 diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 62ba687c19f..240e3366b0b 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.9} +\def\orgversionnumber{9.6.10} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index d3e61643190..38e81d9d713 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6784,7 +6784,8 @@ org-agenda-get-scheduled (let ((deadline (time-to-days (when (org-element-property :deadline el) (org-time-string-to-time - (org-element-property :deadline el)))))) + (org-element-interpret-data + (org-element-property :deadline el))))))) (and (<= schedule deadline) (> current deadline)))) (`not-today pastschedp) (`t t) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 28cfd0d910c..475416ecf74 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -525,7 +525,8 @@ org-columns-remove-overlays (setq header-line-format org-previous-header-line-format) (kill-local-variable 'org-previous-header-line-format) (remove-hook 'post-command-hook #'org-columns-hscroll-title 'local)) - (set-marker org-columns-begin-marker nil) + (when (markerp org-columns-begin-marker) + (set-marker org-columns-begin-marker nil)) (when (markerp org-columns-top-level-marker) (set-marker org-columns-top-level-marker nil)) (with-silent-modifications diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index a859fe6d412..cfef38581c6 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.6.9")) + (let ((org-release "9.6.10")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.6.9")) + (let ((org-git-version "release_9.6.10")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index f97b9b6c753..0ba0cef4490 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9,7 +9,7 @@ ;; URL: https://orgmode.org ;; Package-Requires: ((emacs "26.1")) -;; Version: 9.6.9 +;; Version: 9.6.10 ;; This file is part of GNU Emacs. ;; commit 238292d6571402e93d4f7886baac9853011b36f6 Author: Juri Linkov Date: Mon Oct 9 21:09:03 2023 +0300 New option 'project-mode-line' to show project name on mode line (bug#66317) * lisp/bindings.el (standard-mode-line-format): Add '(project-mode-line project-mode-line-format)'. * lisp/progmodes/project.el (project-mode-line): New user option. (project-menu-entry, project-mode-line-map): New variables. (project-mode-line-format): New variable. (project-mode-line-format): New function. diff --git a/etc/NEWS b/etc/NEWS index 8e05c668439..934521ec1b0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -889,6 +889,10 @@ showcases all their customization options. ** Project +*** New user option 'project-mode-line'. +When non-nil, display the name of the current project on +the mode line. Clicking mouse-1 pops up the project menu. + *** New user option 'project-file-history-behavior'. Customizing it to 'relativize' makes commands like 'project-find-file' and 'project-find-dir' display previous history entries relative to diff --git a/lisp/bindings.el b/lisp/bindings.el index 207adb3a2a4..70e4087e131 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -682,6 +682,7 @@ mode-line-end-spaces 'mode-line-buffer-identification " " 'mode-line-position + '(project-mode-line project-mode-line-format) '(vc-mode vc-mode) " " 'mode-line-modes diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 68d5edc482c..9997833ceb1 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2010,5 +2010,38 @@ project-uniquify-dirname-transform (file-relative-name dirname root)))) dirname)) +;;; Project mode-line + +;;;###autoload +(defcustom project-mode-line nil + "Show the current project name with the menu on the mode line. +This feature requires the presence of the following item in +`mode-line-format': `(project-mode-line project-mode-line-format)'." + :type 'boolean + :group 'project + :version "30.1") + +(defvar project-menu-entry + `(menu-item "Project" ,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) + map)) + +(defvar project-mode-line-format '(:eval (project-mode-line-format))) +(put 'project-mode-line-format 'risky-local-variable t) + +(defun project-mode-line-format () + "Compose the project mode-line." + (when-let ((project (project-current))) + (concat + " " + (propertize + (project-name project) + 'mouse-face 'mode-line-highlight + 'help-echo "mouse-1: Project menu" + 'local-map project-mode-line-map)))) + (provide 'project) ;;; project.el ends here commit 2cdf80bb8f56110b45dbde3e22dfa69d6f1fdc9c Author: Juri Linkov Date: Mon Oct 9 21:03:03 2023 +0300 * lisp/progmodes/xref.el: Show the number of matches on mode-line (bug#66332) (xref-num-matches-found, xref-num-matches-face, xref-mode-line-matches): New variables. (xref--show-xref-buffer): Set xref-num-matches-found to the length of xrefs, and buffer-local mode-line-process to xref-mode-line-matches. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b7bfb192d87..fd788ec8f32 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -638,6 +638,18 @@ xref-match "Face used to highlight matches in the xref buffer." :version "28.1") +(defvar-local xref-num-matches-found 0) + +(defvar xref-num-matches-face 'compilation-info + "Face name to show the number of matches on the mode line.") + +(defconst xref-mode-line-matches + `(" [" (:propertize (:eval (int-to-string xref-num-matches-found)) + face ,xref-num-matches-face + help-echo "Number of matches so far") + "]")) +(put 'xref-mode-line-matches 'risky-local-variable t) + (defmacro xref--with-dedicated-window (&rest body) `(let* ((xref-w (get-buffer-window xref-buffer-name)) (xref-w-dedicated (window-dedicated-p xref-w))) @@ -1235,6 +1247,8 @@ xref--show-xref-buffer (xref--ensure-default-directory dd (current-buffer)) (xref--xref-buffer-mode) (xref--show-common-initialize xref-alist fetcher alist) + (setq xref-num-matches-found (length xrefs)) + (setq mode-line-process (list xref-mode-line-matches)) (pop-to-buffer (current-buffer)) (setq buf (current-buffer))) (xref--auto-jump-first buf (assoc-default 'auto-jump alist)) commit fc1f6688a2d673e6f440700b6b256de2a96d652a Author: Harald Jörg Date: Mon Oct 9 17:49:15 2023 +0200 ; cperl-mode.el: Don't override fontificaton in comments. * lisp/progmodes/cperl-mode.el (cperl-init-faces): Reorder the matchers for fontification of array and hash elements and keys so that they don't override comment and string fontification (Bug#66145). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-66145): New test for all combinations of sigils and brackets/braces to verify that strings and comments are left untouched. This test also works for perl-mode which has always done it correctly. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl: New resource file for the above test. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 1736b45c72d..c2d9c0d6020 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6049,35 +6049,6 @@ cperl-init-faces ;; (matcher subexp facespec) '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$" 1 font-lock-function-name-face) - ;; -------- bareword hash key: $foo{bar}, $foo[1]{bar} - ;; (matcher (subexp facespec) ... - `(,(rx (or (in "]}\\%@>*&") - (sequence "$" (eval cperl--normal-identifier-rx))) - (0+ blank) "{" (0+ blank) - (group-n 1 (sequence (opt "-") - (eval cperl--basic-identifier-rx))) - (0+ blank) "}") -;; '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - (1 font-lock-string-face t) - ;; -------- anchored bareword hash key: $foo{bar}{baz} - ;; ... (anchored-matcher pre-form post-form subex-highlighters) - (,(rx point - (0+ blank) "{" (0+ blank) - (group-n 1 (sequence (opt "-") - (eval cperl--basic-identifier-rx))) - (0+ blank) "}") - ;; ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - nil nil - (1 font-lock-string-face t))) - ;; -------- hash element assignments with bareword key => value - ;; (matcher subexp facespec) - `(,(rx (in "[ \t{,()") - (group-n 1 (sequence (opt "-") - (eval cperl--basic-identifier-rx))) - (0+ blank) "=>") - 1 font-lock-string-face t) - ;; '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 - ;; font-lock-string-face t) ;; -------- labels ;; (matcher subexp facespec) `(,(rx @@ -6177,32 +6148,33 @@ cperl-init-faces (setq t-font-lock-keywords-1 `( - ;; -------- arrays and hashes. Access to elements is fixed below - ;; (matcher subexp facespec) - ;; facespec is an expression to distinguish between arrays and hashes - (,(rx (group-n 1 (group-n 2 (or (in "@%") "$#")) - (eval cperl--normal-identifier-rx))) - 1 -;; ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 - (if (eq (char-after (match-beginning 2)) ?%) - 'cperl-hash-face - 'cperl-array-face) - nil) - ;; -------- access to array/hash elements - ;; (matcher subexp facespec) - ;; facespec is an expression to distinguish between arrays and hashes - (,(rx (group-n 1 (group-n 2 (in "$@%")) - (eval cperl--normal-identifier-rx)) - (0+ blank) - (group-n 3 (in "[{"))) -;; ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" - 1 - (if (= (- (match-end 2) (match-beginning 2)) 1) - (if (eq (char-after (match-beginning 3)) ?{) - 'cperl-hash-face - 'cperl-array-face) ; arrays and hashes - font-lock-variable-name-face) ; Just to put something - t) ; override previous + ;; -------- bareword hash key: $foo{bar}, $foo[1]{bar} + ;; (matcher (subexp facespec) ... + (,(rx (or (in "]}\\%@>*&") + (sequence "$" (eval cperl--normal-identifier-rx))) + (0+ blank) "{" (0+ blank) + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "}") +;; '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + (1 font-lock-string-face) + ;; -------- anchored bareword hash key: $foo{bar}{baz} + ;; ... (anchored-matcher pre-form post-form subex-highlighters) + (,(rx point + (0+ blank) "{" (0+ blank) + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "}") + ;; ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + nil nil + (1 font-lock-string-face))) + ;; -------- hash element assignments with bareword key => value + ;; (matcher subexp facespec) + (,(rx (in "[ \t{,()") + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "=>") + 1 font-lock-string-face) ;; -------- @$ array dereferences, $#$ last array index ;; (matcher (subexp facespec) (subexp facespec)) (,(rx (group-n 1 (or "@" "$#")) @@ -6221,6 +6193,32 @@ cperl-init-faces ;; ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" (1 'cperl-hash-face) (2 font-lock-variable-name-face)) + ;; -------- access to array/hash elements + ;; (matcher subexp facespec) + ;; facespec is an expression to distinguish between arrays and hashes + (,(rx (group-n 1 (group-n 2 (in "$@%")) + (eval cperl--normal-identifier-rx)) + (0+ blank) + (group-n 3 (in "[{"))) +;; ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" + 1 + (if (= (- (match-end 2) (match-beginning 2)) 1) + (if (eq (char-after (match-beginning 3)) ?{) + 'cperl-hash-face + 'cperl-array-face) ; arrays and hashes + font-lock-variable-name-face) ; Just to put something + nil) ; do not override previous + ;; -------- "Pure" arrays and hashes. + ;; (matcher subexp facespec) + ;; facespec is an expression to distinguish between arrays and hashes + (,(rx (group-n 1 (group-n 2 (or (in "@%") "$#")) + (eval cperl--normal-identifier-rx))) + 1 +;; ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 + (if (eq (char-after (match-beginning 2)) ?%) + 'cperl-hash-face + 'cperl-array-face) + nil) ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") ;;; Too much noise from \s* @s[ and friends ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl new file mode 100644 index 00000000000..70f12346ded --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl @@ -0,0 +1,62 @@ +# The original code, from the bug report, with variables renamed + +sub foo { + # Here we do something like + # this: $array_comment [ num_things ]->{key_comment} +} + +# -------------------------------------------------- +# Comments containing hash and array sigils + +# This is an @array, and this is a %hash +# $array_comment[$index] = $hash_comment{key_comment} +# The last element has the index $#array_comment +# my @a_slice = @array_comment[1,2,3]; +# my @h_slice = @hash_comment{qw(a b c)}; +# my %a_set = %array_comment[1,2,3]; +# my %h_set = %hash_comment{qw(a b c)}; + +# -------------------------------------------------- +# in POD + +=head1 NAME + +cperl-bug-66145 - don't fontify arrays and hashes in POD + +=head1 SYNOPSIS + + $array_comment[$index] = $hash_comment{key_comment}; + @array_comment = qw(in pod); + %hash_comment = key_comment => q(pod); + @array_comment = @array_comment[1,2,3]; + @array_comment = @hash_comment{qw(a b c)}; + %hash_comment = %array_comment[1,2,3]; + %hash_comment = %hash_comment{qw(a b c)}; + +=cut + +# -------------------------------------------------- +# in strings + +my @strings = ( + q/$array_string[$index] = $hash_string{key_string};/, + q/my @array_string = qw(in unquoted string);/, + q/my %hash_string = (key_string => q(pod);)/, + q/@array_string = @array_string[1,2,3];/, + q/@array_string = @hash_string{qw(a b c)};/, + q/%hash_string = %array_string[1,2,3];/, + q/%hash_string = %hash_string{qw(a b c)};/, +); + +# -------------------------------------------------- +# in a HERE-document (perl-mode has an extra face for that) + +my $here = < q(pod); + @array_here = @array_here[1,2,3]; + @array_here = @hash_here{qw(a b c)}; + %hash_here = %array_here[1,2,3]; + %hash_here = %hash_here{qw(a b c)}; +DONE diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index a29ee54b6b9..87d4f11280c 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1379,6 +1379,29 @@ cperl-test-bug-64364 (forward-line 1)))) (cperl-set-style-back)) +(ert-deftest cperl-test-bug-66145 () + "Verify that hashes and arrays are only fontified in code. +In strings, comments and POD the syntaxified faces should +prevail. The tests exercise all combinations of sigils $@% and +parenthesess [{ for comments, POD, strings and HERE-documents. +Fontification in code for `cperl-mode' is done in the tests +beginning with `cperl-test-unicode`." + (let ((types '("array" "hash" "key")) + (faces `(("string" . font-lock-string-face) + ("comment" . font-lock-comment-face) + ("here" . ,(if (equal cperl-test-mode 'perl-mode) + 'perl-heredoc + font-lock-string-face))))) + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-66145.pl")) + (funcall cperl-test-mode) + (font-lock-ensure) + (dolist (type types) + (goto-char (point-min)) + (while (re-search-forward (concat type "_\\([a-z]+\\)") nil t) + (should (equal (get-text-property (match-beginning 1) 'face) + (cdr (assoc (match-string-no-properties 1) + faces))))))))) (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) commit 156392fee547dc07363b425f5226cfa0f28f6105 Author: Mattias Engdegård Date: Mon Oct 9 17:18:17 2023 +0200 Don't allow Services entries in pop-up menus on macOS (bug#66420) * src/nsmenu.m ([EmacsMenu runMenuAt:forFrame:keymaps:]): Prevent the system from adding context menu plug-ins (Services entries or sub-menu) to all our pop-up menus. diff --git a/src/nsmenu.m b/src/nsmenu.m index 4a86864176d..fb356c6b861 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -768,6 +768,10 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f pressure: 0]; context_menu_value = -1; +#ifdef NS_IMPL_COCOA + /* Don't let the system add a Services menu here. */ + self.allowsContextMenuPlugIns = NO; +#endif [NSMenu popUpContextMenu: self withEvent: event forView: view]; retVal = context_menu_value; context_menu_value = 0; commit 4da644edf60e238d74334f121d5d07870496e368 Author: Gerd Möllmann Date: Mon Oct 9 15:20:37 2023 +0200 ; LLDB synthetic child provider diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index f92a7e03a41..24b127a1fb9 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -88,7 +88,7 @@ def __init__(self, lisp_obj): self.init_values() def init_unsigned(self): - if self.lisp_obj.GetNumChildren() != 0: + if self.lisp_obj.GetType().GetTypeClass() == lldb.eTypeClassStruct: # Lisp_Object is actually a struct. lisp_word = self.lisp_obj.GetValueForExpressionPath(".i") self.unsigned = lisp_word.GetValueAsUnsigned() @@ -213,6 +213,41 @@ def xdebug_print(debugger, command, result, internal_dict): def type_summary_Lisp_Object(obj, internal_dict): return Lisp_Object(obj).summary() +# Don't know at the moment how to use this outside of the LLDB gui +# command. And it's still incomplete. +class Lisp_Object_Provider: + def __init__(self, valobj, internal_dict): + self.valobj = valobj + self.lisp_obj = Lisp_Object(valobj) + self.child = None + + def update(self): + if self.lisp_obj.lisp_type == "Lisp_Symbol": + self.child = self.lisp_obj.get_symbol_name().Clone("name") + self.child.SetSyntheticChildGenerated(True) + elif self.lisp_obj.lisp_type == "Lisp_String": + self.child = self.lisp_obj.get_string_data().Clone("data") + self.child.SetSyntheticChildGenerated(True) + else: + self.child = self.lisp_obj.value.Clone("untagged") + self.child.SetSyntheticChildGenerated(True) + + def has_children(self): + return True + + def num_children(self): + return 1 + + def get_child_index(self, name): + return 0 + + # This works insofar as struct frame * works, but it doesn't work + # Lisp_Symbol, for example. + def get_child_at_index(self, index): + if index != 0: + return None + return self.child + ######################################################################## # Initialization @@ -246,6 +281,17 @@ def define_type_summary(debugger, regex, function): f"--python-function {python_function} " + regex) +# Define Python class CLS as a children provider for the types +# matching REFEXP. Providers are defined in the category Emacs, and +# can be seen with 'type synthetic list -w Emacs', and deleted in a +# similar way. +def define_type_synthetic(debugger, regex, cls): + python_class = __name__ + "." + cls.__name__ + debugger.HandleCommand(f"type synthetic add " + f"--category Emacs " + f"--python-class {python_class} " + + regex) + # Enable a given category of type summary providers. def enable_type_category(debugger, category): debugger.HandleCommand(f"type category enable {category}") @@ -255,6 +301,7 @@ def __lldb_init_module(debugger, internal_dict): define_command(debugger, xbacktrace) define_command(debugger, xdebug_print) define_type_summary(debugger, "Lisp_Object", type_summary_Lisp_Object) + define_type_synthetic(debugger, "Lisp_Object", Lisp_Object_Provider) enable_type_category(debugger, "Emacs") print('Emacs debugging support has been installed.') commit 63a6fb2a7a02ca88835c3fd473894d3b7d39ff15 Author: Philip Kaludercic Date: Mon Oct 9 10:23:36 2023 +0200 Improve formatting of bindings in 'help-quick' * lisp/help.el (help-quick): Prevent format's padding from extending text properties beyond the initial string containing the key binding. diff --git a/lisp/help.el b/lisp/help.el index 3a641ccc1be..41c43c356a4 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -192,7 +192,7 @@ help-quick max-key-len (max (length key) max-key-len)) (push (list key (cdr ent) (car ent)) keys)))) (when keys - (let ((fmt (format "%%-%ds %%-%ds%s" max-key-len max-cmd-len + (let ((fmt (format "%%s %%-%ds%s" max-cmd-len (make-string padding ?\s))) (width (+ max-key-len 1 max-cmd-len padding))) (push `(,width @@ -203,10 +203,12 @@ help-quick 'face 'bold) ,@(mapcar (lambda (ent) (format fmt - (propertize - (car ent) - 'quick-help-cmd - (caddr ent)) + (concat + (propertize + (car ent) + 'quick-help-cmd + (caddr ent)) + (make-string (- max-key-len (length (car ent))) ?\s)) (cadr ent))) keys)) blocks))))) commit 5528bea8d6a0a4d4fdab9cb830b09cb5445bea89 Author: Philip Kaludercic Date: Mon Oct 9 10:10:47 2023 +0200 Use text-mode as default value for 'rcirc-multiline-major-mode' * lisp/net/rcirc.el (rcirc-multiline-major-mode): Update default value. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 3f6242d9347..7cc7adc45c7 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -392,8 +392,9 @@ rcirc-coding-system-alist (cons (coding-system :tag "Decode") (coding-system :tag "Encode"))))) -(defcustom rcirc-multiline-major-mode 'fundamental-mode +(defcustom rcirc-multiline-major-mode #'text-mode "Major-mode function to use in multiline edit buffers." + :version "30.1" :type 'function) (defcustom rcirc-nick-completion-format "%s: " commit 73ccd9d2959aba36b2433c5c6d0a3bc81114e76d Author: Yuan Fu Date: Wed Sep 27 00:21:40 2023 -0700 Don't call font-lock-mode in treesit-major-mode-setup (bug#66223) * lisp/treesit.el (treesit-major-mode-setup): Remove. (cherry picked from commit a3a840c80a217db7d4d125c667ff7d4946507fbb) diff --git a/lisp/treesit.el b/lisp/treesit.el index e8d57dfcd06..c4aba4c3e8d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2386,7 +2386,6 @@ treesit-major-mode-setup '( nil nil nil nil (font-lock-fontify-syntactically-function . treesit-font-lock-fontify-region))) - (font-lock-mode 1) (treesit-font-lock-recompute-features) (dolist (parser (treesit-parser-list)) (treesit-parser-add-notifier commit 53292c5d8186dfac5c82b0d16a10d91c691ae75f Author: nverno Date: Sat Oct 7 19:36:44 2023 -0700 Fix treesit-query-validate for string input (bug#66400) * lisp/treesit.el (treesit-query-validate): Don't expand if QUERY is string. diff --git a/lisp/treesit.el b/lisp/treesit.el index 98eac7f6d63..e8d57dfcd06 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2528,7 +2528,9 @@ treesit-query-validate (start (nth 1 data)) (inhibit-read-only t)) (erase-buffer) - (insert (treesit-query-expand query)) + (insert (if (stringp query) + query + (treesit-query-expand query))) (goto-char start) (search-forward " " nil t) (put-text-property start (point) 'face 'error) commit 9e78b82d1b8eaa02309d220d995db199e9e040fe Author: Po Lu Date: Mon Oct 9 09:30:56 2023 +0800 Update default font substitution list * src/sfntfont-android.c (init_sfntfont_android): Account for Android 4.x not distributing Noto Serif. diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c index be75c2d9e22..e49615210eb 100644 --- a/src/sfntfont-android.c +++ b/src/sfntfont-android.c @@ -746,13 +746,19 @@ syms_of_sfntfont_android_for_pdumper (void) void init_sfntfont_android (void) { + int api_level; + if (!android_init_gui) return; + api_level = android_get_current_api_level (); + /* Make sure to pick the proper Sans Serif and Serif fonts for the version of Android the device is running. */ - if (android_get_current_api_level () >= 15) + if (api_level >= 21) + /* Android 5.0 and later distribute Noto Serif in lieu of Droid + Serif. */ Vsfnt_default_family_alist = list4 (Fcons (build_string ("Monospace"), build_string ("Droid Sans Mono")), @@ -764,6 +770,20 @@ init_sfntfont_android (void) build_string ("Roboto")), Fcons (build_string ("DejaVu Serif"), build_string ("Noto Serif"))); + else if (api_level >= 15) + /* Android 4.0 and later distribute Roboto in lieu of Droid + Sans. */ + Vsfnt_default_family_alist + = list4 (Fcons (build_string ("Monospace"), + build_string ("Droid Sans Mono")), + /* Android doesn't come with a Monospace Serif font, so + this will have to do. */ + Fcons (build_string ("Monospace Serif"), + build_string ("Droid Sans Mono")), + Fcons (build_string ("Sans Serif"), + build_string ("Roboto")), + Fcons (build_string ("DejaVu Serif"), + build_string ("Droid Serif"))); else Vsfnt_default_family_alist = list4 (Fcons (build_string ("Monospace"), commit 35205f19ca9c3aa4e70bd3a233c500ff7b5fa0cf Author: Joseph Turner Date: Sun Oct 8 23:29:23 2023 +0200 Make package-vc-install-from-checkout NAME argument optional * lisp/emacs-lisp/package-vc.el (package-vc-install-from-checkout): Allow nil NAME; update documentation. (Bug#66393) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 88304c49675..9780e4d53de 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -953,18 +953,19 @@ package-vc-checkout (find-file directory))) ;;;###autoload -(defun package-vc-install-from-checkout (dir name) +(defun package-vc-install-from-checkout (dir &optional name) "Install the package NAME from its source directory DIR. +NAME defaults to the base name of DIR. Interactively, prompt the user for DIR, which should be a directory under version control, typically one created by `package-vc-checkout'. If invoked interactively with a prefix argument, prompt the user -for the NAME of the package to set up. Otherwise infer the package -name from the base name of DIR." - (interactive (let ((dir (read-directory-name "Directory: "))) - (list dir - (if current-prefix-arg - (read-string "Package name: ") - (file-name-base (directory-file-name dir)))))) +for the NAME of the package to set up." + (interactive (let* ((dir (read-directory-name "Directory: ")) + (base (file-name-base (directory-file-name dir)))) + (list dir (and current-prefix-arg + (read-string + (format-prompt "Package name" base) + nil nil base))))) (unless (vc-responsible-backend dir) (user-error "Directory %S is not under version control" dir)) (package-vc--archives-initialize) commit 68318dfd1652151f7d08f7682303499494a0c427 Author: Philip Kaludercic Date: Tue Oct 3 10:08:52 2023 +0200 Do not scrape :ignored-files for dependencies * lisp/emacs-lisp/package-vc.el (package-vc--unpack-1): If a file matches the ignored packages in :ignored-files, do not install any dependencies it lists. diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index a8393cb7e75..88304c49675 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -501,7 +501,8 @@ package-vc--unpack-1 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 (missing) + (let ((pkg-spec (package-vc--desc->spec pkg-desc)) + missing) ;; Remove any previous instance of PKG-DESC from `package-alist' (let ((pkgs (assq (package-desc-name pkg-desc) package-alist))) (when pkgs @@ -510,17 +511,29 @@ package-vc--unpack-1 ;; In case the package was installed directly from source, the ;; dependency list wasn't know beforehand, and they might have ;; to be installed explicitly. - (let ((deps '())) + (let ((ignored-files + (if (plist-get pkg-spec :ignored-files) + (mapconcat + (lambda (ignore) + (wildcard-to-regexp + (if (string-match-p "\\`/" ignore) + (concat pkg-dir ignore) + (concat "*/" ignore)))) + (plist-get pkg-spec :ignored-files) + "\\|") + regexp-unmatchable)) + (deps '())) (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) - (with-temp-buffer - (insert-file-contents file) - (when-let* ((require-lines (lm-header-multiline "package-requires"))) - (thread-last - (mapconcat #'identity require-lines " ") - package-read-from-string - package--prepare-dependencies - (nconc deps) - (setq deps))))) + (unless (string-match-p ignored-files file) + (with-temp-buffer + (insert-file-contents file) + (when-let* ((require-lines (lm-header-multiline "package-requires"))) + (thread-last + (mapconcat #'identity require-lines " ") + package-read-from-string + package--prepare-dependencies + (nconc deps) + (setq deps)))))) (dolist (dep deps) (cl-callf version-to-list (cadr dep))) (setf missing (package-vc-install-dependencies (delete-dups deps))) @@ -529,8 +542,7 @@ package-vc--unpack-1 missing))) (let ((default-directory (file-name-as-directory pkg-dir)) - (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)) - (pkg-spec (package-vc--desc->spec pkg-desc))) + (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)) commit 35bb629eca9a60fb2cc9c7eaa953bf1b0dfc5860 Author: Philip Kaludercic Date: Tue Oct 3 09:55:12 2023 +0200 Rename 'vc-switch-backend' to 'vc-change-backend' * etc/NEWS: Mention the change * lisp/vc/vc.el (vc-switch-backend): Rename and unobsolete. (vc-transfer-file): Use new name. (bug#50344) diff --git a/etc/NEWS b/etc/NEWS index 12c2d52a4ab..8e05c668439 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -315,6 +315,10 @@ This is a string or a list of strings that specifies the Git log switches for shortlogs, such as the one produced by 'C-x v L'. 'vc-git-log-switches' is no longer used for shortlogs. +--- +*** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'. +The command was previously obsoleted and unbound in Emacs 28. + ** Diff Mode +++ diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b99424750e0..55d0376eab6 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3171,14 +3171,13 @@ vc-revert-file (vc-resynch-buffer file t t)) ;;;###autoload -(defun vc-switch-backend (file backend) +(defun vc-change-backend (file backend) "Make BACKEND the current version control system for FILE. FILE must already be registered in BACKEND. The change is not permanent, only for the current session. This function only changes VC's perspective on FILE, it does not register or unregister it. By default, this command cycles through the registered backends. To get a prompt, use a prefix argument." - (declare (obsolete nil "28.1")) (interactive (list (or buffer-file-name @@ -3209,6 +3208,9 @@ vc-switch-backend (error "%s is not registered in %s" file backend)) (vc-mode-line file))) +(define-obsolete-function-alias 'vc-switch-backend #'vc-change-backend + "30.1") + ;;;###autoload (defun vc-transfer-file (file new-backend) "Transfer FILE to another version control system NEW-BACKEND. @@ -3233,8 +3235,7 @@ vc-transfer-file (if registered (set-file-modes file (logior (file-modes file) 128)) ;; `registered' might have switched under us. - (with-suppressed-warnings ((obsolete vc-switch-backend)) - (vc-switch-backend file old-backend)) + (vc-change-backend file old-backend) (let* ((rev (vc-working-revision file)) (modified-file (and edited (make-temp-file file))) (unmodified-file (and modified-file (vc-version-backup-file file)))) @@ -3253,19 +3254,16 @@ vc-transfer-file (vc-revert-file file)))) (vc-call-backend new-backend 'receive-file file rev)) (when modified-file - (with-suppressed-warnings ((obsolete vc-switch-backend)) - (vc-switch-backend file new-backend)) + (vc-change-backend file new-backend) (unless (eq (vc-checkout-model new-backend (list file)) 'implicit) (vc-checkout file)) (rename-file modified-file file 'ok-if-already-exists) (vc-file-setprop file 'vc-checkout-time nil))))) (when move - (with-suppressed-warnings ((obsolete vc-switch-backend)) - (vc-switch-backend file old-backend)) + (vc-change-backend file old-backend) (setq comment (vc-call-backend old-backend 'comment-history file)) (vc-call-backend old-backend 'unregister file)) - (with-suppressed-warnings ((obsolete vc-switch-backend)) - (vc-switch-backend file new-backend)) + (vc-change-backend file new-backend) (when (or move edited) (vc-file-setprop file 'vc-state 'edited) (vc-mode-line file new-backend) commit 81a0c1ed2e437f94edaef0c9d3b5740d36f47181 Author: Eli Zaretskii Date: Sun Oct 8 11:29:29 2023 +0300 ; Improve documentation of VC commands * doc/emacs/maintaining.texi (Basic VC Editing) (VC With A Merging VCS, VC With A Locking VCS, Advanced C-x v v) (Registering, Pulling / Pushing, Merging): Improve wording, accuracy, and indexing. * lisp/vc/vc.el (vc-next-action): Doc fix. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 2dad70d3d13..c74a7ef8e3a 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -481,22 +481,23 @@ Basic VC Editing @cindex filesets, VC @cindex VC filesets Most VC commands operate on @dfn{VC filesets}. A VC fileset is a -collection of one or more files that a VC operation acts on. When you -type VC commands in a buffer visiting a version-controlled file, the -VC fileset is simply that one file. When you type them in a VC +collection of one or more files that a VC operation acts upon. When +you type VC commands in a buffer visiting a version-controlled file, +the VC fileset is simply that one file. When you type them in a VC Directory buffer, and some files in it are marked, the VC fileset consists of the marked files (@pxref{VC Directory Mode}). Likewise, when you invoke a VC command from a Dired buffer, the VC fileset consists of the marked files (@pxref{Marks vs Flags}), defaulting to the file shown on the current line if no files are marked. - On modern changeset-based version control systems (@pxref{VCS -Changesets}), VC commands handle multi-file VC filesets as a group. -For example, committing a multi-file VC fileset generates a single -revision, containing the changes to all those files. On older -file-based version control systems like CVS, each file in a multi-file -VC fileset is handled individually; for example, a commit generates -one revision for each changed file. + With modern changeset-based version control systems (@pxref{VCS +Changesets}), such as Git, Mercurial, and Bazaar, VC commands handle +multi-file VC filesets as a group. For example, committing a +multi-file VC fileset generates a single revision, containing the +changes to all those files. On older file-based version control +systems like CVS, each file in a multi-file VC fileset is handled +individually; thus, committing a fileset generates one revision for +each changed file in the fileset. @table @kbd @item C-x v v @@ -507,14 +508,16 @@ Basic VC Editing @findex vc-next-action @kindex C-x v v The principal VC command is a multi-purpose command, @kbd{C-x v v} -(@code{vc-next-action}), which performs the most appropriate -action on the current VC fileset: either registering it with a version -control system, or committing it, or unlocking it, or merging changes -into it. The precise actions are described in detail in the following -subsections. You can use @kbd{C-x v v} either in a file-visiting -buffer, in a Dired buffer, or in a VC Directory buffer; in the latter -two cases the command operates on the fileset consisting of the marked -files. +(@code{vc-next-action}), which performs the most appropriate action on +the current VC fileset: either registering it with a version control +system, or committing it, or unlocking it, or merging changes into it. +The precise actions for each situation are described in detail in the +following subsections. You can use @kbd{C-x v v} either in a +file-visiting buffer, in a Dired buffer, or in a VC Directory buffer; +in the latter two cases the command operates on the fileset consisting +of the marked files. You can also use @kbd{C-x v v}, in a buffer with +patches under Diff Mode (@pxref{Diff Mode}), in which case the command +operates on the files whose diffs are shown in the buffer. Note that VC filesets are distinct from the named filesets used for viewing and visiting files in functional groups @@ -522,7 +525,7 @@ Basic VC Editing and don't persist across sessions. @menu -* VC With A Merging VCS:: Without locking: default mode for CVS. +* VC With A Merging VCS:: Without locking: default mode for Git, Hg, SVN, CVS. * VC With A Locking VCS:: RCS in its default mode, SCCS, and optionally CVS. * Advanced C-x v v:: Advanced features available with a prefix argument. @end menu @@ -530,44 +533,56 @@ Basic VC Editing @node VC With A Merging VCS @subsubsection Basic Version Control with Merging - On a merging-based version control system (i.e., most modern ones; -@pxref{VCS Merging}), @kbd{C-x v v} does the following: + With a modern merging-based version control system (such as Git and Hg; +@pxref{VCS Merging}), @kbd{C-x v v} does the following when invoked +from a buffer that visits a version-controlled file or a VC Directory +or Dired buffer: @itemize @bullet @item If there is more than one file in the VC fileset and the files have inconsistent version control statuses, signal an error. (Note, -however, that a fileset is allowed to include both newly-added -files and modified files; @pxref{Registering}.) +however, that a fileset is allowed to include both newly-added files +and modified files; @pxref{Registering}.) Also signal an error if the +files in the fileset are missing (removed from the filesystem, but +still tracked by version control), or are ignored by version control. @item -If none of the files in the VC fileset are registered with a version -control system, register the VC fileset, i.e., place it under version -control. @xref{Registering}. If Emacs cannot find a system to -register under, it prompts for a repository type, creates a new -repository, and registers the VC fileset with it. - -@item -If every work file in the VC fileset is unchanged, do nothing. - -@item -If every work file in the VC fileset has been modified, commit the -changes. To do this, Emacs pops up a @file{*vc-log*} buffer; type the -desired log entry for the new revision, followed by @kbd{C-c C-c} to -commit. @xref{Log Buffer}. - -If committing to a shared repository, the commit may fail if the -repository has been changed since your last update. In that -case, you must perform an update before trying again. On a -decentralized version control system, use @kbd{C-x v +} -(@pxref{Pulling / Pushing}) or @kbd{C-x v m} (@pxref{Merging}). -On a centralized version control system, type @kbd{C-x v v} again to -merge in the repository changes. +If every file in the VC fileset is registered and unchanged with +respect to the last revision, do nothing. @item -Finally, if you are using a centralized version control system, check -if each work file in the VC fileset is up-to-date. If any file has -been changed in the repository, offer to update it. +If none of the files in the VC fileset are registered with a version +control system, register the newly-added files in the VC fileset, +i.e., place them under version control. @xref{Registering}. If Emacs +cannot find a system to register under, it prompts for a repository +type, creates a new repository, and registers the VC fileset with it. +You can also specify the system explicitly, see @ref{Advanced C-x v +v}. Note that registering the files doesn't commit them; you must +invoke @w{@kbd{C-x v v}} again to commit, see below. + +@item +If every file in the VC fileset has been either newly-added or +modified, commit the changed files. To do this, Emacs pops up a +@file{*vc-log*} buffer; type the desired log entry for the changes, +followed by @kbd{C-c C-c} to commit. @xref{Log Buffer}. + +With modern decentralized version control systems (Git, Mercurial, +etc.), the changes are committed locally and not automatically +propagated to the upstream repository (which is usually on a remote +host). In these cases, if the repository has been changed since your +last update, the commit may fail. In that case, you must update from +upstream and then try again. Use @kbd{C-x v +} (@pxref{Pulling / +Pushing}) or @kbd{C-x v m} (@pxref{Merging}) for that. + +With a centralized version control system, if the commit fails due to +upstream changes, type @kbd{C-x v v} again to merge in the upstream +repository changes. + +@item +Finally, if you are using a centralized version control system, if any +file in the VC fileset is outdated with respect to the upstream +repository, offer to update the fileset from the repository. @end itemize These rules also apply when you use RCS in its non-locking mode, @@ -581,43 +596,60 @@ VC With A Merging VCS @kbd{C-x v v} with an unmodified file locks the file, just as it does with RCS in its normal locking mode (@pxref{VC With A Locking VCS}). + If @kbd{C-x v v} is invoked from a buffer under Diff Mode, the +command assumes the buffer holds a set of patches for one or more +files. It then applies the changes to the respective files and +commits the changes after popping up the @file{*vc-log*} buffer to +allow you to type a suitable commit log message. + @node VC With A Locking VCS @subsubsection Basic Version Control with Locking - On a locking-based version control system (such as SCCS, and RCS in + With a locking-based version control system (such as SCCS, and RCS in its default mode), @kbd{C-x v v} does the following: @itemize @bullet @item If there is more than one file in the VC fileset and the files have -inconsistent version control statuses, signal an error. +inconsistent version control statuses, signal an error. Also signal +an error if the files in the fileset are missing (removed from the +filesystem, but still tracked by version control). @item If each file in the VC fileset is not registered with a version -control system, register the VC fileset. @xref{Registering}. If -Emacs cannot find a system to register under, it prompts for a -repository type, creates a new repository, and registers the VC -fileset with it. +control system, register the newly-added files in the fileset. +@xref{Registering}. If Emacs cannot find a system to register under, +it prompts for a repository type, creates a new repository, and +registers the VC fileset with it. You can also specify the system +explicitly, see @ref{Advanced C-x v v}. @item -If each file is registered and unlocked, lock it and make it writable, -so that you can begin to edit it. +If each file is registered and unlocked, check the files out: lock +each one and make it writable, so that you can begin to edit it. @item -If each file is locked by you and contains changes, commit the -changes. To do this, Emacs pops up a @file{*vc-log*} buffer; type the -desired log entry for the new revision, followed by @kbd{C-c C-c} to -commit (@pxref{Log Buffer}). +If each file is locked by you and contains changes, commit (a.k.a.@: +``check-in'') the changes. To do this, Emacs pops up a +@file{*vc-log*} buffer; type the desired log entry for the new +revision, followed by @kbd{C-c C-c} to commit (@pxref{Log Buffer}). @item If each file is locked by you, but you have not changed it, release -the lock and make the file read-only again. +the lock and make the file read-only again. This undoes previous +check-out operation for files that were not changed since the +checkout. @item If each file is locked by another user, ask whether you want to steal the lock. If you say yes, the file becomes locked by you, and a warning message is sent to the user who had formerly locked the file. + +@item +If files in the fileset are unlocked, but have changes with respect to +their last revision, offer to claim the lock for each such file or to +revert the file to the last checked-in revision. (This situation is +exceptional and should not normally happen.) @end itemize These rules also apply when you use CVS in locking mode, except @@ -642,19 +674,21 @@ Advanced C-x v v @item Otherwise, if using CVS, RCS or SRC, you can specify a revision ID. -If the fileset is modified (or locked), this makes Emacs commit with -that revision ID@. You can create a new branch by supplying an -appropriate revision ID (@pxref{Branches}). - -If the fileset is unmodified (and unlocked), this checks the specified -revision into the working tree. You can also specify a revision on -another branch by giving its revision or branch ID (@pxref{Switching -Branches}). An empty argument (i.e., @kbd{C-u C-x v v @key{RET}}) -checks out the latest (head) revision on the current branch. - -This is silently ignored on a decentralized version control system. -Those systems do not let you specify your own revision IDs, nor do -they use the concept of checking out individual files. +If the fileset is modified (or locked), this makes Emacs commit the +files with that revision ID@. You can create a new branch by +supplying an appropriate revision ID (@pxref{Branches}). + +If the fileset is unmodified (and unlocked), this checks out the +specified revision into the working tree. You can also specify a +revision on another branch by giving its revision or branch ID +(@pxref{Switching Branches}). An empty argument (i.e., @kbd{C-u C-x v +v @key{RET}}) checks out the latest (a.k.a.@: ``head'') revision on +the current branch. + +Specifying revision ID in this manner is silently ignored by a +decentralized version control system. Those systems do not let you +specify your own revision IDs, nor do they use the concept of checking +out individual files. @end itemize @node Log Buffer @@ -788,17 +822,21 @@ Registering under, it prompts for a repository type, creates a new repository, and registers the file into that repository. - On most version control systems, registering a file with @kbd{C-x v -i} or @kbd{C-x v v} adds it to the working tree but not to the -repository. Such files are labeled as @samp{added} in the VC -Directory buffer, and show a revision ID of @samp{@@@@} in the mode -line. To make the registration take effect in the repository, you -must perform a commit (@pxref{Basic VC Editing}). Note that a single -commit can include both file additions and edits to existing files. - - On a locking-based version control system (@pxref{VCS Merging}), +@cindex added files, VC +@cindex files added to VCS + With most version control systems, registering a file with +@w{@kbd{C-x v i}} or @w{@kbd{C-x v v}} adds it to the working tree, +but does not commit it, i.e., doesn't add it to the repository. Such +files are labeled as @dfn{added} in the VC Directory buffer, and the +mode line of the buffers visiting such files shows a revision ID of +@samp{@@@@}. To make the registration take effect in the repository, +you must commit the newly-added files (@pxref{Basic VC Editing}). +Note that a single commit can include both file additions and edits to +files already known to the VCS. + + With a locking-based version control system (@pxref{VCS Merging}), registering a file leaves it unlocked and read-only. Type @kbd{C-x v -v} to start editing it. +v} to check-out the file and start editing it. @node Old Revisions @subsection Examining And Comparing Old Revisions @@ -1563,32 +1601,39 @@ Pulling / Pushing @subsubsection Pulling/Pushing Changes into/from a Branch @table @kbd +@cindex push changes to upstream (VC) @item C-x v P -On a decentralized version control system, update another location -with changes from the current branch (a.k.a. ``push'' changes). This -concept does not exist for centralized version control systems +With a decentralized version control system, update another repository +with locally-committed changes from the current branch (a.k.a.@: +@dfn{push} changes). This concept does not exist for centralized +version control systems +@cindex pull changes from upstream (VC) @item C-x v + -On a decentralized version control system, update the current branch -by ``pulling in'' changes from another location. +With a decentralized version control system, update the current branch +of the local repository by @dfn{pulling in} changes from another +repository. -On a centralized version control system, update the current VC -fileset. +With a centralized version control system, update the current VC +fileset from the repository. @end table @kindex C-x v P @findex vc-push +@cindex upstream repository On a decentralized version control system, the command @kbd{C-x v P} -(@code{vc-push}) updates another location with changes from the +(@code{vc-push}) updates another location, commonly known as the +@dfn{upstream repository}, with locally-committed changes from the current branch. With a prefix argument, it prompts for the exact version control command to run, which lets you specify where to push -changes; the default is @kbd{bzr push} with Bazaar, @kbd{git -push} with Git, and @kbd{hg push} with Mercurial. The default -commands always push to a default location determined by the version -control system from your branch configuration. +changes; the default is @kbd{bzr push} with Bazaar, @kbd{git push} +with Git, and @kbd{hg push} with Mercurial. The default commands +always push to the repository in the default location determined by +the version control system from your branch configuration. Prior to pushing, you can use @kbd{C-x v O} (@code{vc-log-outgoing}) -to view a log buffer of the changes to be sent. @xref{VC Change Log}. +to view a log buffer of the changes to be sent upstream. @xref{VC +Change Log}. @cindex bound branch (Bazaar VCS) This command is currently supported only by Bazaar, Git, and Mercurial. @@ -1602,13 +1647,15 @@ Pulling / Pushing @kindex C-x v + @findex vc-pull - On a decentralized version control system, the command @kbd{C-x v +} -(@code{vc-pull}) updates the current branch and working tree. It is -typically used to update a copy of a remote branch. If you supply a -prefix argument, the command prompts for the exact version control -command to use, which lets you specify where to pull changes from. -Otherwise, it pulls from a default location determined by the version -control system. + With a decentralized version control system, the command @kbd{C-x v ++} (@code{vc-pull}) updates the current branch of the local repository +and it working tree with changes made in the upstream repository. It +is typically used to update a copy (a.k.a.@: @dfn{clone}) of a remote +branch. If you supply a prefix argument, the command prompts for the +exact version control command to use, which lets you specify where to +pull changes from. Otherwise, it pulls from the repository in the +default location determined by the version control system from your +branch configuration. Amongst decentralized version control systems, @kbd{C-x v +} is currently supported only by Bazaar, Git, and Mercurial. With Bazaar, @@ -1624,7 +1671,7 @@ Pulling / Pushing to view a log buffer of the changes to be applied. @xref{VC Change Log}. - On a centralized version control system like CVS, @kbd{C-x v +} + With a centralized version control system like CVS, @kbd{C-x v +} updates the current VC fileset from the repository. @node Merging @@ -1633,36 +1680,36 @@ Merging @table @kbd @item C-x v m -On a decentralized version control system, merge changes from another +With a decentralized version control system, merge changes from another branch into the current one. -On a centralized version control system, merge changes from another +With a centralized version control system, merge changes from another branch into the current VC fileset. @end table While developing a branch, you may sometimes need to @dfn{merge} in changes that have already been made in another branch. This is not a -trivial operation, as overlapping changes may have been made to the -two branches. - - On a decentralized version control system, merging is done with the -command @kbd{C-x v m} (@code{vc-merge}). On Bazaar, this prompts for -the exact arguments to pass to @kbd{bzr merge}, offering a -sensible default if possible. On Git, this prompts for the name of a -branch to merge from, with completion (based on the branch names known -to the current repository). With Mercurial, this prompts for argument -to pass to @kbd{hg merge}. The output from running the merge -command is shown in a separate buffer. - - On a centralized version control system like CVS, @kbd{C-x v m} +trivial operation, as overlapping and conflicting changes may have +been made to the two branches. + + With a decentralized version control system, you merge changes with +the command @kbd{C-x v m} (@code{vc-merge}). With Bazaar, this +prompts for the exact arguments to pass to the @command{bzr merge} +command, offering a sensible default if possible. With Git, this +prompts for the name of a branch to merge from, with completion (based +on the branch names known to the current repository). With Mercurial, +this prompts for argument to pass to @command{hg merge}. The output +from running the merge command is shown in a separate buffer. + + With a centralized version control system like CVS, @kbd{C-x v m} prompts for a branch ID, or a pair of revision IDs (@pxref{Switching Branches}); then it finds the changes from that branch, or the changes between the two revisions you specified, and merges those changes into -the current VC fileset. If you just type @kbd{@key{RET}}, Emacs simply -merges any changes that were made on the same branch since you checked -the file out. +the current VC fileset. If you just type @kbd{@key{RET}} at the +prompt, Emacs simply merges any changes that were made on the same +branch since you checked the file out. -@cindex conflicts +@cindex conflicts, VC @cindex resolving conflicts Immediately after performing a merge, only the working tree is modified, and you can review the changes produced by the merge with @@ -1671,9 +1718,12 @@ Merging @dfn{conflict}; a warning appears in the output of the merge command, and @dfn{conflict markers} are inserted into each affected work file, surrounding the two sets of conflicting changes. You must then -resolve the conflict by editing the conflicted files. Once you are -done, the modified files must be committed in the usual way for the -merge to take effect (@pxref{Basic VC Editing}). +resolve the conflict by editing the conflicted files; by default, +Emacs will place buffers with VC conflicts in the special Smerge mode, +which provides special commands for resolving the merge conflicts. +Once you are done with resolving the conflicts and have saved the +files with resolved conflicts, those files must be committed in the +usual way for the merge to take effect (@pxref{Basic VC Editing}). @node Creating Branches @subsubsection Creating New Branches diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 51d0d20ae3e..1dadceda8c4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1222,18 +1222,23 @@ vc-read-backend (defun vc-next-action (verbose) "Do the next logical version control operation on the current fileset. This requires that all files in the current VC fileset be in the -same state. If not, signal an error. - -For merging-based version control systems: - If every file in the VC fileset is not registered for version - control, register the fileset (but don't commit). - If every work file in the VC fileset is added or changed, pop - up a *vc-log* buffer to commit the fileset. +same state. If they are not, signal an error. Also signal an error if +files in the fileset are missing (removed, but tracked by version control), +or are ignored by the version control system. + +For modern merging-based version control systems: + If every file in the fileset is not registered for version + control, register the fileset (but don't commit). If VERBOSE is + non-nil (interactively, the prefix argument), ask for the VC + backend with which to register the fileset. + If every work file in the VC fileset is either added or modified, + pop up a *vc-log* buffer to commit the fileset changes. For a centralized version control system, if any work file in the VC fileset is out of date, offer to update the fileset. For old-style locking-based version control systems, like RCS: - If every file is not registered, register the file(s). + If every file is not registered, register the file(s); with a prefix + argument, allow to specify the VC backend for registration. If every file is registered and unlocked, check out (lock) the file(s) for editing. If every file is locked by you and has changes, pop up a @@ -1241,14 +1246,21 @@ vc-next-action read-only copy of each changed file after checking in. If every file is locked by you and unchanged, unlock them. If every file is locked by someone else, offer to steal the lock. + If files are unlocked, but have changes, offer to either claim the + lock or revert to the last checked-in version. + +If this command is invoked from a patch buffer under `diff-mode', it +will apply the diffs from the patch and pop up a *vc-log* buffer to +check-in the resulting changes. When using this command to register a new file (or files), it will automatically deduce which VC repository to register it with, using the most specific one. If VERBOSE is non-nil (interactively, the prefix argument), -you can specify a VC backend or (for centralized VCS only) -the revision ID or branch ID." +you can specify another VC backend for the file(s), +or (for centralized VCS only) the revision ID or branch ID +from which to check out the file(s)." (interactive "P") (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files)) (backend (car vc-fileset)) commit 940df63d2daf50b899a66cd1542bec0c0f3eaebf Author: Po Lu Date: Sun Oct 8 10:42:47 2023 +0800 Port arc to Android * lisp/arc-mode.el (archive-zip-extract): Default to -q and -p when the Android system unzip is being employed. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 81d3dfc3432..c861c835966 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -231,13 +231,27 @@ archive-zip :group 'archive) (defcustom archive-zip-extract - (cond ((executable-find "unzip") '("unzip" "-qq" "-c")) + (cond ((executable-find "unzip") + (if (and (eq system-type 'android) + ;; Mind that the unzip provided by Android + ;; does not understand -qq or -c, their + ;; functions being assumed by -q and -p + ;; respectively. Furthermore, the user + ;; might install an unzip executable + ;; distinct from the system-provided unzip, + ;; and such situations must be detected as + ;; well. + (member (executable-find "unzip") + '("/bin/unzip" + "/system/bin/unzip"))) + '("unzip" "-q" "-p") + '("unzip" "-qq" "-c"))) (archive-7z-program `(,archive-7z-program "x" "-so")) ((executable-find "pkunzip") '("pkunzip" "-e" "-o-")) (t '("unzip" "-qq" "-c"))) "Program and its options to run in order to extract a zip file member. -Extraction should happen to standard output. Archive and member name will -be added." +Extraction should happen to standard output. Archive and member +name will be added." :type '(list (string :tag "Program") (repeat :tag "Options" :inline t commit a01203ce3374d6ce2ac8ea2992bff693ad73c0c2 Author: Po Lu Date: Sun Oct 8 09:13:11 2023 +0800 Introduce a tool bar for dictionary mode * lisp/doc-view.el (doc-view-minor-mode-menu): Correct typo in edit mode menu. * lisp/net/dictionary.el (dictionary-mode-menu): New menu. (dictionary-tool-bar-map): New variable; derive menu bar entries from the dictionary-mode-menu. (dictionary-mode): Set the tool bar map to dictionary-tool-bar-map. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 210b7ace7d6..fb51661caac 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -661,7 +661,9 @@ doc-view-minor-mode-menu '("DocView (edit)" ("Toggle edit/display" ["Edit document" (lambda ()) ; ignore but show no keybinding - :style radio :selected (eq major-mode 'doc-view--text-view-mode)] + ;; This is always selected since its menu is singular to the + ;; display minor mode. + :style radio :selected t] ["Display document" doc-view-toggle-display :style radio :selected (eq major-mode 'doc-view-mode)]) ["Exit DocView Mode" doc-view-minor-mode])) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index ca706c3c6e9..d1f92334ee2 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -309,12 +309,12 @@ dictionary-search-interface :version "30.1") (defface dictionary-word-definition-face -'((((supports (:family "DejaVu Serif"))) - (:family "DejaVu Serif")) - (((type x)) - (:font "Sans Serif")) - (t - (:font "default"))) + '((((supports (:family "DejaVu Serif"))) + (:family "DejaVu Serif")) + (((type x)) + (:font "Sans Serif")) + (t + (:font "default"))) "The face that is used for displaying the definition of the word." :group 'dictionary :version "28.1") @@ -405,6 +405,22 @@ dictionary-mode-map "M-SPC" #'scroll-down-command "DEL" #'scroll-down-command) +(easy-menu-define dictionary-mode-menu dictionary-mode-map + "Menu for the Dictionary mode." + '("Dictionary" + ["Search Definition" dictionary-search + :help "Look up a new word"] + ["List Matching Words" dictionary-match-words + :help "List all words matching a pattern"] + ["Lookup Word At Point" dictionary-lookup-definition + :help "Look up the word at point"] + ["Select Dictionary" dictionary-select-dictionary + :help "Select one or more dictionaries to search within"] + ["Select Match Strategy" dictionary-select-strategy + :help "Select the algorithm to match queries and entries with"] + ["Back" dictionary-previous + :help "Return to the previous match or location"])) + (defvar dictionary-connection nil "The current network connection.") @@ -423,6 +439,30 @@ dictionary--last-match ;; Basic function providing startup actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar dictionary-tool-bar-map + (let ((map (make-sparse-keymap))) + ;; Most of these items are the same as in the default tool bar + ;; map, but with extraneous items removed, and with extra search + ;; and navigation items. + (tool-bar-local-item-from-menu 'find-file "new" map + nil :label "New File" + :vert-only t) + (tool-bar-local-item-from-menu 'menu-find-file-existing "open" map + nil :label "Open" :vert-only t) + (tool-bar-local-item-from-menu 'dired "diropen" map nil :vert-only t) + (tool-bar-local-item-from-menu 'kill-this-buffer "close" map nil + :vert-only t) + (define-key-after map [separator-1] menu-bar-separator) + (tool-bar-local-item-from-menu 'dictionary-search "search" + map dictionary-mode-map :vert-only t + :help "Start a new search query.") + (tool-bar-local-item-from-menu 'dictionary-previous "left-arrow" + map dictionary-mode-map + :vert-only t + :help "Go backwards in history.") + map) + "Like the default `tool-bar-map', but with additions for Dictionary mode") + ;;;###autoload (define-derived-mode dictionary-mode special-mode "Dictionary" "Mode for searching a dictionary. @@ -452,6 +492,8 @@ dictionary-mode (make-local-variable 'dictionary-positions) (make-local-variable 'dictionary-default-dictionary) (make-local-variable 'dictionary-default-strategy) + ;; Replace the tool bar map with `dictionary-tool-bar-map'. + (setq-local tool-bar-map dictionary-tool-bar-map) (add-hook 'kill-buffer-hook #'dictionary-close t t)) ;;;###autoload commit 0590e3e69a9431b7ec024a61882f912c6083eb0c Author: Stefan Kangas Date: Sat Oct 7 18:29:07 2023 +0200 Recommend `M-x man` in woman.el docs * lisp/woman.el (Commentary, woman): Recommend using 'M-x man' where available. The added sentence is copied from the emacs manual. Ref: https://lists.gnu.org/r/emacs-devel/2023-10/msg00090.html diff --git a/lisp/woman.el b/lisp/woman.el index 92cd425d32f..2a71b8c1119 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -34,6 +34,10 @@ ;; the emulation is modified to include the reformatting done by the ;; Emacs `man' command. No hyphenation is performed. +;; Note that `M-x woman' doesn’t yet support the latest features of +;; modern man pages, so we recommend using `M-x man' if that is +;; available on your system. + ;; Advantages ;; Much more direct, does not require any external programs. @@ -1149,7 +1153,11 @@ woman updated (e.g. to re-interpret the current directory). Used non-interactively, arguments are optional: if given then TOPIC -should be a topic string and non-nil RE-CACHE forces re-caching." +should be a topic string and non-nil RE-CACHE forces re-caching. + +Note that `M-x woman' doesn’t yet support the latest features of +modern man pages, so we recommend using `M-x man' if that is +available on your system." (interactive (list nil current-prefix-arg)) ;; The following test is for non-interactive calls via emacsclient, etc. (if (or (not (stringp topic)) (string-match-p "\\S " topic)) commit 809da7fc9a1ca112ae7179112a5cec8dd557510e Author: Eli Zaretskii Date: Sat Oct 7 19:09:58 2023 +0300 ; * doc/lispref/processes.texi (Process Buffers): More accurate wording. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 43c794104b8..e1398749005 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1641,8 +1641,10 @@ Process Buffers @defun set-process-buffer process buffer This function sets the buffer associated with @var{process} to @var{buffer}. If @var{buffer} is @code{nil}, the process becomes -associated with no buffer; if non-@code{nil}, the process mark will be -set to point to the end of @var{buffer}. +associated with no buffer; if non-@code{nil} and different from the +buffer associated with the process, the process mark will be set to +point to the end of @var{buffer} (unless the process mark is already +associated with @var{buffer}). @end defun @defun get-buffer-process buffer-or-name commit 8f23a02a9ea1fbc4213cae5664dcb9bf6b5205f6 Author: Eli Zaretskii Date: Sat Oct 7 17:58:54 2023 +0300 Fix updating process-mark position in 'set-process-buffer' * src/process.c (update_process_mark): Update marker position only if P's process-mark is not already associated with P's buffer. (Bug#66313) diff --git a/src/process.c b/src/process.c index 5f7408a9395..46e57c1a7c2 100644 --- a/src/process.c +++ b/src/process.c @@ -1273,7 +1273,8 @@ DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 2, 0, update_process_mark (struct Lisp_Process *p) { Lisp_Object buffer = p->buffer; - if (BUFFERP (buffer)) + if (BUFFERP (buffer) + && XMARKER (p->mark)->buffer != XBUFFER (buffer)) set_marker_both (p->mark, buffer, BUF_ZV (XBUFFER (buffer)), BUF_ZV_BYTE (XBUFFER (buffer))); commit b583cb81c90ee452c754777e33571dbd23f159ff Author: Gerd Möllmann Date: Sat Oct 7 14:57:52 2023 +0200 ; Produce fewer $nnn vars in LLDB diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index 609815613bf..f92a7e03a41 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -122,19 +122,21 @@ def init_values(self): if self.lisp_type == "Lisp_Symbol": offset = self.get_lisp_pointer("char").GetValueAsUnsigned() self.value = self.eval(f"(struct Lisp_Symbol *)" - f" ((char *) &lispsym + {offset})") + f" ((char *) &lispsym + {offset})", + True) elif self.lisp_type == "Lisp_String": - self.value = self.get_lisp_pointer("struct Lisp_String") + self.value = self.get_lisp_pointer("struct Lisp_String", True) elif self.lisp_type == "Lisp_Vectorlike": c_type = Lisp_Object.pvec2type[self.pvec_type] - self.value = self.get_lisp_pointer(c_type) + self.value = self.get_lisp_pointer(c_type, True) elif self.lisp_type == "Lisp_Cons": - self.value = self.get_lisp_pointer("struct Lisp_Cons") + self.value = self.get_lisp_pointer("struct Lisp_Cons", True) elif self.lisp_type == "Lisp_Float": - self.value = self.get_lisp_pointer("struct Lisp_Float") + self.value = self.get_lisp_pointer("struct Lisp_Float", True) elif self.lisp_type in ("Lisp_Int0", "Lisp_Int1"): self.value = self.eval(f"((EMACS_INT) {self.unsigned}) " - f">> (GCTYPEBITS - 1)") + f">> (GCTYPEBITS - 1)", + True) else: assert False, "Unknown Lisp type" @@ -143,14 +145,19 @@ def create_value(self, name, expr): return self.lisp_obj.CreateValueFromExpression(name, expr) # Evaluate EXPR in the context of the current frame. - def eval(self, expr): - return self.frame.EvaluateExpression(expr) + def eval(self, expr, make_var=False): + if make_var: + return self.frame.EvaluateExpression(expr) + options = lldb.SBExpressionOptions() + options.SetSuppressPersistentResult(True) + return self.frame.EvaluateExpression(expr, options) # Return an SBValue for this object denoting a pointer of type # TYP*. - def get_lisp_pointer(self, typ): + def get_lisp_pointer(self, typ, make_var=False): return self.eval(f"({typ}*) (((EMACS_INT) " - f"{self.unsigned}) & VALMASK)") + f"{self.unsigned}) & VALMASK)", + make_var) # If this is a Lisp_String, return an SBValue for its string data. # Return None otherwise. commit 247743bd1e99821e111a838ca5070c5ba057ac1c Author: Yuan Fu Date: Tue Sep 26 23:15:14 2023 -0700 ; * lisp/treesit.el (treesit-language-at-point-function): Fix doc. (cherry picked from commit 07ede5e92a58ac3739a0e5b0c9025bee2f75c5ba) (Bug#66183) diff --git a/lisp/treesit.el b/lisp/treesit.el index c24ea90bba0..98eac7f6d63 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -132,7 +132,14 @@ treesit-language-at-point-function This is used by `treesit-language-at', which is used by various functions to determine which parser to use at point. -The function is called with one argument, the position of point.") +The function is called with one argument, the position of point. + +In general, this function should call `treesit-node-at' with an +explicit language (usually the host language), and determine the +language at point using the type of the returned node. + +DO NOT derive the language at point from parser ranges. It's +cumbersome and can't deal with some edge cases.") (defun treesit-language-at (position) "Return the language at POSITION. commit 5384619921783bc6d411ea88976ea55b1198ed91 Merge: 2132d8d8dd6 a74e51cfd15 Author: Eli Zaretskii Date: Sat Oct 7 03:48:00 2023 -0400 Merge from origin/emacs-29 a74e51cfd15 Fix a defcustom :type c27b90d04bf Fix 'ido--ffap-find-file' 1594d5f17ad Fix setting the pipe capacity for subprocesses aad8b5d78f3 Handle LANG on macOS differently (bug#65908) # Conflicts: # src/process.c commit 2132d8d8dd61424af33f5b7d7543d8d30120aec3 Merge: 1c9ddf39481 6cf7e676e9d Author: Eli Zaretskii Date: Sat Oct 7 03:46:50 2023 -0400 ; Merge from origin/emacs-29 The following commit was skipped: 6cf7e676e9d Silence macro expansion during completion at point commit 1c9ddf39481694b67f02da96660d15f6468186fc Merge: 96980586532 e9b88f61ccc Author: Eli Zaretskii Date: Sat Oct 7 03:46:48 2023 -0400 Merge from origin/emacs-29 e9b88f61ccc Fix a defcustom :type 3216cd96952 Fix pulse-flag :type 2065ab5562e Fix defcustoms in timeclock.el bdd30132496 ; * lisp/image-mode.el (image-mode-to-text, image-mode-as... 5c2d9ae48ed ; * lisp/image-mode.el: Fix typos in doc strings (bug#663... fa0d3f45aeb ; Improve wording of last change 3ef259e28a8 Improve documentation of `ns-use-proxy-icon` 712505a82b9 Document assigning libraries to packages in make-tarball.txt 6bdc5cfe384 Doc fix; more consistently refer to "text terminals" d210d761b19 ; Fix doc strings of overlay-arrow variables 4fd00ff1f7e Fix defcustoms in type-break.el (Bug#66210) 47770b0eca4 Fix term-scroll-to-bottom-on-output :type f8bdc8dff0b ; Normalize GNU ELPA :core package statements 63ec6d998d4 ; * doc/emacs/custom.texi (Early Init File): Improve inde... a4185f87bd0 ; Silence macOS 14 warning d9d6e14a698 ; * lisp/vc/vc.el (vc-next-action): Improve commentary. d558f38fe5c ; * lisp/emacs-lisp/let-alist.el (let-alist): Fix quoting... 71feee79309 Doc fix in let-alist for keys with nil value 72cc9cf2cde ; Fix typos commit 9698058653272129203a649efdc683c5816fe286 Merge: 28b31480768 356e79e47fc Author: Eli Zaretskii Date: Sat Oct 7 03:46:47 2023 -0400 ; Merge from origin/emacs-29 The following commits were skipped: 356e79e47fc Fix tramp-test.el (don't merge with master) 34550ea8ce4 Improve Emacs 30 compatibility in tramp-tests.el (don't m... commit a74e51cfd1518507220de2ba317bb862409541cf Author: Mauro Aranda Date: Fri Oct 6 17:02:37 2023 -0300 Fix a defcustom :type * lisp/cedet/srecode/map.el (srecode-map-save-file): Expand :type to allow nil. (Bug#66377) diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index 125459d6eeb..004bb7adddb 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -49,7 +49,8 @@ srecode-map-save-file "The save location for SRecode's map file. If the save file is nil, then the MAP is not saved between sessions." :group 'srecode - :type 'file) + :type '(choice (const :tag "Don't save" nil) + file)) (defclass srecode-map (eieio-persistent) ((fileheaderline :initform ";; SRECODE TEMPLATE MAP") commit c27b90d04bfef5e39558dc84946ad3e57a9ee480 Author: Eli Zaretskii Date: Sat Oct 7 09:46:04 2023 +0300 Fix 'ido--ffap-find-file' * lisp/ido.el (ido--ffap-find-file): Make the signature consistent with that of 'find-file', and pass the optional second argument to 'find-file'. (Bug#66382) diff --git a/lisp/ido.el b/lisp/ido.el index f42d93837c1..0fb504e8ac7 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1508,8 +1508,8 @@ ido-common-initialization (add-hook 'minibuffer-setup-hook #'ido-minibuffer-setup) (add-hook 'choose-completion-string-functions #'ido-choose-completion-string)) -(defun ido--ffap-find-file (file) - (find-file file)) +(defun ido--ffap-find-file (file &optional wildcard) + (find-file file wildcard)) (define-minor-mode ido-everywhere "Toggle use of Ido for all buffer/file reading." commit 28b31480768143f9696746d30da151531706f94c Author: Po Lu Date: Sat Oct 7 09:25:23 2023 +0800 Revise font family translation lists under Android * doc/emacs/android.texi (Android Environment): Revise paragraph illustrating the startup notification. (Android Fonts): Mention font family replacement. * src/sfntfont-android.c (init_sfntfont_android): Translate DejaVu Serif to either Droid Serif or Noto Serif. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 5e018c3e4c5..bfa58b6cacc 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -333,7 +333,7 @@ Android Environment From the perspective of users, Android is mostly a single user operating system; however, from the perspective of applications and -Emacs, the system has an overwhelming number of users. +Emacs, the system is host to an overwhelming number of users. Each application runs in its own user, with its home directory set to its app data directory (@pxref{Android File @@ -360,12 +360,12 @@ Android Environment @xref{Subprocess Creation,,, elisp, the Emacs Lisp Reference Manual}. The @file{/assets} directory containing Emacs start-up files is -supposed to be inaccessible to processes not directly created by +meant to be inaccessible to processes not directly created by @code{zygote}, the system service responsible for starting applications. Since required Lisp is found in the @file{/assets} directory, it would thus follow that it is not possible for Emacs to start itself as a subprocess. A special binary named -@command{libandroid-emacs.so} is provided with Emacs, and does its +@command{libandroid-emacs.so} is provided with Emacs, which tries its best to start Emacs for the purpose of running Lisp in batch mode. However, the approach it takes was devised by reading Android source code, and is not sanctioned by the Android compatibility definition @@ -419,25 +419,31 @@ Android Environment terminated by the system at any time, for the purpose of saving system resources. - On Android 7.1 and earlier, Emacs tells the system to treat it as a -``background service''. The system will try to avoid killing Emacs -unless the system is stressed for memory. + On Android 7.1 and earlier, Emacs designates itself a ``background +service'', which impels the system to avoid killing Emacs unless it is +stressed for memory. Android 8.0 removed the ability for background services to receive such special treatment. However, Emacs applies a workaround: the system considers applications that create a permanent notification to be performing active work, and will avoid killing such applications. Thus, on those systems, Emacs displays a permanent notification for as -long as it is running. Once the notification is displayed, it can be -safely hidden through the system settings without resulting in Emacs -being killed. - - However, it is not guaranteed that the system will not kill Emacs -even if a notification is being displayed. While the Open Handset -Alliance's sample implementation of Android behaves correctly, many -manufacturers place additional restrictions on program execution in -the background in their proprietary versions of Android. There is a -list of such troublesome manufacturers and sometimes workarounds at +long as it is running. + + Before Android 13, Emacs does not require rights to display +notifications. Under Android 13 or later, the notification is hidden +until the user accords Emacs such rights. In spite of that, merely +attempting to display the notification suffices to avert sudden death; +whether the notification is displayed has no bearing on Emacs's +capacity to execute in the background, and it may be disabled without +any adverse consequences. + + However, it is not guaranteed that the system will not kill Emacs. +Although the Open Handset Alliance's sample implementation of Android +behaves correctly, many manufacturers institute additional +restrictions on program execution in the background in their +proprietary versions of Android. There is a list of such troublesome +manufacturers and sometimes workarounds at @url{https://dontkillmyapp.com/}. @cindex permissions under android @@ -747,6 +753,22 @@ Android Fonts distortable fonts with the same family will no longer be used to provide that style. +@cindex default font families, Android +@vindex sfnt-default-family-alist + + Emacs generally assumes the presence of font families named +@samp{Monospace}, @samp{Monospace Serif}, @samp{Sans Serif}, and +@samp{DejaVu Serif}. Since Android does not provide any fonts by +these names, Emacs modifies requests for them to request one of a +corresponding set of font families distributed with Android. + + To change either the set of font families subject to replacement, or +that by which they are replaced, modify the variable +@code{sfnt-default-family-alist}; then, restart Emacs. Bear in mind +that this is usually unwarranted, with customizations to the default +or @code{variable-pitch} faces better made through modifying their +definitions (@xref{Face Customization}). + @node Android Troubleshooting @section Troubleshooting Startup Problems on Android @cindex troubleshooting, android diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c index 53589078cda..be75c2d9e22 100644 --- a/src/sfntfont-android.c +++ b/src/sfntfont-android.c @@ -749,26 +749,31 @@ init_sfntfont_android (void) if (!android_init_gui) return; - /* Make sure to pick the right Sans Serif font depending on what + /* Make sure to pick the proper Sans Serif and Serif fonts for the version of Android the device is running. */ + if (android_get_current_api_level () >= 15) Vsfnt_default_family_alist - = list3 (Fcons (build_string ("Monospace"), + = list4 (Fcons (build_string ("Monospace"), build_string ("Droid Sans Mono")), /* Android doesn't come with a Monospace Serif font, so this will have to do. */ Fcons (build_string ("Monospace Serif"), build_string ("Droid Sans Mono")), Fcons (build_string ("Sans Serif"), - build_string ("Roboto"))); + build_string ("Roboto")), + Fcons (build_string ("DejaVu Serif"), + build_string ("Noto Serif"))); else Vsfnt_default_family_alist - = list3 (Fcons (build_string ("Monospace"), + = list4 (Fcons (build_string ("Monospace"), build_string ("Droid Sans Mono")), Fcons (build_string ("Monospace Serif"), build_string ("Droid Sans Mono")), Fcons (build_string ("Sans Serif"), - build_string ("Droid Sans"))); + build_string ("Droid Sans")), + Fcons (build_string ("DejaVu Serif"), + build_string ("Droid Serif"))); /* Set up the user fonts directory. This directory is ``fonts'' in the Emacs files directory. */ commit 8dbc74084b708c7dffbf0a982779ae4b1e54c2c6 Author: Gerd Möllmann Date: Fri Oct 6 16:52:19 2023 +0200 ; Configure ObjC for clang-format diff --git a/.clang-format b/.clang-format index 5c987536b0c..7929a7435f2 100644 --- a/.clang-format +++ b/.clang-format @@ -1,4 +1,3 @@ -Language: Cpp BasedOnStyle: GNU AlignEscapedNewlinesLeft: true AlignOperands: Align @@ -35,6 +34,10 @@ PenaltyBreakBeforeFirstCallParameter: 2000 SpaceAfterCStyleCast: true SpaceBeforeParens: Always UseTab: Always +--- +Language: Cpp +--- +Language: ObjC # Local Variables: # mode: yaml commit 1594d5f17ad9845be526381e6cd62313da41590a Author: Eli Zaretskii Date: Fri Oct 6 08:31:59 2023 +0300 Fix setting the pipe capacity for subprocesses * src/process.c (create_process) [F_SETPIPE_SZ]: Set the pipe capacity only if the required read-process-max is larger than the default capacity of the pipe. (Bug#66288) diff --git a/src/process.c b/src/process.c index 67d1d3e425f..5f7408a9395 100644 --- a/src/process.c +++ b/src/process.c @@ -2189,8 +2189,14 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) inchannel = p->open_fd[READ_FROM_SUBPROCESS]; forkout = p->open_fd[SUBPROCESS_STDOUT]; -#if defined(GNU_LINUX) && defined(F_SETPIPE_SZ) - fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max); +#if defined(F_SETPIPE_SZ) && defined(F_GETPIPE_SZ) + /* If they requested larger reads than the default system pipe + capacity, try enlarging the capacity to match the request. */ + if (read_process_output_max > fcntl (inchannel, F_GETPIPE_SZ)) + { + int readmax = clip_to_bounds (1, read_process_output_max, INT_MAX); + fcntl (inchannel, F_SETPIPE_SZ, readmax); + } #endif } commit 505c80623049d9e181918acdac8229c9a2041b1e Author: Stefan Kangas Date: Fri Oct 6 01:54:12 2023 +0200 Revert slurp_image extraction for svg_load * src/image.c (svg_load): Inline slurp_image code again, as it didn't build in its current form. Reported by Andreas Schwab . diff --git a/src/image.c b/src/image.c index fcae13e2302..9a465f0b180 100644 --- a/src/image.c +++ b/src/image.c @@ -11684,11 +11684,22 @@ svg_load (struct frame *f, struct image *img) base_uri = image_spec_value (img->spec, QCbase_uri, NULL); if (STRINGP (file_name)) { + image_fd fd; + Lisp_Object file = image_find_image_fd (file_name, &fd); + if (!STRINGP (file)) + { + image_not_found_error (file_name); + return false; + } + + /* Read the entire file into memory. */ ptrdiff_t size; - char *contents = slurp_image (file_name, &size, "SVG"); + char *contents = slurp_file (fd, &size); if (contents == NULL) - return false; - + { + image_error ("Error loading SVG image `%s'", file); + return false; + } /* If the file was slurped into memory properly, parse it. */ if (!STRINGP (base_uri)) base_uri = file; commit bf4d4ab4ddecffbee6d740f9c271dcca514d6a3d Author: Stefan Kangas Date: Thu Oct 5 23:07:39 2023 +0200 Extract function slurp_image from image loading * src/image.c (slurp_image): New function... (xbm_load, xpm_load, pbm_load, webp_load, svg_load): ...extracted from here. diff --git a/src/image.c b/src/image.c index 84db9bfb3b8..fcae13e2302 100644 --- a/src/image.c +++ b/src/image.c @@ -4355,6 +4355,27 @@ slurp_file (image_fd fd, ptrdiff_t *size) return buf; } +/* Like slurp_file above, but with added error handling. Value is + null if an error occurred. Set SIZE to the size of the file. + IMAGE_TYPE describes the image type (e.g. "PNG"). */ + +static char * +slurp_image (Lisp_Object filename, ptrdiff_t *size, const char *image_type) +{ + image_fd fd; + Lisp_Object file = image_find_image_fd (filename, &fd); + if (!STRINGP (file)) + { + image_not_found_error (filename); + return NULL; + } + char *result = slurp_file (fd, size); + if (result == NULL) + image_error ("Error loading %s image `%s'", + make_unibyte_string (image_type, strlen (image_type)), + file); + return result; +} /*********************************************************************** @@ -5073,22 +5094,10 @@ xbm_load (struct frame *f, struct image *img) file_name = image_spec_value (img->spec, QCfile, NULL); if (STRINGP (file_name)) { - image_fd fd; - Lisp_Object file = image_find_image_fd (file_name, &fd); - if (!STRINGP (file)) - { - image_not_found_error (file_name); - return false; - } - ptrdiff_t size; - char *contents = slurp_file (fd, &size); + char *contents = slurp_image (file_name, &size, "XBM"); if (contents == NULL) - { - image_error ("Error loading XBM image `%s'", file); - return 0; - } - + return false; success_p = xbm_load_image (f, img, contents, contents + size); xfree (contents); } @@ -6369,21 +6378,10 @@ xpm_load (struct frame *f, file_name = image_spec_value (img->spec, QCfile, NULL); if (STRINGP (file_name)) { - image_fd fd; - Lisp_Object file = image_find_image_fd (file_name, &fd); - if (!STRINGP (file)) - { - image_not_found_error (file_name); - return false; - } - ptrdiff_t size; - char *contents = slurp_file (fd, &size); + char *contents = slurp_image (file_name, &size, "XPM"); if (contents == NULL) - { - image_error ("Error loading XPM image `%s'", file); - return 0; - } + return false; success_p = xpm_load_image (f, img, contents, contents + size); xfree (contents); @@ -7398,21 +7396,10 @@ pbm_load (struct frame *f, struct image *img) if (STRINGP (specified_file)) { - image_fd fd; - Lisp_Object file = image_find_image_fd (specified_file, &fd); - if (!STRINGP (file)) - { - image_not_found_error (specified_file); - return false; - } - ptrdiff_t size; - contents = slurp_file (fd, &size); + contents = slurp_image (specified_file, &size, "PBM"); if (contents == NULL) - { - image_error ("Error reading `%s'", file); - return 0; - } + return false; p = contents; end = contents + size; @@ -10302,20 +10289,9 @@ webp_load (struct frame *f, struct image *img) if (NILP (specified_data)) { - image_fd fd; - file = image_find_image_fd (specified_file, &fd); - if (!STRINGP (file)) - { - image_not_found_error (specified_file); - return false; - } - - contents = (uint8_t *) slurp_file (fd, &size); + contents = (uint8_t *) slurp_image (specified_file, &size, "WebP"); if (contents == NULL) - { - image_error ("Error loading WebP image `%s'", file); - return false; - } + return false; } else { @@ -11708,22 +11684,11 @@ svg_load (struct frame *f, struct image *img) base_uri = image_spec_value (img->spec, QCbase_uri, NULL); if (STRINGP (file_name)) { - image_fd fd; - Lisp_Object file = image_find_image_fd (file_name, &fd); - if (!STRINGP (file)) - { - image_not_found_error (file_name); - return false; - } - - /* Read the entire file into memory. */ ptrdiff_t size; - char *contents = slurp_file (fd, &size); + char *contents = slurp_image (file_name, &size, "SVG"); if (contents == NULL) - { - image_error ("Error loading SVG image `%s'", file); - return 0; - } + return false; + /* If the file was slurped into memory properly, parse it. */ if (!STRINGP (base_uri)) base_uri = file; commit aad8b5d78f306ac9ca0c03734524c9f49585bee8 Author: Gerd Möllmann Date: Thu Oct 5 20:41:54 2023 +0200 Handle LANG on macOS differently (bug#65908) * src/nsterm.m (ns_init_locale): If LANG is set, try to use that, otherwise try to deduce what LANG should be. Check is the result is valid, and use LANG="en_US.UTF-8" if not. diff --git a/src/nsterm.m b/src/nsterm.m index 7c9fd102a7f..f8aac065b72 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -554,29 +554,32 @@ - (unsigned long)unsignedLong /* macOS doesn't set any environment variables for the locale when run from the GUI. Get the locale from the OS and set LANG. */ { - NSLocale *locale = [NSLocale currentLocale]; - NSTRACE ("ns_init_locale"); - /* If we were run from a terminal then assume an unset LANG variable - is intentional and don't try to "fix" it. */ - if (!isatty (STDIN_FILENO)) + /* Either use LANG, if set, or try to construct LANG from + NSLocale. */ + const char *lang = getenv ("LANG"); + if (lang == NULL || *lang == 0) { - char *oldLocale = setlocale (LC_ALL, NULL); - /* It seems macOS should probably use UTF-8 everywhere. - 'localeIdentifier' does not specify the encoding, and I can't - find any way to get the OS to tell us which encoding to use, - so hard-code '.UTF-8'. */ - NSString *localeID = [NSString stringWithFormat:@"%@.UTF-8", - [locale localeIdentifier]]; - - /* Check the locale ID is valid and if so set LANG, but not if - it is already set. */ - if (setlocale (LC_ALL, [localeID UTF8String])) - setenv("LANG", [localeID UTF8String], 0); + const NSLocale *locale = [NSLocale currentLocale]; + const NSString *localeID = [NSString stringWithFormat:@"%@.UTF-8", + [locale localeIdentifier]]; + lang = [localeID UTF8String]; + } - setlocale (LC_ALL, oldLocale); + /* Check if LANG can be used for initializing the locale. If not, + use a default setting. Note that Emacs' main will undo the + setlocale below, initializing the locale from the + environment. */ + if (setlocale (LC_ALL, lang) == NULL) + { + const char *const default_lang = "en_US.UTF-8"; + fprintf (stderr, "LANG=%s cannot be used, using %s instead.\n", + lang, default_lang); + lang = default_lang; } + + setenv ("LANG", lang, 1); } commit eb5a453a58a4d7fe1ab213d0fdb746ccb65b9909 Author: Stefan Kangas Date: Thu Oct 5 20:10:16 2023 +0200 Set buffers-menu-max-size to 15 unconditionally * lisp/menu-bar.el (buffers-menu-max-size): Set the default value to 15 unconditionally. (Bug#64398) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 2d6abf5d5e3..94c2b50c724 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2314,12 +2314,12 @@ menu-bar-select-yank ;;; Buffers Menu -(defcustom buffers-menu-max-size (if (display-graphic-p) 15 10) +;; Increasing this more might be problematic on TTY frames. See Bug#64398. +(defcustom buffers-menu-max-size 15 "Maximum number of entries which may appear on the Buffers menu. If this is a number, only that many most-recently-selected buffers are shown. If this is nil, all buffers are shown." - :initialize #'custom-initialize-delay :type '(choice natnum (const :tag "All" nil)) :group 'menu @@ -2467,12 +2467,9 @@ menu-bar-update-buffers ;; Make the menu of buffers proper. (setq buffers-menu (let ((i 0) - (limit (if (boundp 'buffers-menu-max-size) - (and (integerp buffers-menu-max-size) - (> buffers-menu-max-size 1) - buffers-menu-max-size) - ;; Used when bootstrapping. - 10)) + (limit (and (integerp buffers-menu-max-size) + (> buffers-menu-max-size 1) + buffers-menu-max-size)) alist) ;; Put into each element of buffer-list ;; the name for actual display, commit 86e8f3150533da1ff5e8bf0afa87c3e97240b253 Author: Jens Schmidt Date: Fri Sep 29 22:04:43 2023 +0200 Silence macro expansion during completion at point * lisp/emacs-lisp/macroexp.el (macroexp-inhibit-compiler-macros): Add variable. (macroexp--compiler-macro): Inspect that new variable and, if it is non-nil, return the input form unchanged. * lisp/progmodes/elisp-mode.el (elisp--local-variables): Silence messages. Avoid compiler macros. (Bug#58148) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 3ef924a5c73..6eb670d6dc1 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -105,13 +105,21 @@ macroexp--all-clauses (macroexp--all-forms clause skip) clause))) +(defvar macroexp-inhibit-compiler-macros nil + "Inhibit application of compiler macros if non-nil.") + (defun macroexp--compiler-macro (handler form) - (condition-case-unless-debug err - (apply handler form (cdr form)) - (error - (message "Warning: Optimization failure for %S: Handler: %S\n%S" - (car form) handler err) - form))) + "Apply compiler macro HANDLER to FORM and return the result. +Unless `macroexp-inhibit-compiler-macros' is non-nil, in which +case return FORM unchanged." + (if macroexp-inhibit-compiler-macros + form + (condition-case-unless-debug err + (apply handler form (cdr form)) + (error + (message "Warning: Optimization failure for %S: Handler: %S\n%S" + (car form) handler err) + form)))) (defun macroexp--funcall-if-compiled (_form) "Pseudo function used internally by macroexp to delay warnings. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 664299df288..ff90a744ea3 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -460,7 +460,11 @@ elisp--local-variables (message "Ignoring macroexpansion error: %S" err) form)))) (sexp (unwind-protect - (let ((warning-minimum-log-level :emergency)) + ;; Silence any macro expansion errors when + ;; attempting completion at point (bug#58148). + (let ((inhibit-message t) + (macroexp-inhibit-compiler-macros t) + (warning-minimum-log-level :emergency)) (advice-add 'macroexpand-1 :around macroexpand-advice) (macroexpand-all sexp elisp--local-macroenv)) (advice-remove 'macroexpand-1 macroexpand-advice))) commit 6cf7e676e9d4846a72d48f21168e92e4efcbf95a Author: Jens Schmidt Date: Tue Sep 26 22:26:15 2023 +0200 Silence macro expansion during completion at point To keep risk in the current release branch low, do not avoid compiler macros as suggested by Stefan in the bug, but rather suppress all errors. * lisp/progmodes/elisp-mode.el (elisp--local-variables): Silence messages. Suppress all errors during macro expansion. (Bug#58148) Do not merge to master. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index bd3916ce108..354d98c50dc 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -447,9 +447,14 @@ elisp--local-variables (error form)))) (sexp (unwind-protect - (let ((warning-minimum-log-level :emergency)) + ;; Silence any macro expansion errors when + ;; attempting completion at point (bug#58148). + (let ((inhibit-message t) + (warning-minimum-log-level :emergency)) (advice-add 'macroexpand :around macroexpand-advice) - (macroexpand-all sexp)) + (condition-case nil + (macroexpand-all sexp) + (error sexp))) (advice-remove 'macroexpand macroexpand-advice))) (vars (elisp--local-variables-1 nil sexp))) (delq nil commit e9b88f61ccce16e6aad2ad8575a25c3665f8bde4 Author: Mauro Aranda Date: Thu Oct 5 10:25:52 2023 -0300 Fix a defcustom :type * lisp/cedet/ede/base.el (ede-project-placeholder-cache-file): Expand :type to allow nil. (Bug#66361) diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 305bf599151..c32d2edd7b7 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -312,7 +312,8 @@ ede-project-placeholder-cache-file "File containing the list of projects EDE has viewed. If set to nil, then the cache is not saved." :group 'ede - :type 'file) + :type '(choice (const :tag "Don't save the cache" nil) + file)) (defvar ede-project-cache-files nil "List of project files EDE has seen before.") commit 095d64577c2393640f4859486d6db492203890e6 Author: Robert Pluim Date: Thu Sep 7 16:56:06 2023 +0200 Use key-translate instead of keyboard-translate As a consequence of the discussions in Bug#65735, move to using the new key-translate function instead of the deprecated keyboard-translate. For future maintainers: ?\C-? or ?\177 do not mean "DEL" with key-translate, you have to use "DEL". * lisp/simple.el (normal-erase-is-backspace-mode): Use key-translate. * lisp/term/bobcat.el (terminal-init-bobcat): Use key-translate. diff --git a/lisp/simple.el b/lisp/simple.el index 2cb3f45866c..ec14bec9e07 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10671,10 +10671,10 @@ normal-erase-is-backspace-mode (t (if enabled (progn - (keyboard-translate ?\C-h ?\C-?) - (keyboard-translate ?\C-? ?\C-d)) - (keyboard-translate ?\C-h ?\C-h) - (keyboard-translate ?\C-? ?\C-?)))) + (key-translate "C-h" "DEL") + (key-translate "DEL" "C-d")) + (key-translate "C-h" "C-h") + (key-translate "DEL" "DEL")))) (if (called-interactively-p 'interactive) (message "Delete key deletes %s" diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el index 983c8cded2f..0c2eba486a3 100644 --- a/lisp/term/bobcat.el +++ b/lisp/term/bobcat.el @@ -3,8 +3,8 @@ (defun terminal-init-bobcat () "Terminal initialization function for bobcat." ;; HP terminals usually encourage using ^H as the rubout character - (keyboard-translate ?\177 ?\^h) - (keyboard-translate ?\^h ?\177)) + (key-translate "DEL" "C-h") + (key-translate "C-h" "DEL")) (provide 'term/bobcat) commit ca9f0e75b1f25b02b32538246ea64e50be6c97c0 Author: Mattias Engdegård Date: Wed Oct 4 19:27:49 2023 +0200 Omit the `omake` compilation-mode rule by default It keeps interfering with other rules, slowing everything down a little bit and makes it harder to add or change other rules. The rule is still there and can easily be re-enabled by those who need it. * etc/NEWS: Announce. * lisp/progmodes/compile.el (compilation-error-regexp-alist): Exclude `omake`. * test/lisp/progmodes/compile-tests.el (compile-tests--test-regexps-data): Actually test the `cucumber` rule. Remove the `omake` test case. (compile-test-error-regexps): Test `omake` here. Test other rules without `omake` included. diff --git a/etc/NEWS b/etc/NEWS index b3c7d3a8693..12c2d52a4ab 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -299,6 +299,14 @@ equivalent to the "--heading" option of some tools such as 'git grep' and 'rg'. The headings are displayed using the new 'grep-heading' face. +--- +** Compilation mode + +*** The 'omake' matching rule is now disabled by default. +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'. + ** VC --- diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 4cf62476148..9e441dbfcf7 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -683,7 +683,10 @@ compilation-error-regexp-alist-alist "Alist of values for `compilation-error-regexp-alist'.") (defcustom compilation-error-regexp-alist - (mapcar #'car compilation-error-regexp-alist-alist) + ;; Omit `omake' by default: its mere presence here triggers special processing + ;; and modifies regexps for other rules (see `compilation-parse-errors'), + ;; which may slow down matching (or even cause mismatches). + (delq 'omake (mapcar #'car compilation-error-regexp-alist-alist)) "Alist that specifies how to match errors in compiler output. On GNU and Unix, any string is a valid filename, so these matchers must make some common sense assumptions, which catch diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 078eef36774..d497644c389 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -121,9 +121,7 @@ compile-tests--test-regexps-data ;; cucumber (cucumber "Scenario: undefined step # features/cucumber.feature:3" 29 nil 3 "features/cucumber.feature") - ;; This rule is actually handled by the `cucumber' pattern but when - ;; `omake' is included, then `gnu' matches it first. - (gnu " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" + (cucumber " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" 1 nil 500 "/home/gusev/.rvm/foo/bar.rb") ;; edg-1 edg-2 (edg-1 "build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" @@ -312,10 +310,6 @@ compile-tests--test-regexps-data 1 nil 109 "..\\src\\ctrl\\lister.c") (watcom "..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" 1 nil 120 "..\\src\\ctrl\\lister.c") - ;; omake - ;; FIXME: This doesn't actually test the omake rule. - (gnu " alpha.c:5:15: error: expected ';' after expression" - 1 15 5 "alpha.c") ;; oracle (oracle "Semantic error at line 528, column 5, file erosacqdb.pc:" 1 5 528 "erosacqdb.pc") @@ -497,8 +491,22 @@ compile-test-error-regexps (font-lock-mode -1) (let ((compilation-num-errors-found 0) (compilation-num-warnings-found 0) - (compilation-num-infos-found 0)) - (mapc #'compile--test-error-line compile-tests--test-regexps-data) + (compilation-num-infos-found 0) + (all-rules (mapcar #'car compilation-error-regexp-alist-alist))) + + ;; Test all built-in rules except `omake' to avoid interference. + (let ((compilation-error-regexp-alist (remq 'omake all-rules))) + (mapc #'compile--test-error-line compile-tests--test-regexps-data)) + + ;; Test the `omake' rule separately. + ;; This doesn't actually test the `omake' rule itself but its + ;; indirect effects. + (let ((compilation-error-regexp-alist all-rules) + (test + '(gnu " alpha.c:5:15: error: expected ';' after expression" + 1 15 5 "alpha.c"))) + (compile--test-error-line test)) + (should (eq compilation-num-errors-found 100)) (should (eq compilation-num-warnings-found 35)) (should (eq compilation-num-infos-found 28))))) commit cfcdb6ec2af52dd4c7b2300363a0da1c79b9b26e Author: Gregory Heytings Date: Thu Oct 5 08:37:21 2023 +0000 ; * admin/git-bisect-start: Update failing commits diff --git a/admin/git-bisect-start b/admin/git-bisect-start index 8eb5328a1a1..30a738267fa 100755 --- a/admin/git-bisect-start +++ b/admin/git-bisect-start @@ -2,7 +2,9 @@ ### Start a git bisection, ensuring that commits in branches that are ### the result of merging external trees into the Emacs repository, as -### well as certain commits on which Emacs fails to build, are skipped. +### well as certain commits on which Emacs fails to build (with the +### default options, on a GNU/Linux computer and with GCC; see below), +### are skipped. ## Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -82,7 +84,7 @@ done # SKIP-BRANCH 58cc931e92ece70c3e64131ee12a799d65409100 ## The list below is the exhaustive list of all commits between Dec 1 -## 2016 and Aug 10 2023 on which building Emacs with the default +## 2016 and Oct 2 2023 on which building Emacs with the default ## options, on a GNU/Linux computer and with GCC, fails. It is ## possible (though unlikely) that building Emacs with non-default ## options, with other compilers, or on other platforms, would succeed @@ -1776,3 +1778,13 @@ $REAL_GIT bisect skip $(cat $0 | grep '^# SKIP-SINGLE ' | sed 's/^# SKIP-SINGLE # SKIP-SINGLE 2752573dfb76873dbe783e89a1fbf01d157c54e3 # SKIP-SINGLE 62e990db7a2fad16756e019b331c28ad5a5a89fe # SKIP-SINGLE 6253e7e74249c7cdfa86723f0b91a1d207cb143e +# SKIP-SINGLE 1f7113e68988fa0bcbdeca5ae364cba8d6db3637 +# SKIP-SINGLE 6e44d6e18438ea2665ae6252a6ec090963dd7e42 +# SKIP-SINGLE 168cc0aff0bfbc1d67a7e8a72b88a1bf10ad019e +# SKIP-SINGLE efb276fef1f580eafa8458fc262a4b35eb3abd5e +# SKIP-SINGLE cc0d7d7a3867e4554f89262e4641c9845ee0d647 +# SKIP-SINGLE 012f9c28053d06b6d527d77530605aedbd55d5b4 +# SKIP-SINGLE e61a03984335b4ffb164280b2df80668b2a92c23 +# SKIP-SINGLE f7fd21b06865d20a16c11e20776e843db24d4b14 +# SKIP-SINGLE 35fbf6f15830f576fd1909f4a8d30e7ba1d777bd +# SKIP-SINGLE 0e44ab5f061c81874dd8298a0f3318f14ef95a24 commit 5b019360d681f808f4336188cd85ada2f3593438 Author: Spencer Baugh Date: Wed Jun 28 08:48:01 2023 -0400 Make newly-created smerge-diff-buffers read-only Buffers name *vc-diff* are usually created by vc, which makes them read-only. If we create such a buffer, let's make it read-only too. If the buffer already exists, though, don't change that since the user might have deliberately made it writable. * lisp/vc/smerge-mode.el (smerge-diff): Make newly-created smerge-diff-buffers read-only. (bug#64071) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 7847a6c7670..e42b82c7064 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1239,7 +1239,11 @@ smerge-diff (write-region beg1 end1 file1 nil 'nomessage) (write-region beg2 end2 file2 nil 'nomessage) (unwind-protect - (with-current-buffer (get-buffer-create smerge-diff-buffer-name) + (save-current-buffer + (if-let (buffer (get-buffer smerge-diff-buffer-name)) + (set-buffer buffer) + (set-buffer (get-buffer-create smerge-diff-buffer-name)) + (setq buffer-read-only t)) (setq default-directory dir) (let ((inhibit-read-only t)) (erase-buffer) commit a9c4994776f21ba2880469739688c0718d1686c7 Author: Eli Zaretskii Date: Thu Oct 5 11:01:41 2023 +0300 ' Improve wording of compilation-error messages * lisp/progmodes/compile.el (compilation-next-error): Improve wording of user-error text. (Bug#65713) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f85cc0909dd..4cf62476148 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2721,7 +2721,7 @@ compilation-next-error (compilation-loop > compilation-next-single-property-change 1- (if (get-buffer-process (current-buffer)) "No more %ss yet" - "Moved past last %s") + "Past last %s") (point-max)) ;; Don't move "back" to message at or before point. ;; Pass an explicit (point-min) to make sure pt is non-nil. commit 60f3e9f5c92622b6ab8811147b576a2052d15e60 Author: Paul W. Rankin Date: Tue Oct 3 07:27:38 2023 -0300 Improve find-sibling-rules option type * lisp/files.el (find-sibling-rules): More helpful rules. diff --git a/lisp/files.el b/lisp/files.el index ddae097f1d1..884c6b74247 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7572,7 +7572,8 @@ find-sibling-rules In this example, if you're in \"src/emacs/emacs-27/lisp/abbrev.el\", and a \"src/emacs/emacs-28/lisp/abbrev.el\" file exists, it's now defined as a sibling." - :type 'sexp + :type '(alist :key-type (regexp :tag "Match") + :value-type (repeat (string :tag "Expansion"))) :version "29.1") (defun find-sibling-file (file) commit 873341037e2430ab17c7eb523027fa88b614d3fe Author: Manuel Giraud Date: Wed Sep 27 19:05:10 2023 +0200 Nontext mouse cursor as default on {tab|tool}-bar * src/xdisp.c (note_mouse_highlight): Always set the mouse cursor to nontext when entering tab-bar and tool-bar. (Bug#66243) diff --git a/src/xdisp.c b/src/xdisp.c index f1980c4f20c..2c53527c25e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35544,12 +35544,10 @@ note_mouse_highlight (struct frame *f, int x, int y) { note_tab_bar_highlight (f, x, y); if (tab_bar__dragging_in_progress) - { cursor = FRAME_OUTPUT_DATA (f)->hand_cursor; - goto set_cursor; - } else - return; + cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; + goto set_cursor; } else { @@ -35567,7 +35565,8 @@ note_mouse_highlight (struct frame *f, int x, int y) if (EQ (window, f->tool_bar_window)) { note_tool_bar_highlight (f, x, y); - return; + cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; + goto set_cursor; } #endif commit 123b77436e187c6254d4585d08135a44077528d1 Author: Po Lu Date: Thu Oct 5 14:23:20 2023 +0800 Introduce an input method callback required by Android 34 * java/org/gnu/emacs/EmacsInputConnection.java (replaceText): New function. * java/org/gnu/emacs/EmacsNative.java (replaceText): Declare native function. * src/androidgui.h (enum android_ime_operation): New operation ANDROID_IME_REPLACE_TEXT. * src/androidterm.c (android_handle_ime_event): Decode text when encountering an ANDROID_IME_REPLACE_TEXT operation. Return if decoding overflowed rather than presenting Qnil to textconv functions. (replaceText): New JNI function. * src/frame.h (enum text_conversion_operation): New operation TEXTCONV_REPLACE_TEXT. * src/textconv.c (really_commit_text): Move point to start if the composing region is set. (really_replace_text): New function. (handle_pending_conversion_events_1) : New case. (replace_text): New function. * src/textconv.h: Update prototypes. diff --git a/java/org/gnu/emacs/EmacsInputConnection.java b/java/org/gnu/emacs/EmacsInputConnection.java index c3764a7b29f..7f6331205cb 100644 --- a/java/org/gnu/emacs/EmacsInputConnection.java +++ b/java/org/gnu/emacs/EmacsInputConnection.java @@ -628,6 +628,21 @@ public final class EmacsInputConnection implements InputConnection batchEditCount = 0; } + @Override + public boolean + replaceText (int start, int end, CharSequence text, + int newCursorPosition, TextAttribute attributes) + { + if (EmacsService.DEBUG_IC) + Log.d (TAG, ("replaceText: " + text + ":: " + start + "," + + end + "," + newCursorPosition)); + + EmacsNative.replaceText (windowHandle, start, end, + text.toString (), newCursorPosition, + attributes); + return true; + } + public void diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index a4b45aafbc1..d8524d92130 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -26,6 +26,7 @@ import android.view.inputmethod.ExtractedText; import android.view.inputmethod.ExtractedTextRequest; import android.view.inputmethod.SurroundingText; +import android.view.inputmethod.TextAttribute; import android.view.inputmethod.TextSnapshot; public final class EmacsNative @@ -219,6 +220,9 @@ public static native void deleteSurroundingText (short window, int leftLength, int rightLength); public static native void finishComposingText (short window); + public static native void replaceText (short window, int start, int end, + String text, int newCursorPosition, + TextAttribute attributes); public static native String getSelectedText (short window, int flags); public static native String getTextAfterCursor (short window, int length, int flags); diff --git a/src/androidgui.h b/src/androidgui.h index 14225f7bf80..936706b092e 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -463,6 +463,7 @@ #define ANDROID_IS_MODIFIER_KEY(key) \ ANDROID_IME_END_BATCH_EDIT, ANDROID_IME_REQUEST_SELECTION_UPDATE, ANDROID_IME_REQUEST_CURSOR_UPDATES, + ANDROID_IME_REPLACE_TEXT, }; enum diff --git a/src/androidterm.c b/src/androidterm.c index 438f8ce1fbb..9b00ad85642 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -687,9 +687,17 @@ android_handle_ime_event (union android_event *event, struct frame *f) { case ANDROID_IME_COMMIT_TEXT: case ANDROID_IME_SET_COMPOSING_TEXT: + case ANDROID_IME_REPLACE_TEXT: text = android_decode_utf16 (event->ime.text, event->ime.length); xfree (event->ime.text); + + /* Return should text be long enough that it overflows ptrdiff_t. + Such circumstances are detected within android_decode_utf16. */ + + if (NILP (text)) + return; + break; default: @@ -773,6 +781,12 @@ android_handle_ime_event (union android_event *event, struct frame *f) case ANDROID_IME_REQUEST_CURSOR_UPDATES: android_request_cursor_updates (f, event->ime.length); break; + + case ANDROID_IME_REPLACE_TEXT: + replace_text (f, event->ime.start, event->ime.end, + text, event->ime.position, + event->ime.counter); + break; } } @@ -4856,6 +4870,39 @@ NATIVE_NAME (finishComposingText) (JNIEnv *env, jobject object, android_write_event (&event); } +JNIEXPORT void JNICALL +NATIVE_NAME (replaceText) (JNIEnv *env, jobject object, jshort window, + jint start, jint end, jobject text, + int new_cursor_position, jobject attribute) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + union android_event event; + size_t length; + + /* First, obtain a copy of the Java string. */ + text = android_copy_java_string (env, text, &length); + + if (!text) + return; + + /* Next, populate the event with the information in this function's + arguments. */ + + event.ime.type = ANDROID_INPUT_METHOD; + event.ime.serial = ++event_serial; + event.ime.window = window; + event.ime.operation = ANDROID_IME_REPLACE_TEXT; + event.ime.start = start + 1; + event.ime.end = end + 1; + event.ime.length = length; + event.ime.position = new_cursor_position; + event.ime.text = text; + event.ime.counter = ++edit_counter; + + android_write_event (&event); +} + /* Structure describing the context used for a text query. */ struct android_conversion_query_context diff --git a/src/frame.h b/src/frame.h index f4726f1c0e5..d826ae56e8b 100644 --- a/src/frame.h +++ b/src/frame.h @@ -90,6 +90,7 @@ #define EMACS_FRAME_H TEXTCONV_DELETE_SURROUNDING_TEXT, TEXTCONV_REQUEST_POINT_UPDATE, TEXTCONV_BARRIER, + TEXTCONV_REPLACE_TEXT, }; /* Structure describing a single edit being performed by the input diff --git a/src/textconv.c b/src/textconv.c index 57daa7e53b6..bd72562317f 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -616,6 +616,12 @@ really_commit_text (struct frame *f, EMACS_INT position, end = max (mark, PT); } + /* If it transpires that the start of the compose region is not + point, move point there. */ + + if (start != PT) + set_point (start); + /* Now delete whatever needs to go. */ del_range_1 (start, end, true, false); @@ -635,7 +641,7 @@ really_commit_text (struct frame *f, EMACS_INT position, record_buffer_change (start, PT, text); } - /* Move to a the position specified in POSITION. */ + /* Move to the position specified in POSITION. */ if (position <= 0) { @@ -1154,6 +1160,135 @@ really_set_point_and_mark (struct frame *f, ptrdiff_t point, unbind_to (count, Qnil); } +/* Remove the composing region. Replace the text between START and + END in F's selected window with TEXT, then set point to POSITION + relative to it. If the mark is active, deactivate it. */ + +static void +really_replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end, + Lisp_Object text, ptrdiff_t position) +{ + specpdl_ref count; + ptrdiff_t new_start, new_end, wanted; + struct window *w; + + /* If F's old selected window is no longer alive, fail. */ + + if (!WINDOW_LIVE_P (f->old_selected_window)) + return; + + count = SPECPDL_INDEX (); + record_unwind_protect (restore_selected_window, + selected_window); + + /* Make the composition region markers point elsewhere. */ + + if (!NILP (f->conversion.compose_region_start)) + { + Fset_marker (f->conversion.compose_region_start, Qnil, Qnil); + Fset_marker (f->conversion.compose_region_end, Qnil, Qnil); + f->conversion.compose_region_start = Qnil; + f->conversion.compose_region_end = Qnil; + + /* Notify the IME of an update to the composition region, + inasmuch as the point might not change if START and END are + identical and TEXT is empty, among other circumstances. */ + + if (text_interface + && text_interface->compose_region_changed) + (*text_interface->compose_region_changed) (f); + } + + /* Delete the composition region overlay. */ + + if (!NILP (f->conversion.compose_region_overlay)) + Fdelete_overlay (f->conversion.compose_region_overlay); + + /* Temporarily switch to F's selected window at the time of the last + redisplay. */ + select_window (f->old_selected_window, Qt); + + /* Sort START and END by magnitude. */ + new_start = min (start, end); + new_end = max (start, end); + + /* Now constrain both to the accessible region. */ + + if (new_start < BEGV) + new_start = BEGV; + else if (new_start > ZV) + new_start = ZV; + + if (new_end < BEGV) + new_end = BEGV; + else if (new_end > ZV) + new_end = ZV; + + start = new_start; + end = new_end; + + /* This should deactivate the mark. */ + call0 (Qdeactivate_mark); + + /* Go to start. */ + set_point (start); + + /* Now delete the text in between, and save PT before TEXT is + inserted. */ + del_range_1 (start, end, true, false); + record_buffer_change (start, start, Qt); + wanted = PT; + + /* So long as TEXT isn't empty, insert it now. */ + + if (SCHARS (text)) + { + /* Insert the new text. Make sure to inherit text properties + from the surroundings: if this doesn't happen, CC Mode + fontification might grow confused and become very slow. */ + + insert_from_string (text, 0, 0, SCHARS (text), + SBYTES (text), true); + record_buffer_change (start, PT, text); + } + + /* Now, move point to the position designated by POSITION. */ + + if (position <= 0) + { + if (INT_ADD_WRAPV (wanted, position, &wanted) + || wanted < BEGV) + wanted = BEGV; + + if (wanted > ZV) + wanted = ZV; + + set_point (wanted); + } + else + { + wanted = PT; + + if (INT_ADD_WRAPV (wanted, position - 1, &wanted) + || wanted > ZV) + wanted = ZV; + + if (wanted < BEGV) + wanted = BEGV; + + set_point (wanted); + } + + /* Print some debugging information. */ + TEXTCONV_DEBUG ("text inserted: %s, point now: %zd", + SSDATA (text), PT); + + /* Update the ephemeral last point. */ + w = XWINDOW (selected_window); + w->ephemeral_last_point = PT; + unbind_to (count, Qnil); +} + /* Complete the edit specified by the counter value inside *TOKEN. */ static void @@ -1325,6 +1460,13 @@ handle_pending_conversion_events_1 (struct frame *f, if (w) w->ephemeral_last_point = window_point (w); break; + + case TEXTCONV_REPLACE_TEXT: + really_replace_text (f, XFIXNUM (XCAR (data)), + XFIXNUM (XCAR (XCDR (data))), + XCAR (XCDR (XCDR (data))), + XFIXNUM (XCAR (XCDR (XCDR (XCDR (data)))))); + break; } /* Signal success. */ @@ -1679,6 +1821,30 @@ textconv_barrier (struct frame *f, unsigned long counter) input_pending = true; } +/* Remove the composing region. Replace the text between START and + END within F's selected window with TEXT; deactivate the mark if it + is active. Subsequently, set point to POSITION relative to TEXT, + much as `commit_text' would. */ + +void +replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end, + Lisp_Object text, ptrdiff_t position, + unsigned long counter) +{ + struct text_conversion_action *action, **last; + + action = xmalloc (sizeof *action); + action->operation = TEXTCONV_REPLACE_TEXT; + action->data = list4 (make_fixnum (start), make_fixnum (end), + text, make_fixnum (position)); + action->next = NULL; + action->counter = counter; + for (last = &f->conversion.actions; *last; last = &(*last)->next) + ;; + *last = action; + input_pending = true; +} + /* Return N characters of text around point in frame F's old selected window. diff --git a/src/textconv.h b/src/textconv.h index feac5b805af..c677c07e9aa 100644 --- a/src/textconv.h +++ b/src/textconv.h @@ -142,6 +142,9 @@ #define TEXTCONV_SKIP_CONVERSION_REGION (1 << 0) ptrdiff_t, unsigned long); extern void request_point_update (struct frame *, unsigned long); extern void textconv_barrier (struct frame *, unsigned long); +extern void replace_text (struct frame *, ptrdiff_t, ptrdiff_t, + Lisp_Object, ptrdiff_t, unsigned long); + extern char *get_extracted_text (struct frame *, ptrdiff_t, ptrdiff_t *, ptrdiff_t *, ptrdiff_t *, ptrdiff_t *, ptrdiff_t *, bool *); commit 253f1aff1ab00e9794f3cfcf50e86e335f411242 Author: Po Lu Date: Thu Oct 5 11:57:26 2023 +0800 Port Emacs to Android 34 * configure.ac: Detect and require Android 34 headers. * doc/emacs/android.texi (Android Environment): Mention new permissions mandated by Android 34. * java/AndroidManifest.xml.in: Introduce new permissions and foreground service types prerequisite for background execution under Android 34. * java/INSTALL: Update installation documentation. * java/org/gnu/emacs/EmacsSdk7FontDriver.java (Sdk7FontEntity) (Sdk7FontObject): * java/org/gnu/emacs/EmacsService.java (onCreate): Silence deprecation warnings. * src/android.c: Update documentation. diff --git a/configure.ac b/configure.ac index 9ae0dec3867..4456cd89b7a 100644 --- a/configure.ac +++ b/configure.ac @@ -941,7 +941,7 @@ AC_DEFUN fi AC_CACHE_CHECK([whether android.jar is new enough], - [emacs_cv_android_s_or_later], + [emacs_cv_android_u_or_later], AS_IF([rm -f conftest.class cat << EOF > conftest.java @@ -949,18 +949,18 @@ AC_DEFUN class conftest { - private static int test = Build.VERSION_CODES.TIRAMISU; + private static int test = Build.VERSION_CODES.UPSIDE_DOWN_CAKE; } EOF ("$JAVAC" -classpath "$with_android" -target 1.7 -source 1.7 conftest.java \ -d . >&AS_MESSAGE_LOG_FD 2>&1) && test -s conftest.class && rm -f conftest.class], - [emacs_cv_android_s_or_later=yes], - [emacs_cv_android_s_or_later=no])) + [emacs_cv_android_u_or_later=yes], + [emacs_cv_android_u_or_later=no])) - if test "$emacs_cv_android_s_or_later" = "no"; then + if test "$emacs_cv_android_u_or_later" = "no"; then AC_MSG_ERROR([Emacs must be built with an android.jar file produced for \ -Android 13 (Tiramisu) or later.]) +Android 14 (Upside Down Cake) or later.]) fi dnl See if the Java compiler supports the `--release' option which @@ -1152,6 +1152,8 @@ AC_DEFUN foo = "emacs_api_32"; #elif __ANDROID_API__ < 34 foo = "emacs_api_33"; +#elif __ANDROID_API__ < 35 + foo = "emacs_api_34"; #else foo = "emacs_api_future"; #endif diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 9f3cca2b137..5e018c3e4c5 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -469,6 +469,10 @@ Android Environment @code{android.permission.TRANSMIT_IR} @item @code{android.permission.WAKE_LOCK} +@item +@code{android.permission.FOREGROUND_SERVICE} +@item +@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE} @end itemize Other permissions must be granted by the user through the system diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in index 9ba9dabde81..2749f43c245 100644 --- a/java/AndroidManifest.xml.in +++ b/java/AndroidManifest.xml.in @@ -73,8 +73,12 @@ along with GNU Emacs. If not, see . --> + + + + + android:targetSdkVersion="34"/> . --> android:directBootAware="false" android:enabled="true" android:exported="false" + android:foregroundServiceType="specialUse" android:label="GNU Emacs service"/> diff --git a/java/INSTALL b/java/INSTALL index fb235af1346..b6c31483dd3 100644 --- a/java/INSTALL +++ b/java/INSTALL @@ -39,7 +39,7 @@ script like so: Replacing the paths in the command line above with: - the path to the `android.jar' headers which come with the Android - SDK. They must correspond to Android version 13 (API level 33). + SDK. They must correspond to Android version 14 (API level 34). - the path to the C compiler in the Android NDK, for the kind of CPU you are building Emacs to run on. @@ -87,13 +87,13 @@ necessary for compiling Emacs. It is imperative that Emacs is compiled using the headers for the exact API level that it is written for. This is currently API level -33, so the correct android.jar archive is located within a directory -whose name begins with `android-33'. Minor revisions to the headers +34, so the correct android.jar archive is located within a directory +whose name begins with `android-34'. Minor revisions to the headers are inconsequential towards the Emacs compilation process; if there is -a directory named `android-33-extN' (where N represents a revision to +a directory named `android-34-extN' (where N represents a revision to the Android SDK), whether you provide `configure' with that directory's android.jar or the android.jar contained within the -directory named `android-33' is of no special importance. +directory named `android-34' is of no special importance. The ndk directory contains one subdirectory for each version of the Android NDK installed. This directory in turn contains the C and C++ diff --git a/java/org/gnu/emacs/EmacsSdk7FontDriver.java b/java/org/gnu/emacs/EmacsSdk7FontDriver.java index 21ae159d5bd..33d6ee34fa4 100644 --- a/java/org/gnu/emacs/EmacsSdk7FontDriver.java +++ b/java/org/gnu/emacs/EmacsSdk7FontDriver.java @@ -99,6 +99,7 @@ protected static final class Sdk7FontEntity extends FontEntity /* The typeface. */ public Sdk7Typeface typeface; + @SuppressWarnings ("deprecation") public Sdk7FontEntity (Sdk7Typeface typeface) { @@ -120,6 +121,7 @@ protected final class Sdk7FontObject extends FontObject /* The typeface. */ public Sdk7Typeface typeface; + @SuppressWarnings ("deprecation") public Sdk7FontObject (Sdk7Typeface typeface, int pixelSize) { diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 997c6923fcc..28b725d0cd0 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -223,6 +223,21 @@ public final class EmacsService extends Service } } + /* Return the display density, adjusted in accord with the user's + text scaling preferences. */ + + @SuppressWarnings ("deprecation") + private static float + getScaledDensity (DisplayMetrics metrics) + { + /* The scaled density has been made obsolete by the introduction + of non-linear text scaling in Android 34, where there is no + longer a fixed relation between point and pixel sizes, but + remains useful, considering that Emacs does not support + non-linear text scaling. */ + return metrics.scaledDensity; + } + @Override public void onCreate () @@ -242,7 +257,7 @@ public final class EmacsService extends Service metrics = getResources ().getDisplayMetrics (); pixelDensityX = metrics.xdpi; pixelDensityY = metrics.ydpi; - tempScaledDensity = ((metrics.scaledDensity + tempScaledDensity = ((getScaledDensity (metrics) / metrics.density) * pixelDensityX); resolver = getContentResolver (); diff --git a/src/android.c b/src/android.c index 1424270e785..b9236075a1e 100644 --- a/src/android.c +++ b/src/android.c @@ -6238,7 +6238,7 @@ android_restart_emacs (void) exit (0); } -/* Return a number from 1 to 33 describing the version of Android +/* Return a number from 1 to 34 describing the version of Android Emacs is running on. This is different from __ANDROID_API__, as that describes the commit 511acc2ed827dd039eee1c6d70c77153825d5c67 Author: Eli Zaretskii Date: Wed Oct 4 20:04:53 2023 +0300 ; * lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Typo. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index aa495b161d6..b6d1f13bb2f 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -550,7 +550,7 @@ cl-print-to-string-with-limit "Return a string containing a printed representation of VALUE. Attempt to get the length of the returned string under LIMIT characters with appropriate settings of `print-level', -`print-length.', and `cl-print-string-length'. Use +`print-length', and `cl-print-string-length'. Use PRINT-FUNCTION to print, which should take the arguments VALUE and STREAM and which should respect `print-length', `print-level', and `cl-print-string-length'. LIMIT may be nil or commit 3216cd96952c5fa0fbe665ef219210c9ebaf4e75 Author: Mauro Aranda Date: Wed Oct 4 10:47:51 2023 -0300 Fix pulse-flag :type * lisp/cedet/pulse.el (pulse-flag): Expand :type to allow 'never as value. (Bug#66341) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index 37b41fbe8c3..38ccf5b975f 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -71,7 +71,9 @@ pulse-flag If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then this flag is ignored." :group 'pulse - :type 'boolean) + :type '(choice (const :tag "Highlight with unchanging color" nil) + (const :tag "No highlight" never) + (other :tag "Pulse" t))) (defface pulse-highlight-start-face '((((class color) (background dark)) commit bb417daa703b0dd8871470ce53a40b16b1ca300b Author: Po Lu Date: Wed Oct 4 16:33:05 2023 +0800 Correct local reference leaks * src/android.c (android_build_string): Accept a list of local references to destroy upon an allocation failure, facilitating the proper deallocation of local references in such situations. (android_browse_url): Revise for new calling convention. * src/android.h (android_build_string): Update declaration correspondingly. * src/androidmenu.c (android_menu_show, android_dialog_show): Revise for new calling convention. * src/androidselect.c (android_notifications_notify_1): Supply each successive local reference to android_build_string as notification text is being encoded. * src/androidvfs.c (android_saf_exception_check): Introduce absent va_end. diff --git a/src/android.c b/src/android.c index aa4033c676f..1424270e785 100644 --- a/src/android.c +++ b/src/android.c @@ -5593,15 +5593,20 @@ android_verify_jni_string (const char *name) } /* Given a Lisp string TEXT, return a local reference to an equivalent - Java string. */ + Java string. Each argument following TEXT should be NULL or a + local reference that will be freed if creating the string fails, + whereupon memory_full will also be signaled. */ jstring -android_build_string (Lisp_Object text) +android_build_string (Lisp_Object text, ...) { Lisp_Object encoded; jstring string; size_t nchars; jchar *characters; + va_list ap; + jobject object; + USE_SAFE_ALLOCA; /* Directly encode TEXT if it contains no non-ASCII characters, or @@ -5619,9 +5624,11 @@ android_build_string (Lisp_Object text) { string = (*android_java_env)->NewStringUTF (android_java_env, SSDATA (text)); - android_exception_check (); - SAFE_FREE (); + if ((*android_java_env)->ExceptionCheck (android_java_env)) + goto error; + + SAFE_FREE (); return string; } @@ -5640,10 +5647,36 @@ android_build_string (Lisp_Object text) string = (*android_java_env)->NewString (android_java_env, characters, nchars); - android_exception_check (); + + if ((*android_java_env)->ExceptionCheck (android_java_env)) + goto error; SAFE_FREE (); return string; + + error: + /* An exception arose while creating the string. When this + transpires, an assumption is made that the error was induced by + running out of memory. Delete each of the local references + within AP. */ + + va_start (ap, text); + + __android_log_print (ANDROID_LOG_WARN, __func__, + "Possible out of memory error. " + " The Java exception follows: "); + /* Describe exactly what went wrong. */ + (*android_java_env)->ExceptionDescribe (android_java_env); + (*android_java_env)->ExceptionClear (android_java_env); + + /* Now remove each and every local reference provided after + OBJECT. */ + + while ((object = va_arg (ap, jobject))) + ANDROID_DELETE_LOCAL_REF (object); + + va_end (ap); + memory_full (0); } /* Do the same, except TEXT is constant string data in ASCII or @@ -6154,7 +6187,7 @@ android_browse_url (Lisp_Object url, Lisp_Object send) Lisp_Object tem; const char *buffer; - string = android_build_string (url); + string = android_build_string (url, NULL); value = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, emacs_service, diff --git a/src/android.h b/src/android.h index d4605c11ad0..28d9d25930e 100644 --- a/src/android.h +++ b/src/android.h @@ -108,7 +108,7 @@ Copyright (C) 2023 Free Software Foundation, Inc. extern void android_set_dont_accept_focus (android_window, bool); extern int android_verify_jni_string (const char *); -extern jstring android_build_string (Lisp_Object); +extern jstring android_build_string (Lisp_Object, ...); extern jstring android_build_jstring (const char *); extern void android_exception_check (void); extern void android_exception_check_1 (jobject); diff --git a/src/androidmenu.c b/src/androidmenu.c index ed26bdafa85..1f4d91b527d 100644 --- a/src/androidmenu.c +++ b/src/androidmenu.c @@ -278,7 +278,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, title_string = NULL; if (STRINGP (title) && menu_items_n_panes < 2) - title_string = android_build_string (title); + title_string = android_build_string (title, NULL); /* Push the first local frame for the context menu. */ method = menu_class.create_context_menu; @@ -370,7 +370,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, pane_name = Fsubstring (pane_name, make_fixnum (1), Qnil); /* Add the pane. */ - temp = android_build_string (pane_name); + temp = android_build_string (pane_name, NULL); android_exception_check (); (*env)->CallNonvirtualVoidMethod (env, current_context_menu, @@ -399,7 +399,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, { /* This is a submenu. Add it. */ title_string = (!NILP (item_name) - ? android_build_string (item_name) + ? android_build_string (item_name, NULL) : NULL); help_string = NULL; @@ -408,7 +408,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, if (android_get_current_api_level () >= 26 && STRINGP (help)) - help_string = android_build_string (help); + help_string = android_build_string (help, NULL); store = current_context_menu; current_context_menu @@ -443,7 +443,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, /* Add this menu item with the appropriate state. */ title_string = (!NILP (item_name) - ? android_build_string (item_name) + ? android_build_string (item_name, NULL) : NULL); help_string = NULL; @@ -452,7 +452,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, if (android_get_current_api_level () >= 26 && STRINGP (help)) - help_string = android_build_string (help); + help_string = android_build_string (help, NULL); /* Determine whether or not to display a check box. */ @@ -686,7 +686,7 @@ android_dialog_show (struct frame *f, Lisp_Object title, : android_build_jstring ("Question")); /* And the title. */ - java_title = android_build_string (title); + java_title = android_build_string (title, NULL); /* Now create the dialog. */ method = dialog_class.create_dialog; @@ -738,7 +738,7 @@ android_dialog_show (struct frame *f, Lisp_Object title, } /* Add the button. */ - temp = android_build_string (item_name); + temp = android_build_string (item_name, NULL); (*env)->CallNonvirtualVoidMethod (env, dialog, dialog_class.class, dialog_class.add_button, diff --git a/src/androidselect.c b/src/androidselect.c index cf2265d4cf4..3f025351093 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -613,10 +613,12 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, (long int) (boot_time.tv_sec / 2), id); /* Encode all strings into their Java counterparts. */ - title1 = android_build_string (title); - body1 = android_build_string (body); - group1 = android_build_string (group); - identifier1 = android_build_jstring (identifier); + title1 = android_build_string (title, NULL); + body1 = android_build_string (body, title1, NULL); + group1 = android_build_string (group, body1, title1, NULL); + identifier1 + = (*android_java_env)->NewStringUTF (android_java_env, identifier); + android_exception_check_3 (title1, body1, group1); /* Create the notification. */ notification diff --git a/src/androidvfs.c b/src/androidvfs.c index 0e5bbf8a13e..94c5d35ed2c 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -3995,8 +3995,11 @@ android_saf_exception_check (int n, ...) /* First, check for an exception. */ if (!(*env)->ExceptionCheck (env)) - /* No exception has taken place. Return 0. */ - return 0; + { + /* No exception has taken place. Return 0. */ + va_end (ap); + return 0; + } /* Print the exception. */ (*env)->ExceptionDescribe (env); @@ -4045,6 +4048,7 @@ android_saf_exception_check (int n, ...) /* expression is still a local reference! */ ANDROID_DELETE_LOCAL_REF ((jobject) exception); errno = new_errno; + va_end (ap); return 1; } commit fbfdd1e0e3e67f765c6dbf9f61b5f913e55e004e Author: Juri Linkov Date: Tue Oct 3 20:13:58 2023 +0300 * lisp/menu-bar.el (menu-bar-project-menu): Improve menu items. Remove ellipsis from menu items that don't read arguments from the minibuffer. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 3a348ebcdc6..2d6abf5d5e3 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1804,7 +1804,7 @@ menu-bar-project-menu (bindings--define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files belonging to current project")) (bindings--define-key menu [separator-project-search] menu-bar-separator) (bindings--define-key menu [project-kill-buffers] '(menu-item "Kill Buffers..." project-kill-buffers :help "Kill the buffers belonging to the current project")) - (bindings--define-key menu [project-list-buffers] '(menu-item "List Buffers..." project-list-buffers :help "Pop up a window listing all Emacs buffers belonging to current project")) + (bindings--define-key menu [project-list-buffers] '(menu-item "List Buffers" project-list-buffers :help "Pop up a window listing all Emacs buffers belonging to current project")) (bindings--define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer belonging to current project, and switch to it")) (bindings--define-key menu [separator-project-buffers] menu-bar-separator) (bindings--define-key menu [project-async-shell-command] '(menu-item "Async Shell Command..." project-async-shell-command :help "Invoke a shell command in project root asynchronously in background")) @@ -1814,7 +1814,7 @@ menu-bar-project-menu (bindings--define-key menu [project-compile] '(menu-item "Compile..." project-compile :help "Invoke compiler or Make for current project, view errors")) (bindings--define-key menu [separator-project-programs] menu-bar-separator) (bindings--define-key menu [project-switch-project] '(menu-item "Switch Project..." project-switch-project :help "Switch to another project and then run a command")) - (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir..." project-vc-dir :help "Show the VC status of the project repository")) + (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir" project-vc-dir :help "Show the VC status of the project repository")) (bindings--define-key menu [project-dired] '(menu-item "Open Project Root" project-dired :help "Read the root directory of the current project, to operate on its files")) (bindings--define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open existing directory that belongs to current project")) (bindings--define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open existing file that belongs to current project or its external roots")) commit 37130fd500fbf78ff0d0037aa6275f0f70a415dd Author: Stefan Monnier Date: Tue Oct 3 10:10:57 2023 -0400 regex.c: Fix recent regression with mutually_exclusive_p The new analysis code ended up increasing the scope of an optimization a bit too far. Reign it in. * src/regex-emacs.c (struct mutexcl_data): Add `unconstrained` field. (mutually_exclusive_one): Use and set it. (mutually_exclusive_p): Initialize it. * test/src/regex-emacs-tests.el (regexp-tests-backtrack-optimization): Add test. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index ffb8891d3a6..95c3366652d 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -3899,6 +3899,7 @@ mutually_exclusive_charset (struct re_pattern_buffer *bufp, re_char *p1, struct mutexcl_data { struct re_pattern_buffer *bufp; re_char *p1; + bool unconstrained; }; static bool @@ -3907,7 +3908,32 @@ mutually_exclusive_one (re_char *p2, void *arg) struct mutexcl_data *data = arg; switch (*p2) { + case succeed: + /* If `p1` matches, `succeed` can still match, so we should return + `false`. *BUT* when N iterations of `p1` and N+1 iterations of `p1` + match, the `succeed` that comes after N+1 always takes precedence + over the one after N because we always prefer a longer match, so + the succeed after N can actually be replaced by a "fail" without + changing the end result. + In this sense, "if `p1` matches, `succeed` can't match". + So we can return `true`. + *BUT* this only holds if we're sure that the N+1 will indeed succeed, + so we need to make sure there is no other matching operator between + the exit of the iteration and the `succeed`. */ + return data->unconstrained; + +/* Remember that there may be an empty matching operator on the way. + If we return true, this is the "end" of this control flow path, + so it can't get in the way of a subsequent `succeed. */ +#define RETURN_CONSTRAIN(v) \ + { bool tmp = (v); \ + if (!tmp) \ + data->unconstrained = false; \ + return tmp; \ + } + case endline: + RETURN_CONSTRAIN (mutually_exclusive_exactn (data->bufp, data->p1, p2)); case exactn: return mutually_exclusive_exactn (data->bufp, data->p1, p2); case charset: @@ -3945,18 +3971,17 @@ mutually_exclusive_one (re_char *p2, void *arg) return (*data->p1 == categoryspec && data->p1[1] == p2[1]); case endbuf: - case succeed: return true; case wordbeg: - return (*data->p1 == notsyntaxspec && data->p1[1] == Sword); + RETURN_CONSTRAIN (*data->p1 == notsyntaxspec && data->p1[1] == Sword); case wordend: - return (*data->p1 == syntaxspec && data->p1[1] == Sword); + RETURN_CONSTRAIN (*data->p1 == syntaxspec && data->p1[1] == Sword); case symbeg: - return (*data->p1 == notsyntaxspec - && (data->p1[1] == Ssymbol || data->p1[1] == Sword)); + RETURN_CONSTRAIN (*data->p1 == notsyntaxspec + && (data->p1[1] == Ssymbol || data->p1[1] == Sword)); case symend: - return (*data->p1 == syntaxspec - && (data->p1[1] == Ssymbol || data->p1[1] == Sword)); + RETURN_CONSTRAIN (*data->p1 == syntaxspec + && (data->p1[1] == Ssymbol || data->p1[1] == Sword)); case duplicate: /* At this point, we know nothing about what this can match, sadly. */ @@ -3976,7 +4001,7 @@ mutually_exclusive_one (re_char *p2, void *arg) mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, re_char *p2) { - struct mutexcl_data data = { bufp, p1 }; + struct mutexcl_data data = { bufp, p1, true }; return forall_firstchar (bufp, p2, NULL, mutually_exclusive_one, &data); } diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el index 621e4dbe2c0..615d905e140 100644 --- a/test/src/regex-emacs-tests.el +++ b/test/src/regex-emacs-tests.el @@ -555,10 +555,10 @@ regex-tests-PCRE (defconst regex-tests-PTESTS-whitelist [ - ;; emacs doesn't see DEL (0x7f) as a [:cntrl:] character + ;; Emacs doesn't see DEL (0x7f) as a [:cntrl:] character 138 - ;; emacs doesn't barf on weird ranges such as [b-a], but simply + ;; Emacs doesn't barf on weird ranges such as [b-a], but simply ;; fails to match 168 ] @@ -872,14 +872,14 @@ regexp-atomic-failure (should (equal (string-match "\\`\\(?:ab\\)*\\'" "a") nil)) (should (equal (string-match "\\`a\\{2\\}*\\'" "a") nil))) -(ert-deftest regexp-tests-backtrack-optimization () ;bug#61514 +(ert-deftest regexp-tests-backtrack-optimization () ;; Make sure we don't use up the regexp stack needlessly. (with-current-buffer (get-buffer-create "*bug*") (erase-buffer) (insert (make-string 1000000 ?x) "=") (goto-char (point-min)) ;; Make sure we do perform the optimization (if we don't, the - ;; below will burp with regexp-stack-overflow). + ;; below will burp with regexp-stack-overflow). ;bug#61514 (should (looking-at "x*=*")) (should (looking-at "x*\\(=\\|:\\)")) (should (looking-at "x*\\(=\\|:\\)*")) @@ -908,6 +908,7 @@ regexp-tests-backtrack-optimization (should (eq 0 (string-match "\\(ca*\\|ab\\)+d" "cabd"))) (should (string-match "\\(aa*\\|b\\)*c" "ababc")) (should (string-match " \\sw*\\bfoo" " foo")) + (should (string-match ".*\\>" "hello ")) )) (ert-deftest regexp-tests-zero-width-assertion-repetition () commit 2065ab5562e87bc5f4900f60459597356afe22df Author: Mauro Aranda Date: Tue Oct 3 08:03:47 2023 -0300 Fix defcustoms in timeclock.el * lisp/calendar/timeclock.el (timeclock-get-project-function) (timeclock-get-reason-function): Fix :type to allow nil. (Bug#66320) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 0cd03c15881..7606805a99b 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -100,19 +100,21 @@ timeclock-relative previous days. This only affects the timeclock mode line display." :type 'boolean) -(defcustom timeclock-get-project-function 'timeclock-ask-for-project +(defcustom timeclock-get-project-function #'timeclock-ask-for-project "The function used to determine the name of the current project. When clocking in, and no project is specified, this function will be called to determine what is the current project to be worked on. If this variable is nil, no questions will be asked." - :type 'function) + :type '(choice (const :tag "Don't ask" nil) + function)) -(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason +(defcustom timeclock-get-reason-function #'timeclock-ask-for-reason "A function used to determine the reason for clocking out. When clocking out, and no reason is specified, this function will be called to determine what is the reason. If this variable is nil, no questions will be asked." - :type 'function) + :type '(choice (const :tag "Don't ask" nil) + function)) (defcustom timeclock-get-workday-function nil "A function used to determine the length of today's workday. commit 849de5aa1a42cae6ae1504804acf0c7fb8b13860 Author: Alan Mackenzie Date: Tue Oct 3 10:22:26 2023 +0000 Correct the `cond' forms in cl-print-string-with-limit In this function, calling with limit bound to t will cause an error in any of the cond forms which set print-length, etc. Correct them! * lisp/emacs-lisp/cl-print.el (cl-print-string-with-limit): Amend the doc string. In the cond forms in the bindings for print-length, etc., test the value t first. Amend those for print-length and print-level also to test for a zero value of limit. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index d0bfcab4082..aa495b161d6 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -549,14 +549,14 @@ cl-prin1-to-string (defun cl-print-to-string-with-limit (print-function value limit) "Return a string containing a printed representation of VALUE. Attempt to get the length of the returned string under LIMIT -characters with appropriate settings of `print-level' and -`print-length.' Use PRINT-FUNCTION to print, which should take -the arguments VALUE and STREAM and which should respect -`print-length' and `print-level'. LIMIT may be nil or zero in -which case PRINT-FUNCTION will be called with `print-level' and -`print-length' bound to nil, and it can also be t in which case -PRINT-FUNCTION will be called with the current values of `print-level' -and `print-length'. +characters with appropriate settings of `print-level', +`print-length.', and `cl-print-string-length'. Use +PRINT-FUNCTION to print, which should take the arguments VALUE +and STREAM and which should respect `print-length', +`print-level', and `cl-print-string-length'. LIMIT may be nil or +zero in which case PRINT-FUNCTION will be called with these +settings bound to nil, and it can also be t in which case +PRINT-FUNCTION will be called with their current values. Use this function with `cl-prin1' to print an object, abbreviating it with ellipses to fit within a size limit." @@ -565,17 +565,17 @@ cl-print-to-string-with-limit ;; limited, if you increase print-level here, add more depth in ;; call_debugger (bug#31919). (let* ((print-length (cond - ((null limit) nil) ((eq limit t) print-length) + ((or (null limit) (zerop limit)) nil) (t (min limit 50)))) (print-level (cond - ((null limit) nil) ((eq limit t) print-level) + ((or (null limit) (zerop limit)) nil) (t (min 8 (truncate (log limit)))))) (cl-print-string-length (cond - ((or (null limit) (zerop limit)) nil) ((eq limit t) cl-print-string-length) + ((or (null limit) (zerop limit)) nil) (t (max 0 (- limit 3))))) (delta-length (when (natnump limit) (max 1 (truncate (/ print-length print-level)))))) commit 21c81f49e7b8347a7f8bc52024b53ec1a13108d3 Author: Michael Albinus Date: Tue Oct 3 10:02:52 2023 +0200 Ensure, that Tramp uses GNU style emulation when calling ls-lisp * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Reorganize. * lisp/net/tramp.el (ls-lisp-dirs-first, ls-lisp-emulation) (ls-lisp-ignore-case, ls-lisp-verbosity): Declare. (tramp-handle-insert-directory): Bind `ls-lisp-*' options. Call `ls-lisp-set-options'. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 07f1cf24542..95c27626166 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2637,15 +2637,15 @@ tramp-sh-handle-dired-compress-file (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." - (unless switches (setq switches "")) - ;; Check, whether directory is accessible. - (unless wildcard - (access-file filename "Reading directory")) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (if (and (featurep 'ls-lisp) - (not ls-lisp-use-insert-directory-program)) - (tramp-handle-insert-directory - filename switches wildcard full-directory-p) + (if (and (featurep 'ls-lisp) + (not ls-lisp-use-insert-directory-program)) + (tramp-handle-insert-directory + filename switches wildcard full-directory-p) + (unless switches (setq switches "")) + ;; Check, whether directory is accessible. + (unless wildcard + (access-file filename "Reading directory")) + (with-parsed-tramp-file-name (expand-file-name filename) nil (let ((dired (tramp-get-ls-command-with v "--dired"))) (when (stringp switches) (setq switches (split-string switches))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index aca2ebb8e8a..bff9a010c3b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -67,7 +67,11 @@ (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) @@ -4159,7 +4163,7 @@ tramp-handle-find-backup-file-name (tramp-error v 'file-error "Unsafe backup file name")))))) (defun tramp-handle-insert-directory - (filename switches &optional wildcard full-directory-p) + (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." (require 'ls-lisp) (unless switches (setq switches "")) @@ -4172,8 +4176,14 @@ tramp-handle-insert-directory (access-file filename "Reading directory")) (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename) - (let (ls-lisp-use-insert-directory-program start) - ;; Silence byte compiler. + ;; We bind `ls-lisp-emulation' to nil (which is GNU). + ;; `ls-lisp-set-options' modifies `ls-lisp-ignore-case', + ;; `ls-lisp-dirs-first' and `ls-lisp-verbosity', so we bind them + ;; as well. We don't want to use `insert-directory-program'. + (let (ls-lisp-emulation ls-lisp-ignore-case ls-lisp-dirs-first + ls-lisp-verbosity ls-lisp-use-insert-directory-program start) + ;; Set proper options based on `ls-lisp-emulation'. + (tramp-compat-funcall 'ls-lisp-set-options) (tramp-run-real-handler #'insert-directory (list filename switches wildcard full-directory-p)) commit 498d31e9f0549189f4e9b140549419dd4e462575 Author: Jim Porter Date: Sat Sep 23 11:36:11 2023 -0700 Support Eshell iterative evaluation in the background This really just generalizes Eshell's previous support for iterative evaluation of a single current command to a list of multiple commands, of which at most one can be in the foreground (bug#66066). * lisp/eshell/esh-cmd.el (eshell-last-async-procs) (eshell-current-command): Make obsolete in favor of... (eshell-foreground-command): ... this (eshell-background-commands): New variable. (eshell-interactive-process-p): Make obsolete. (eshell-head-process, eshell-tail-process): Use 'eshell-foreground-command'. (eshell-cmd-initialize): Initialize new variables. (eshell-add-command, eshell-remove-command) (eshell-commands-for-process): New functions. (eshell-parse-command): Make 'eshell-do-subjob' the outermost call. (eshell-do-subjob): Call 'eshell-resume-eval' to split this command off from its parent forms. (eshell-eval-command): Use 'eshell-add-command'. (eshell-resume-command): Use 'eshell-commands-for-process'. (eshell-resume-eval): Take a COMMAND argument. Return ':eshell-background' form for deferred background commands. (eshell-do-eval): Remove check for 'eshell-current-subjob-p'. This is handled differently now. * lisp/eshell/eshell.el (eshell-command): Wait for all processes to exit when running synchronously. * lisp/eshell/esh-mode.el (eshell-intercept-commands) (eshell-watch-for-password-prompt): * lisp/eshell/em-cmpl.el (eshell-complete-parse-arguments): * lisp/eshell/em-smart.el (eshell-smart-display-move): Use 'eshell-foreground-command'. * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/background/simple-command) (esh-cmd-test/background/subcommand): New tests. (esh-cmd-test/throw): Use 'eshell-foreground-command'. * test/lisp/eshell/eshell-tests.el (eshell-test/queue-input): Use 'eshell-foreground-command'. * test/lisp/eshell/em-script-tests.el (em-script-test/source-script/background): Make the test script more complex. * test/lisp/eshell/eshell-tests.el (eshell-test/eshell-command/pipeline-wait): New test. * doc/misc/eshell.texi (Bugs and ideas): Remove implemented feature. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 8b3eb72aa66..cc94f610615 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -2568,8 +2568,6 @@ Bugs and ideas @samp{$=[REGEXP]}. It indexes into the directory ring. @end table -@item Eshell scripts can't execute in the background - @item Support zsh's ``Parameter Expansion'' syntax, i.e., @samp{$@{@var{name}:-@var{val}@}} @item Create a mode @code{eshell-browse} diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 25dccbd695c..61f1237b907 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -343,7 +343,7 @@ eshell-external-command-p (defun eshell-complete-parse-arguments () "Parse the command line arguments for `pcomplete-argument'." (when (and eshell-no-completion-during-jobs - (eshell-interactive-process-p)) + eshell-foreground-command) (eshell--pcomplete-insert-tab)) (let ((end (point-marker)) (begin (save-excursion (beginning-of-line) (point))) diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index d5002a59d14..4c39a991ec6 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -294,7 +294,7 @@ eshell-smart-display-move ((eq this-command 'self-insert-command) (if (eq last-command-event ? ) (if (and eshell-smart-space-goes-to-end - eshell-current-command) + eshell-foreground-command) (if (not (pos-visible-in-window-p (point-max))) (setq this-command 'scroll-up) (setq this-command 'eshell-smart-goto-end)) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index fc7d54a758d..990d2ca1122 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -263,7 +263,24 @@ eshell-ensure-newline-p ;;; Internal Variables: -(defvar eshell-current-command nil) +;; These variables have been merged into `eshell-foreground-command'. +;; Outside of this file, the most-common use for them is to check +;; whether they're nil. +(define-obsolete-variable-alias 'eshell-last-async-procs + 'eshell-foreground-command "30.1") +(define-obsolete-variable-alias 'eshell-current-command + 'eshell-foreground-command "30.1") + +(defvar eshell-foreground-command nil + "The currently-running foreground command, if any. +This is a list of the form (FORM PROCESSES). FORM is the Eshell +command form. PROCESSES is a list of processes that deferred the +command.") +(defvar eshell-background-commands nil + "A list of currently-running deferred commands. +Each element is of the form (FORM PROCESSES), as with +`eshell-foreground-command' (which see).") + (defvar eshell-command-name nil) (defvar eshell-command-arguments nil) (defvar eshell-in-pipeline-p nil @@ -273,11 +290,6 @@ eshell-in-pipeline-p (defvar eshell-in-subcommand-p nil) (defvar eshell-last-arguments nil) (defvar eshell-last-command-name nil) -(defvar eshell-last-async-procs nil - "The currently-running foreground process(es). -When executing a pipeline, this is a list of all the pipeline's -processes, with the first usually reading from stdin and last -usually writing to stdout.") (defvar eshell-allow-commands t "If non-nil, allow evaluating command forms (including Lisp forms). @@ -294,29 +306,30 @@ 'eshell-commands-forbidden (defsubst eshell-interactive-process-p () "Return non-nil if there is a currently running command process." - eshell-last-async-procs) + (declare (obsolete 'eshell-foreground-command "30.1")) + eshell-foreground-command) (defsubst eshell-head-process () "Return the currently running process at the head of any pipeline. This only returns external (non-Lisp) processes." - (car eshell-last-async-procs)) + (caadr eshell-foreground-command)) (defsubst eshell-tail-process () "Return the currently running process at the tail of any pipeline. This only returns external (non-Lisp) processes." - (car (last eshell-last-async-procs))) + (car (last (cadr eshell-foreground-command)))) (define-obsolete-function-alias 'eshell-interactive-process 'eshell-tail-process "29.1") (defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the Eshell command processing module." - (setq-local eshell-current-command nil) + (setq-local eshell-foreground-command nil) + (setq-local eshell-background-commands nil) (setq-local eshell-command-name nil) (setq-local eshell-command-arguments nil) (setq-local eshell-last-arguments nil) (setq-local eshell-last-command-name nil) - (setq-local eshell-last-async-procs nil) (add-hook 'eshell-kill-hook #'eshell-resume-command nil t) (add-hook 'eshell-parse-argument-hook @@ -337,6 +350,47 @@ eshell-complete-lisp-symbols (throw 'pcomplete-completions (all-completions pcomplete-stub obarray 'boundp))))) +;; Current command management + +(defun eshell-add-command (form &optional background) + "Add a command FORM to our list of known commands and return the new entry. +If non-nil, BACKGROUND indicates that this is a command running +in the background. The result is a command entry in the +form (BACKGROUND FORM PROCESSES), where PROCESSES is initially +nil." + (cons (when background 'background) + (if background + (car (push (list form nil) eshell-background-commands)) + (cl-assert (null eshell-foreground-command)) + (setq eshell-foreground-command (list form nil))))) + +(defun eshell-remove-command (command) + "Remove COMMAND from our list of known commands. +COMMAND should be a list of the form (BACKGROUND FORM PROCESSES), +as returned by `eshell-add-command' (which see)." + (let ((background (car command)) + (entry (cdr command))) + (if background + (setq eshell-background-commands + (delq entry eshell-background-commands)) + (cl-assert (eq eshell-foreground-command entry)) + (setq eshell-foreground-command nil)))) + +(defun eshell-commands-for-process (process) + "Return all commands associated with a PROCESS. +Each element will have the form (BACKGROUND FORM PROCESSES), as +returned by `eshell-add-command' (which see). + +Usually, there should only be one element in this list, but it's +theoretically possible to have more than one associated command +for a given process." + (nconc (when (memq process (cadr eshell-foreground-command)) + (list (cons nil eshell-foreground-command))) + (seq-keep (lambda (cmd) + (when (memq process (cadr cmd)) + (cons 'background cmd))) + eshell-background-commands))) + ;; Command parsing (defsubst eshell--region-p (object) @@ -407,8 +461,6 @@ eshell-parse-command (lambda (cmd) (let ((sep (pop sep-terms))) (setq cmd (eshell-parse-pipeline cmd)) - (when (equal sep "&") - (setq cmd `(eshell-do-subjob (cons :eshell-background ,cmd)))) (unless eshell-in-pipeline-p (setq cmd `(eshell-trap-errors ,cmd))) ;; Copy I/O handles so each full statement can manipulate @@ -416,6 +468,8 @@ eshell-parse-command ;; command in the list; we won't use the originals again ;; anyway. (setq cmd `(eshell-with-copied-handles ,cmd ,(not sep))) + (when (equal sep "&") + (setq cmd `(eshell-do-subjob ,cmd))) cmd)) sub-chains))) (if toplevel @@ -740,13 +794,13 @@ eshell-separate-commands (defmacro eshell-do-subjob (object) "Evaluate a command OBJECT as a subjob. -We indicate that the process was run in the background by returning it -ensconced in a list." +We indicate that the process was run in the background by +returning it as (:eshell-background . PROCESSES)." `(let ((eshell-current-subjob-p t) ;; Print subjob messages. This could have been cleared ;; (e.g. by `eshell-source-file', which see). (eshell-subjob-messages t)) - ,object)) + (eshell-resume-eval (eshell-add-command ',object 'background)))) (defmacro eshell-commands (object &optional silent) "Place a valid set of handles, and context, around command OBJECT." @@ -980,12 +1034,12 @@ eshell-eval-command COMMAND, if any. If COMMAND is a background command, return the process(es) in a cons cell like: - (:eshell-background . PROCESS)" - (if eshell-current-command + (:eshell-background . PROCESSES)" + (if eshell-foreground-command (progn ;; We can just stick the new command at the end of the current ;; one, and everything will happen as it should. - (setcdr (last (cdr eshell-current-command)) + (setcdr (last (cdar eshell-foreground-command)) (list `(let ((here (and (eobp) (point)))) ,(and input `(insert-and-inherit ,(concat input "\n"))) @@ -994,56 +1048,61 @@ eshell-eval-command (eshell-do-eval ',command)))) (eshell-debug-command 'form "enqueued command form for %S\n\n%s" - (or input "") (eshell-stringify eshell-current-command))) + (or input "") + (eshell-stringify (car eshell-foreground-command)))) (eshell-debug-command-start input) - (setq eshell-current-command command) (let* (result (delim (catch 'eshell-incomplete - (ignore (setq result (eshell-resume-eval)))))) + (ignore (setq result (eshell-resume-eval + (eshell-add-command command))))))) (when delim (error "Unmatched delimiter: %S" delim)) result))) (defun eshell-resume-command (proc status) - "Resume the current command when a pipeline ends." - (when (and proc - ;; Make sure PROC is one of our foreground processes and - ;; that all of those processes are now dead. - (member proc eshell-last-async-procs) - (not (seq-some #'eshell-process-active-p eshell-last-async-procs))) - (if (and ;; Check STATUS to determine whether we want to resume or - ;; abort the command. - (stringp status) - (not (string= "stopped" status)) - (not (string-match eshell-reset-signals status))) - (eshell-resume-eval) - (setq eshell-last-async-procs nil) - (setq eshell-current-command nil) - (declare-function eshell-reset "esh-mode" (&optional no-hooks)) - (eshell-reset)))) - -(defun eshell-resume-eval () - "Destructively evaluate a form which may need to be deferred." - (setq eshell-last-async-procs nil) - (when eshell-current-command - (eshell-condition-case err - (let (retval procs) - (unwind-protect - (progn - (setq procs (catch 'eshell-defer - (ignore (setq retval - (eshell-do-eval - eshell-current-command))))) - (when retval - (cadr retval))) - (setq eshell-last-async-procs procs) + "Resume the current command when a pipeline ends. +PROC is the process that invoked this from its sentinel, and +STATUS is its status." + (when proc + (dolist (command (eshell-commands-for-process proc)) + (unless (seq-some #'eshell-process-active-p (nth 2 command)) + (setf (nth 2 command) nil) ; Clear processes from command. + (if (and ;; Check STATUS to determine whether we want to resume or + ;; abort the command. + (stringp status) + (not (string= "stopped" status)) + (not (string-match eshell-reset-signals status))) + (eshell-resume-eval command) + (eshell-remove-command command) + (declare-function eshell-reset "esh-mode" (&optional no-hooks)) + (eshell-reset)))))) + +(defun eshell-resume-eval (command) + "Destructively evaluate a COMMAND which may need to be deferred. +COMMAND is a command entry of the form (BACKGROUND FORM +PROCESSES) (see `eshell-add-command'). + +Return the result of COMMAND's FORM if it wasn't deferred. If +BACKGROUND is non-nil and Eshell defers COMMAND, return a list of +the form (:eshell-background . PROCESSES)." + (eshell-condition-case err + (let (retval procs) + (unwind-protect + (progn + (setq procs + (catch 'eshell-defer + (ignore (setq retval (eshell-do-eval (cadr command)))))) + (cond + (retval (cadr retval)) + ((car command) (cons :eshell-background procs)))) + (if procs + (setf (nth 2 command) procs) ;; If we didn't defer this command, clear it out. This ;; applies both when the command has finished normally, ;; and when a signal or thrown value causes us to unwind. - (unless procs - (setq eshell-current-command nil)))) - (error - (error (error-message-string err)))))) + (eshell-remove-command command)))) + (error + (error (error-message-string err))))) (defmacro eshell-manipulate (form tag &rest body) "Manipulate a command FORM with BODY, using TAG as a debug identifier." @@ -1272,7 +1331,6 @@ eshell-do-eval (setcdr form (cdr new-form))) (eshell-do-eval form synchronous-p)) (if-let (((memq (car form) eshell-deferrable-commands)) - ((not eshell-current-subjob-p)) (procs (eshell-make-process-list result))) (if synchronous-p (apply #'eshell/wait procs) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 0c381dbb86a..2b560afb92c 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -453,7 +453,7 @@ eshell-self-insert-command last-command-event)))) (defun eshell-intercept-commands () - (when (and (eshell-interactive-process-p) + (when (and eshell-foreground-command (not (and (integerp last-input-event) (memq last-input-event '(?\C-x ?\C-c))))) (let ((possible-events (where-is-internal this-command)) @@ -967,7 +967,7 @@ eshell-watch-for-password-prompt `eshell-password-prompt-regexp'. This function could be in the list `eshell-output-filter-functions'." - (when (eshell-interactive-process-p) + (when eshell-foreground-command (save-excursion (let ((case-fold-search t)) (goto-char eshell-last-output-block-begin) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index a3f80f453eb..8765ba499a1 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -315,9 +315,8 @@ eshell-command ;; make the output as attractive as possible, with no ;; extraneous newlines (when intr - (if (eshell-interactive-process-p) - (eshell-wait-for-process (eshell-tail-process))) - (cl-assert (not (eshell-interactive-process-p))) + (apply #'eshell-wait-for-process (cadr eshell-foreground-command)) + (cl-assert (not eshell-foreground-command)) (goto-char (point-max)) (while (and (bolp) (not (bobp))) (delete-char -1))) diff --git a/test/lisp/eshell/em-script-tests.el b/test/lisp/eshell/em-script-tests.el index 191755dcc3e..02e4125d827 100644 --- a/test/lisp/eshell/em-script-tests.el +++ b/test/lisp/eshell/em-script-tests.el @@ -67,14 +67,14 @@ em-script-test/source-script/background "Test sourcing a script in the background." (skip-unless (executable-find "echo")) (ert-with-temp-file temp-file - :text "*echo hi" + :text "*echo hi\nif {[ foo = foo ]} {*echo bye}" (eshell-with-temp-buffer bufname "old" (with-temp-eshell (eshell-match-command-output (format "source %s > #<%s> &" temp-file bufname) "\\`\\'") (eshell-wait-for-subprocess t)) - (should (equal (buffer-string) "hi\n"))))) + (should (equal (buffer-string) "hi\nbye\n"))))) (ert-deftest em-script-test/source-script/arg-vars () "Test sourcing script with $0, $1, ... variables." diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 643038f89ff..e0783b26ad6 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -103,6 +103,32 @@ esh-cmd-test/let-rebinds-after-defer "}") "value\nexternal\nvalue\n"))) + +;; Background command invocation + +(ert-deftest esh-cmd-test/background/simple-command () + "Test invocation with a simple background command." + (skip-unless (executable-find "echo")) + (eshell-with-temp-buffer bufname "" + (with-temp-eshell + (eshell-match-command-output + (format "*echo hi > #<%s> &" bufname) + (rx "[echo" (? ".exe") "] " (+ digit) "\n")) + (eshell-wait-for-subprocess t)) + (should (equal (buffer-string) "hi\n")))) + +(ert-deftest esh-cmd-test/background/subcommand () + "Test invocation with a background command containing subcommands." + (skip-unless (and (executable-find "echo") + (executable-find "rev"))) + (eshell-with-temp-buffer bufname "" + (with-temp-eshell + (eshell-match-command-output + (format "*echo ${*echo hello | rev} > #<%s> &" bufname) + (rx "[echo" (? ".exe") "] " (+ digit) "\n")) + (eshell-wait-for-subprocess t)) + (should (equal (buffer-string) "olleh\n")))) + ;; Lisp forms @@ -453,8 +479,7 @@ esh-cmd-test/throw "echo hi; (throw 'tag 42); echo bye")) 42)) (should (eshell-match-output "\\`hi\n\\'")) - (should-not eshell-current-command) - (should-not eshell-last-async-procs) + (should-not eshell-foreground-command) ;; Make sure we can call another command after throwing. (eshell-match-command-output "echo again" "\\`again\n"))) diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 25c8cfd389c..b02e5fca592 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -58,6 +58,18 @@ eshell-test/eshell-command/pipeline (eshell-command "*echo hi | *cat" t) (should (equal (buffer-string) "hi\n")))))) +(ert-deftest eshell-test/eshell-command/pipeline-wait () + "Check that `eshell-command' waits for all its processes before returning." + (skip-unless (and (executable-find "echo") + (executable-find "sh") + (executable-find "rev"))) + (ert-with-temp-directory eshell-directory-name + (let ((eshell-history-file-name nil)) + (with-temp-buffer + (eshell-command + "*echo hello | sh -c 'sleep 1; rev' 1>&2 | *echo goodbye" t) + (should (equal (buffer-string) "goodbye\nolleh\n")))))) + (ert-deftest eshell-test/eshell-command/background () "Test that `eshell-command' works for background commands." (skip-unless (executable-find "echo")) @@ -132,7 +144,7 @@ eshell-test/queue-input (eshell-insert-command "sleep 1; echo slept") (eshell-insert-command "echo alpha" #'eshell-queue-input) (let ((start (marker-position (eshell-beginning-of-output)))) - (eshell-wait-for (lambda () (not eshell-current-command))) + (eshell-wait-for (lambda () (not eshell-foreground-command))) (should (string-match "^slept\n.*echo alpha\nalpha\n$" (buffer-substring-no-properties start (eshell-end-of-output))))))) commit 8f2cfe15a72a0c440909faa50a9c436931dcf85e Author: Jim Porter Date: Fri Sep 22 23:03:45 2023 -0700 Don't print subjob messages when running an Eshell script in the background * lisp/eshell/esh-proc.el (eshell-subjob-messages): New variable... (eshell-record-process-object) (eshell-remove-process-entry): ... check it. * lisp/eshell/em-script.el (eshell-source-file): Set 'eshell-subjob-messages' to nil. * lisp/eshell/esh-cmd.el (eshell-do-subjob): Set 'eshell-subjob-messages' to t. * test/lisp/eshell/em-script-tests.el (em-script-test/source-script/background): New test. diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index 9f6f720b8b0..3a4c315ad15 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -94,7 +94,12 @@ eshell-source-file (setq cmd `(eshell-as-subcommand ,cmd))) (throw 'eshell-replace-command `(let ((eshell-command-name ',file) - (eshell-command-arguments ',args)) + (eshell-command-arguments ',args) + ;; Don't print subjob messages by default. + ;; Otherwise, if this function was called as a + ;; subjob, then *all* commands in the script would + ;; print start/stop messages. + (eshell-subjob-messages nil)) ,cmd)))) (defun eshell/source (&rest args) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 1d828bd7f82..fc7d54a758d 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -742,7 +742,10 @@ eshell-do-subjob "Evaluate a command OBJECT as a subjob. We indicate that the process was run in the background by returning it ensconced in a list." - `(let ((eshell-current-subjob-p t)) + `(let ((eshell-current-subjob-p t) + ;; Print subjob messages. This could have been cleared + ;; (e.g. by `eshell-source-file', which see). + (eshell-subjob-messages t)) ,object)) (defmacro eshell-commands (object &optional silent) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index d15e1e7d09b..126c7d0f26e 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -100,6 +100,8 @@ eshell-kill-hook (defvar eshell-supports-asynchronous-processes (fboundp 'make-process) "Non-nil if Eshell can create asynchronous processes.") +(defvar eshell-subjob-messages t + "Non-nil if we should print process start/end messages for subjobs.") (defvar eshell-current-subjob-p nil) (defvar eshell-process-list nil @@ -243,8 +245,9 @@ eshell-insert-process (defsubst eshell-record-process-object (object) "Record OBJECT as now running." - (when (and (eshell-processp object) - eshell-current-subjob-p) + (when (and eshell-subjob-messages + eshell-current-subjob-p + (eshell-processp object)) (require 'esh-mode) (declare-function eshell-interactive-print "esh-mode" (string)) (eshell-interactive-print @@ -253,11 +256,12 @@ eshell-record-process-object (defun eshell-remove-process-entry (entry) "Record the process ENTRY as fully completed." - (if (and (eshell-processp (car entry)) - (cdr entry) - eshell-done-messages-in-minibuffer) - (message "[%s]+ Done %s" (process-name (car entry)) - (process-command (car entry)))) + (when (and eshell-subjob-messages + eshell-done-messages-in-minibuffer + (eshell-processp (car entry)) + (cdr entry)) + (message "[%s]+ Done %s" (process-name (car entry)) + (process-command (car entry)))) (setq eshell-process-list (delq entry eshell-process-list))) diff --git a/test/lisp/eshell/em-script-tests.el b/test/lisp/eshell/em-script-tests.el index 74328844778..191755dcc3e 100644 --- a/test/lisp/eshell/em-script-tests.el +++ b/test/lisp/eshell/em-script-tests.el @@ -63,6 +63,19 @@ em-script-test/source-script/redirect/dev-null "\\`\\'")) (should (equal (buffer-string) "hibye"))))) +(ert-deftest em-script-test/source-script/background () + "Test sourcing a script in the background." + (skip-unless (executable-find "echo")) + (ert-with-temp-file temp-file + :text "*echo hi" + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "source %s > #<%s> &" temp-file bufname) + "\\`\\'") + (eshell-wait-for-subprocess t)) + (should (equal (buffer-string) "hi\n"))))) + (ert-deftest em-script-test/source-script/arg-vars () "Test sourcing script with $0, $1, ... variables." (ert-with-temp-file temp-file :text "printnl $0 \"$1 $2\"" commit 3f0461e5397ae7b5337c83e3a12f8d3bc6996133 Merge: 1ad2d2f77c7 3979f83cd60 Author: Po Lu Date: Tue Oct 3 08:59:31 2023 +0800 Merge remote-tracking branch 'savannah/master' into master-android-1 commit 1ad2d2f77c742594768e777c36a2eef22f747722 Author: Po Lu Date: Tue Oct 3 08:55:57 2023 +0800 Update Android port * src/androidvfs.c (android_afs_open, android_asset_fstat): Return proper mtime within file descriptors incorporating asset data and within android_asset_fstat. * src/xterm.c (handle_one_xevent) : Verify presence of a quit keysym prior to registering it. diff --git a/src/androidvfs.c b/src/androidvfs.c index d099e4d636c..0e5bbf8a13e 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -1921,6 +1921,21 @@ android_afs_open (struct android_vnode *vnode, int flags, /* Size of the file. */ info->statb.st_size = AAsset_getLength (asset); + /* If the installation date can be ascertained, return that as + the file's modification time. */ + + if (timespec_valid_p (emacs_installation_time)) + { +#ifdef STAT_TIMESPEC + STAT_TIMESPEC (&info->statb, st_mtim) = emacs_installation_time; +#else /* !STAT_TIMESPEC */ + /* Headers supplied by the NDK r10b contain a `struct stat' + without POSIX fields for nano-second timestamps. */ + info->statb.st_mtime = emacs_installation_time.tv_sec; + info->statb.st_mtime_nsec = emacs_installation_time.tv_nsec; +#endif /* STAT_TIMESPEC */ + } + /* Chain info onto afs_file_descriptors. */ afs_file_descriptors = info; @@ -7365,6 +7380,21 @@ android_asset_fstat (struct android_fd_or_asset asset, statb->st_uid = 0; statb->st_gid = 0; + /* If the installation date can be ascertained, return that as the + file's modification time. */ + + if (timespec_valid_p (emacs_installation_time)) + { +#ifdef STAT_TIMESPEC + STAT_TIMESPEC (statb, st_mtim) = emacs_installation_time; +#else /* !STAT_TIMESPEC */ + /* Headers supplied by the NDK r10b contain a `struct stat' + without POSIX fields for nano-second timestamps. */ + statb->st_mtime = emacs_installation_time.tv_sec; + statb->st_mtime_nsec = emacs_installation_time.tv_nsec; +#endif /* STAT_TIMESPEC */ + } + /* Size of the file. */ statb->st_size = AAsset_getLength (asset.asset); return 0; diff --git a/src/xterm.c b/src/xterm.c index 18a6c51efb3..517bdf57aab 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -20297,20 +20297,23 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* See if keysym should make Emacs quit. */ - if (keysym == dpyinfo->quit_keysym - && (xkey.time - dpyinfo->quit_keysym_time - <= 350)) + if (dpyinfo->quit_keysym) { - Vquit_flag = Qt; - goto done_keysym; - } + if (keysym == dpyinfo->quit_keysym + && (xkey.time - dpyinfo->quit_keysym_time + <= 350)) + { + Vquit_flag = Qt; + goto done_keysym; + } - if (keysym == dpyinfo->quit_keysym) - { - /* Otherwise, set the last time that keysym was - pressed. */ - dpyinfo->quit_keysym_time = xkey.time; - goto done_keysym; + if (keysym == dpyinfo->quit_keysym) + { + /* Otherwise, set the last time that keysym was + pressed. */ + dpyinfo->quit_keysym_time = xkey.time; + goto done_keysym; + } } /* If not using XIM/XIC, and a compose sequence is in progress, @@ -24227,20 +24230,23 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* See if keysym should make Emacs quit. */ - if (keysym == dpyinfo->quit_keysym - && (xev->time - dpyinfo->quit_keysym_time - <= 350)) + if (dpyinfo->quit_keysym) { - Vquit_flag = Qt; - goto xi_done_keysym; - } + if (keysym == dpyinfo->quit_keysym + && (xev->time - dpyinfo->quit_keysym_time + <= 350)) + { + Vquit_flag = Qt; + goto xi_done_keysym; + } - if (keysym == dpyinfo->quit_keysym) - { - /* Otherwise, set the last time that keysym was - pressed. */ - dpyinfo->quit_keysym_time = xev->time; - goto xi_done_keysym; + if (keysym == dpyinfo->quit_keysym) + { + /* Otherwise, set the last time that keysym + was pressed. */ + dpyinfo->quit_keysym_time = xev->time; + goto xi_done_keysym; + } } /* First deal with keysyms which have defined commit 3979f83cd60f2d0168690883423b63ae434da929 Author: F. Jason Park Date: Fri Jun 9 21:00:03 2023 -0700 Inhibit slash commands in erc--input-review-functions * lisp/erc/erc.el (erc--input-review-functions): Add new review function `erc--inhibit-slash-cmd-insertion'. (erc--check-prompt-input-functions): Move `erc--check-prompt-input-for-multiline-command' above `erc--check-prompt-input-for-multiline-blanks'. (erc--inhibit-slash-cmd-insertion): New "review" function to suppress insertion of prompt input for slash commands. Doesn't affect "meta" slash commands like /SAY. (erc--send-input-lines): Don't bother checking whether message is a command. Instead, trust verdict handed down by message-prep and review functions. This opens the door to optional insertion for debugging purposes or when echoing command lines in a shell-like fashion. * test/lisp/erc/erc-tests.el (erc-send-whitespace-lines): clean up portion dealing with trimming slash commands. (Bug#66073) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 37502b4c743..fb236f1f189 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1104,7 +1104,8 @@ 'erc--pre-send-split-functions 'erc--input-review-functions "30.1") (defvar erc--input-review-functions '(erc--split-lines erc--run-input-validation-checks - erc--discard-trailing-multiline-nulls) + erc--discard-trailing-multiline-nulls + erc--inhibit-slash-cmd-insertion) "Special hook for reviewing and modifying prompt input. ERC runs this before clearing the prompt and before running any send-related hooks, such as `erc-pre-send-functions'. Thus, it's @@ -6543,10 +6544,10 @@ erc--check-prompt-input-for-multiline-command (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds erc--check-prompt-input-for-something + erc--check-prompt-input-for-multiline-command erc--check-prompt-input-for-multiline-blanks erc--check-prompt-input-for-running-process - erc--check-prompt-input-for-excess-lines - erc--check-prompt-input-for-multiline-command) + erc--check-prompt-input-for-excess-lines) "Validators for user input typed at prompt. Called with two arguments: the current input submitted by the user, as a string, along with the same input as a list of @@ -6571,6 +6572,11 @@ erc--run-input-validation-checks (message "%s" (string-join (nreverse erc--check-prompt-explanation) "\n")))))) +(defun erc--inhibit-slash-cmd-insertion (state) + "Don't insert STATE object's message if it's a \"slash\" command." + (when (erc--input-split-cmdp state) + (setf (erc--input-split-insertp state) nil))) + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) @@ -6679,9 +6685,8 @@ erc--send-input-lines "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)) - (unless (erc--input-split-cmdp lines-obj) - (when (erc--input-split-insertp lines-obj) - (erc-display-msg line))) + (when (erc--input-split-insertp lines-obj) + (erc-display-msg line)) (erc-process-input-line (concat line "\n") (null erc-flood-protect) (not (erc--input-split-cmdp lines-obj)))))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2da1f7b29c1..8a68eca6196 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1316,17 +1316,12 @@ erc-send-whitespace-lines (should-not (funcall next))) (ert-info ("Multiline command with trailing blank filtered") - (pcase-dolist (`(,p . ,q) - '(("/a b\r" "/a b\n") ("/a b\n" "/a b\n") - ("/a b\n\n" "/a b\n") ("/a b\r\n" "/a b\n") - ("/a b\n\n\n" "/a b\n"))) + (dolist (p '("/a b" "/a b\n" "/a b\n\n" "/a b\n\n\n")) (insert p) (erc-send-current-line) (erc-bol) (should (eq (point) (point-max))) - (while q - (should (pcase (funcall next) - (`(,cmd ,_ nil) (equal cmd (pop q)))))) + (should (pcase (funcall next) (`(,cmd ,_ nil) (equal cmd "/a b\n")))) (should-not (funcall next)))) (ert-info ("Multiline command with non-blanks errors") commit a3c6ed0e36488ae21938409d8bce08d7eda6e5c1 Author: F. Jason Park Date: Fri Sep 15 06:08:55 2023 -0700 Improve erc-warn-about-blank-lines behavior * etc/ERC-NEWS: Mention more detailed feedback when option `erc-warn-about-blank-lines' is non-nil. * lisp/erc/erc-common.el (erc--input-split): Add `abortp' slot to allow a premature exit while validating prompt input. * lisp/erc/erc.el (erc-warn-about-blank-lines): Clarify meaning of "blank lines" in doc string, and mention interaction with companion option `erc-send-whitespace-lines'. (erc-inhibit-multiline-input): Fix inaccurate description in doc string. (erc--input-review-functions): Move `erc--discard-trailing-multiline-nulls' to end of list, after `erc--run-input-validation-checks' so that the latter doesn't have to resplit the original input string in order to issue feedback. (erc--blank-in-multiline-input-p): Remove unused internal function originally slated to be part of ERC 5.6. (erc--check-prompt-input-for-something): New trivial validation function to check if the input is empty. (erc--count-blank-lines): New function that tallies up the number of blank and whitespace-only lines in the current input. One downside of this design is that this function's conclusions aren't shared with `erc--discard-trailing-multiline-nulls', which must decide on its own how many lines to strip. (erc--check-prompt-explanation): New variable. (erc--check-prompt-input-for-multiline-blanks): Rework significantly to provide more informative messages and more sensible behavior for common cases with respect to relevant option values. (erc--check-prompt-input-functions): Add new validation function `erc--check-prompt-for-something'. (erc--run-input-validation-checks): Set `abortp' slot of `erc--input-split' when hooks return a non-string, rather than generate an unhelpful fallback message. Also print a message when the variable `erc--check-prompt-explanation' is non-nil. (erc-send-current-line): When the `abortp' slot of the current `erc--input-split' object is non-nil, forgo normal input processing. This fixes a regression in 5.6-git, which previously emitted an error message when it should have just exited the command. (erc--discard-trailing-multiline-nulls): Always run, regardless of `erc-send-whitespace-lines', and leave a blank line behind when stripping a message consisting of only blank lines. (erc--run-send-hooks): Always run hooks and surrounding logic rather than only when hooks are populated. * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Add assertion and use default value for `erc--input-review-functions'. (erc-ring-previous-command): Use default value for `erc--input-review-functions' and ensure `erc-current-nick' does not error. (erc--blank-in-multiline-input-p): Remove obsolete test. (erc--check-prompt-input-functions): Update expected message. (erc--discard-trailing-multiline-nulls, erc--count-blank-lines): New tests. (erc-tests--check-prompt-input--expect, erc-tests--check-prompt-input-messages): New helper variables. (erc--check-prompt-input-for-multiline-blanks, erc--check-prompt-input-for-multiline-blanks/explanations): New tests. (erc-send-whitespace-lines): Expect hook-processing logic to pad empty lines instead of deferring to `erc-send-input-line-function'. (Bug#66073) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 05e933930e2..fadd97b65df 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -221,6 +221,12 @@ atop any message. The new companion option 'erc-echo-timestamp-zone' determines the default timezone when not specified with a prefix argument. +** Option 'erc-warn-about-blank-lines' is more informative. +Enabled by default, this option now produces more useful feedback +whenever ERC rejects prompt input containing whitespace-only lines. +When paired with option 'erc-send-whitespace-lines', ERC echoes a +tally of blank lines padded and trailing blanks culled. + ** 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 @@ -281,7 +287,7 @@ For starters, the 'cursor-sensor-functions' property no longer contains unique closures and thus no longer proves effective for traversing messages. To compensate, a new property, 'erc-timestamp', now spans message bodies but not the newlines delimiting them. Also -affecting the `stamp' module is the deprecation of the function +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. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 67c2cf8535b..8d896e663b5 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -60,6 +60,7 @@ erc-input ((obsolete erc-send-this)) erc-send-this)))) (lines nil :type (list-of string)) + (abortp nil :type (list-of symbol)) (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8b7f4c2cfa5..37502b4c743 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -252,7 +252,14 @@ erc-prompt-for-password :type 'boolean) (defcustom erc-warn-about-blank-lines t - "Warn the user if they attempt to send a blank line." + "Warn the user if they attempt to send a blank line. +When non-nil, ERC signals a `user-error' upon encountering prompt +input containing empty or whitespace-only lines. When nil, ERC +still inhibits sending but does so silently. With the companion +option `erc-send-whitespace-lines' enabled, ERC sends pending +input and prints a message in the echo area indicating the amount +of padding and/or stripping applied, if any. Setting this option +to nil suppresses such reporting." :group 'erc :type 'boolean) @@ -264,8 +271,8 @@ erc-send-whitespace-lines (defcustom erc-inhibit-multiline-input nil "When non-nil, conditionally disallow input consisting of multiple lines. Issue an error when the number of input lines submitted for -sending exceeds this value. The value t means disallow more -than 1 line of input." +sending meets or exceeds this value. The value t is synonymous +with a value of 2 and means disallow more than 1 line of input." :package-version '(ERC . "5.5") :group 'erc :type '(choice integer boolean)) @@ -1095,9 +1102,9 @@ erc-pre-send-functions (define-obsolete-variable-alias 'erc--pre-send-split-functions 'erc--input-review-functions "30.1") -(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls - erc--split-lines - erc--run-input-validation-checks) +(defvar erc--input-review-functions '(erc--split-lines + erc--run-input-validation-checks + erc--discard-trailing-multiline-nulls) "Special hook for reviewing and modifying prompt input. ERC runs this before clearing the prompt and before running any send-related hooks, such as `erc-pre-send-functions'. Thus, it's @@ -6424,20 +6431,6 @@ erc--input-line-delim-regexp (defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" "Regular expression used for matching commands in ERC.") -(defun erc--blank-in-multiline-input-p (lines) - "Detect whether LINES contains a blank line. -When `erc-send-whitespace-lines' is in effect, return nil if -LINES is multiline or the first line is non-empty. When -`erc-send-whitespace-lines' is nil, return non-nil when any line -is empty or consists of one or more spaces, tabs, or form-feeds." - (catch 'return - (let ((multilinep (cdr lines))) - (dolist (line lines) - (when (if erc-send-whitespace-lines - (and (string-empty-p line) (not multilinep)) - (string-match (rx bot (* (in " \t\f")) eot) line)) - (throw 'return t)))))) - (defun erc--check-prompt-input-for-excess-lines (_ lines) "Return non-nil when trying to send too many LINES." (when erc-inhibit-multiline-input @@ -6457,13 +6450,78 @@ erc--check-prompt-input-for-excess-lines (y-or-n-p (concat "Send input " msg "?"))) (concat "Too many lines " msg)))))) -(defun erc--check-prompt-input-for-multiline-blanks (_ lines) - "Return non-nil when multiline prompt input has blank LINES." - (when (erc--blank-in-multiline-input-p lines) +(defun erc--check-prompt-input-for-something (string _) + (when (string-empty-p string) (if erc-warn-about-blank-lines "Blank line - ignoring..." 'invalid))) +(defun erc--count-blank-lines (lines) + "Report on the number of whitespace-only and empty LINES. +Return a list of (BLANKS TO-PAD TO-STRIP). Expect caller to know +that BLANKS includes non-empty whitespace-only lines and that no +padding or stripping has yet occurred." + (let ((real 0) (total 0) (pad 0) (strip 0)) + (dolist (line lines) + (if (string-match (rx bot (* (in " \t\f")) eot) line) + (progn + (cl-incf total) + (if (zerop (match-end 0)) + (cl-incf strip) + (cl-incf pad strip) + (setq strip 0))) + (cl-incf real) + (unless (zerop strip) + (cl-incf pad strip) + (setq strip 0)))) + (when (and (zerop real) (not (zerop total)) (= total (+ pad strip))) + (cl-incf strip (1- pad)) + (setq pad 1)) + (list total pad strip))) + +(defvar erc--check-prompt-explanation nil + "List of strings to print if no validator returns non-nil.") + +(defun erc--check-prompt-input-for-multiline-blanks (_ lines) + "Return non-nil when multiline prompt input has blank LINES. +Consider newlines to be intervening delimiters, meaning the empty +\"logical\" line between a trailing newline and `eob' constitutes +a separate message." + (pcase-let ((`(,total ,pad ,strip)(erc--count-blank-lines lines))) + (cond ((zerop total) nil) + ((and erc-warn-about-blank-lines erc-send-whitespace-lines) + (let (msg args) + (unless (zerop strip) + (push "stripping (%d)" msg) + (push strip args)) + (unless (zerop pad) + (when msg + (push "and" msg)) + (push "padding (%d)" msg) + (push pad args)) + (when msg + (push "blank" msg) + (push (if (> (apply #'+ args) 1) "lines" "line") msg)) + (when msg + (setf msg (nreverse msg) + (car msg) (capitalize (car msg)))) + (when msg + (push (apply #'format (string-join msg " ") (nreverse args)) + erc--check-prompt-explanation) + nil))) + (erc-warn-about-blank-lines + (concat (if (= total 1) + (if (zerop strip) "Blank" "Trailing") + (if (= total strip) + (format "%d trailing" strip) + (format "%d blank" total))) + (and (> total 1) (/= total strip) (not (zerop strip)) + (format " (%d trailing)" strip)) + (if (= total 1) " line" " lines") + " detected (see `erc-send-whitespace-lines')")) + (erc-send-whitespace-lines nil) + (t 'invalid)))) + (defun erc--check-prompt-input-for-point-in-bounds (_ _) "Return non-nil when point is before prompt." (when (< (point) (erc-beg-of-input-line)) @@ -6484,25 +6542,34 @@ erc--check-prompt-input-for-multiline-command (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds + erc--check-prompt-input-for-something erc--check-prompt-input-for-multiline-blanks erc--check-prompt-input-for-running-process erc--check-prompt-input-for-excess-lines erc--check-prompt-input-for-multiline-command) "Validators for user input typed at prompt. -Called with latest input string submitted by user and the list of -lines produced by splitting it. If any member function returns -non-nil, processing is abandoned and input is left untouched. -When the returned value is a string, ERC passes it to `erc-error'.") +Called with two arguments: the current input submitted by the +user, as a string, along with the same input as a list of +strings. If any member function returns non-nil, ERC abandons +processing and leaves pending input untouched in the prompt area. +When the returned value is a string, ERC passes it to +`user-error'. Any other non-nil value tells ERC to abort +silently. If all members return nil, and the variable +`erc--check-prompt-explanation' is a nonempty list of strings, +ERC prints them as a single message joined by newlines.") (defun erc--run-input-validation-checks (state) "Run input checkers from STATE, an `erc--input-split' object." - (when-let ((msg (run-hook-with-args-until-success - 'erc--check-prompt-input-functions - (erc--input-split-string state) - (erc--input-split-lines state)))) - (unless (stringp msg) - (setq msg (format "Input error: %S" msg))) - (user-error msg))) + (let* ((erc--check-prompt-explanation nil) + (msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions + (erc--input-split-string state) + (erc--input-split-lines state)))) + (cond ((stringp msg) (user-error msg)) + (msg (push msg (erc--input-split-abortp state))) + (erc--check-prompt-explanation + (message "%s" (string-join (nreverse erc--check-prompt-explanation) + "\n")))))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -6526,8 +6593,9 @@ erc-send-current-line str erc--input-line-delim-regexp) :cmdp (string-match erc-command-regexp str)))) (run-hook-with-args 'erc--input-review-functions state) - (let ((inhibit-read-only t) - (old-buf (current-buffer))) + (when-let (((not (erc--input-split-abortp state))) + (inhibit-read-only t) + (old-buf (current-buffer))) (progn ; unprogn this during next major surgery (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt @@ -6556,12 +6624,11 @@ erc-user-input (erc-end-of-input-line))) (defun erc--discard-trailing-multiline-nulls (state) - "Ensure last line of STATE's string is non-null. -But only when `erc-send-whitespace-lines' is non-nil. STATE is -an `erc--input-split' object." - (when (and erc-send-whitespace-lines (erc--input-split-lines state)) + "Remove trailing empty lines from STATE, an `erc--input-split' object. +When all lines are empty, remove all but the first." + (when (erc--input-split-lines state) (let ((reversed (nreverse (erc--input-split-lines state)))) - (while (and reversed (string-empty-p (car reversed))) + (while (and (cdr reversed) (string-empty-p (car reversed))) (setq reversed (cdr reversed))) (setf (erc--input-split-lines state) (nreverse reversed))))) @@ -6581,7 +6648,7 @@ erc--run-send-hooks limits and pad empty ones, knowing full well that additional processing may still corrupt messages before they reach the send queue. Expect LINES-OBJ to be an `erc--input-split' object." - (when (or erc-send-pre-hook erc-pre-send-functions) + (progn ; FIXME remove `progn' after code review. (with-suppressed-warnings ((lexical str) (obsolete erc-send-this)) (defvar str) ; see note in string `erc-send-input'. (let* ((str (string-join (erc--input-split-lines lines-obj) "\n")) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 05d45b2d027..2da1f7b29c1 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -292,7 +292,7 @@ erc--refresh-prompt (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook - erc--input-review-functions + (erc--input-review-functions erc--input-review-functions) erc-send-completed-hook) (ert-info ("Server buffer") @@ -357,6 +357,9 @@ erc--refresh-prompt (should (= (point) erc-input-marker)) (insert "/query bob") (erc-send-current-line) + ;; Last command not inserted + (save-excursion (forward-line -1) + (should (looking-at " Howdy"))) ;; Query does not redraw (nor /help, only message input) (should (looking-back "#chan@ServNet 11> ")) ;; No sign of old prompts @@ -877,11 +880,12 @@ erc-ring-previous-command (with-current-buffer (get-buffer-create "*#fake*") (erc-mode) (erc-tests--send-prep) + (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) ;; Just in case erc-ring-mode is already on - (setq-local erc--input-review-functions nil) + (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) ;; (cl-letf (((symbol-function 'erc-process-input-line) @@ -1056,43 +1060,6 @@ erc--input-line-delim-regexp (should (equal '("" "" "") (split-string "\n\n" p))) (should (equal '("" "" "") (split-string "\n\r" p))))) -(ert-deftest erc--blank-in-multiline-input-p () - (let ((check (lambda (s) - (erc--blank-in-multiline-input-p - (split-string s erc--input-line-delim-regexp))))) - - (ert-info ("With `erc-send-whitespace-lines'") - (let ((erc-send-whitespace-lines t)) - (should (funcall check "")) - (should-not (funcall check "\na")) - (should-not (funcall check "/msg a\n")) ; real /cmd - (should-not (funcall check "a\n\nb")) ; "" allowed - (should-not (funcall check "/msg a\n\nb")) ; non-/cmd - (should-not (funcall check " ")) - (should-not (funcall check "\t")) - (should-not (funcall check "a\nb")) - (should-not (funcall check "a\n ")) - (should-not (funcall check "a\n \t")) - (should-not (funcall check "a\n \f")) - (should-not (funcall check "a\n \nb")) - (should-not (funcall check "a\n \t\nb")) - (should-not (funcall check "a\n \f\nb")))) - - (should (funcall check "")) - (should (funcall check " ")) - (should (funcall check "\t")) - (should (funcall check "a\n\nb")) - (should (funcall check "a\n\nb")) - (should (funcall check "a\n ")) - (should (funcall check "a\n \t")) - (should (funcall check "a\n \f")) - (should (funcall check "a\n \nb")) - (should (funcall check "a\n \t\nb")) - - (should-not (funcall check "a\rb")) - (should-not (funcall check "a\nb")) - (should-not (funcall check "a\r\nb")))) - (defun erc-tests--with-process-input-spy (test) (with-current-buffer (get-buffer-create "FakeNet") (let* ((erc--input-review-functions @@ -1138,7 +1105,7 @@ erc--check-prompt-input-functions (delete-region (point) (point-max)) (insert "one\n") (let ((e (should-error (erc-send-current-line)))) - (should (equal "Blank line - ignoring..." (cadr e)))) + (should (string-prefix-p "Trailing line detected" (cadr e)))) (goto-char (point-max)) (ert-info ("Input remains untouched") (should (save-excursion (goto-char erc-input-marker) @@ -1180,6 +1147,137 @@ erc-send-current-line (should (consp erc-last-input-time))))) +(ert-deftest erc--discard-trailing-multiline-nulls () + (pcase-dolist (`(,input ,want) '((("") ("")) + (("" "") ("")) + (("a") ("a")) + (("a" "") ("a")) + (("" "a") ("" "a")) + (("" "a" "") ("" "a")))) + (ert-info ((format "Input: %S, want: %S" input want)) + (let ((s (make-erc--input-split :lines input))) + (erc--discard-trailing-multiline-nulls s) + (should (equal (erc--input-split-lines s) want)))))) + +(ert-deftest erc--count-blank-lines () + (pcase-dolist (`(,input ,want) '((() (0 0 0)) + (("") (1 1 0)) + (("" "") (2 1 1)) + (("" "" "") (3 1 2)) + ((" " "") (2 0 1)) + ((" " "" "") (3 0 2)) + (("" " " "") (3 1 1)) + (("" "" " ") (3 2 0)) + (("a") (0 0 0)) + (("a" "") (1 0 1)) + (("a" " " "") (2 0 1)) + (("a" "" "") (2 0 2)) + (("a" "b") (0 0 0)) + (("a" "" "b") (1 1 0)) + (("a" " " "b") (1 0 0)) + (("" "a") (1 1 0)) + ((" " "a") (1 0 0)) + (("" "a" "") (2 1 1)) + (("" " " "a" "" " ") (4 2 0)) + (("" " " "a" "" " " "") (5 2 1)))) + (ert-info ((format "Input: %S, want: %S" input want)) + (should (equal (erc--count-blank-lines input) want))))) + +;; Opt `wb': `erc-warn-about-blank-lines' +;; Opt `sw': `erc-send-whitespace-lines' +;; `s': " \n",`a': "a\n",`b': "b\n" +(defvar erc-tests--check-prompt-input--expect + ;; opts "" " " "\n" "\n " " \n" "\n\n" "a\n" "a\n " "a\n \nb" + '(((+wb -sw) err err err err err err err err err) + ((-wb -sw) nop nop nop nop nop nop nop nop nop) + ((+wb +sw) err (s) (0 s) (1 s s) (s) (0 s) (0 a) (a s) (a s b)) + ((-wb +sw) nop (s) (s) (s s) (s) (s) (a) (a s) (a s b)))) + +;; Help messages echoed (not IRC message) was emitted +(defvar erc-tests--check-prompt-input-messages + '("Stripping" "Padding")) + +(ert-deftest erc--check-prompt-input-for-multiline-blanks () + (erc-tests--with-process-input-spy + (lambda (next) + (erc-tests--set-fake-server-process "sleep" "1") + (should-not erc-send-whitespace-lines) + (should erc-warn-about-blank-lines) + + (pcase-dolist (`((,wb ,sw) . ,ex) erc-tests--check-prompt-input--expect) + (let ((print-escape-newlines t) + (erc-warn-about-blank-lines (eq wb '+wb)) + (erc-send-whitespace-lines (eq sw '+sw)) + (samples '("" " " "\n" "\n " " \n" "\n\n" + "a\n" "a\n " "a\n \nb"))) + (setq ex `(,@ex (a) (a b)) ; baseline, same for all combos + samples `(,@samples "a" "a\nb")) + (dolist (input samples) + (insert input) + (ert-info ((format "Opts: %S, Input: %S, want: %S" + (list wb sw) input (car ex))) + (ert-with-message-capture messages + (pcase-exhaustive (pop ex) + ('err (let ((e (should-error (erc-send-current-line)))) + (should (string-match (rx (| "trailing" "blank")) + (cadr e)))) + (should (equal (erc-user-input) input)) + (should-not (funcall next))) + ('nop (erc-send-current-line) + (should (equal (erc-user-input) input)) + (should-not (funcall next))) + ('clr (erc-send-current-line) + (should (string-empty-p (erc-user-input))) + (should-not (funcall next))) + ((and (pred consp) v) + (erc-send-current-line) + (should (string-empty-p (erc-user-input))) + (setq v (reverse v)) ; don't use `nreverse' here + (while v + (pcase (pop v) + ((and (pred integerp) n) + (should (string-search + (nth n erc-tests--check-prompt-input-messages) + messages))) + ('s (should (equal " \n" (car (funcall next))))) + ('a (should (equal "a\n" (car (funcall next))))) + ('b (should (equal "b\n" (car (funcall next))))))) + (should-not (funcall next)))))) + (delete-region erc-input-marker (point-max)))))))) + +(ert-deftest erc--check-prompt-input-for-multiline-blanks/explanations () + (should erc-warn-about-blank-lines) + (should-not erc-send-whitespace-lines) + + (let ((erc-send-whitespace-lines t)) + (pcase-dolist (`(,input ,msg) + '((("") "Padding (1) blank line") + (("" " ") "Padding (1) blank line") + ((" " "") "Stripping (1) blank line") + (("a" "") "Stripping (1) blank line") + (("" "") "Stripping (1) and padding (1) blank lines") + (("" "" "") "Stripping (2) and padding (1) blank lines") + (("" "a" "" "b" "" "c" "" "") + "Stripping (2) and padding (3) blank lines"))) + (ert-info ((format "Input: %S, Msg: %S" input msg)) + (let (erc--check-prompt-explanation) + (should-not (erc--check-prompt-input-for-multiline-blanks nil input)) + (should (equal (list msg) erc--check-prompt-explanation)))))) + + (pcase-dolist (`(,input ,msg) + '((("") "Blank line detected") + (("" " ") "2 blank lines detected") + ((" " "") "2 blank (1 trailing) lines detected") + (("a" "") "Trailing line detected") + (("" "") "2 blank (1 trailing) lines detected") + (("a" "" "") "2 trailing lines detected") + (("" "a" "" "b" "" "c" "" "") + "5 blank (2 trailing) lines detected"))) + (ert-info ((format "Input: %S, Msg: %S" input msg)) + (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input))) + (should (equal (concat msg " (see `erc-send-whitespace-lines')") + rv )))))) + (ert-deftest erc-send-whitespace-lines () (erc-tests--with-process-input-spy (lambda (next) @@ -1196,7 +1294,7 @@ erc-send-whitespace-lines (erc-bol) (should (eq (point) (point-max)))) (should (equal (funcall next) '("two\n" nil t))) - (should (equal (funcall next) '("\n" nil t))) + (should (equal (funcall next) '(" \n" nil t))) (should (equal (funcall next) '("one\n" nil t)))) (ert-info ("Multiline hunk with trailing newline filtered") commit 8db56235cbcb2afc03a3aa0691cc0795c7da43fb Author: F. Jason Park Date: Mon Sep 18 22:50:28 2023 -0700 Prefer ticks/hz pairs for some ERC timestamps on 29+ * lisp/erc/erc-compat.el (erc-compat--current-lisp-time): New macro to prefer ticks/hz pairs on newer Emacs versions because stamps of this form are easier to compare at a glance when used as values for text properties. * lisp/erc/erc-stamp.el (erc-stamp--current-time): Use compat macro. (Bug#60936) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 109b5d245ab..4c376cfbc22 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -444,6 +444,21 @@ erc-compat--29-browse-url-irc (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) existing)))))) +;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because +;; `time-less-p' and friends do +;; +;; message("obsolete timestamp with cdr ...", ...) +;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...) +;; lisp_time_struct(...) +;; time_cmp(...) +;; +;; which spams *Messages* (and stderr when running the test suite). +(defmacro erc-compat--current-lisp-time () + "Return `current-time' as a (TICKS . HZ) pair on 29+." + (if (>= emacs-major-version 29) + '(let (current-time-list) (current-time)) + '(current-time))) + (provide 'erc-compat) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index f159b6d226f..0f3163bf68d 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -215,7 +215,7 @@ erc-stamp--current-time (cl-defgeneric erc-stamp--current-time () "Return a lisp time object to associate with an IRC message. This becomes the message's `erc-timestamp' text property." - (let (current-time-list) (current-time))) + (erc-compat--current-lisp-time)) (cl-defmethod erc-stamp--current-time :around () (or erc-stamp--current-time (cl-call-next-method))) commit 06fb8b76208ad380d7d1e592394d3173249f31df Author: F. Jason Park Date: Wed Sep 20 21:40:36 2023 -0700 Exempt text-scale-mode from erc-scrolltobottom-all * lisp/erc/erc-goodies.el (erc--scrolltobottom-post-ignore-commands): New variable, a list of commands that should not trigger a re-scroll. (erc--scrolltobottom-on-post-command): Don't `recenter' when the current command appears in `erc--scrolltobottom-post-ignore-commands'. This fixes a bug that prevented managed recentering when disabling `text-scale-mode'. Thanks to Corwin Brust for reporting this. Note that this doesn't address any fill-related alignment issues involving `text-scale-mode'. Nor does it address likely problems involving the erroneous restoration of point after the insertion of invisible lines. (erc-keep-place-enable, erc-keep-place-mode): Adjust hook depth to fall within reserved interval. (erc-keep-place-indicator-enable, erc-keep-place-indicator-mode, erc--keep-place-indicator-on-global-module): Lower hook depth to fall within reserved interval. Note that this hook has a buffer-local value, so all members run after their global counterparts. (Bug#66073) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 6eb015fdd64..b77176d8ac7 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -128,6 +128,11 @@ erc--scrolltobottom-post-force-commands That is, ERC recalculates the window's start instead of blindly restoring it.") +;; Unfortunately, this doesn't work when `erc-scrolltobottom-relaxed' +;; is enabled (scaling up still moves the prompt). +(defvar erc--scrolltobottom-post-ignore-commands '(text-scale-adjust) + "Commands to skip instead of force-scroll on `post-command-hook'.") + (defvar erc--scrolltobottom-relaxed-skip-commands '(recenter-top-bottom scroll-down-command) "Commands exempt from triggering a stash and restore of `window-start'. @@ -158,7 +163,8 @@ erc--scrolltobottom-on-post-command ((= (nth 2 found) (count-screen-lines (window-start) (point-max))))) (set-window-start (selected-window) (nth 1 found)) - (erc--scrolltobottom-confirm)) + (unless (memq this-command erc--scrolltobottom-post-ignore-commands) + (erc--scrolltobottom-confirm))) (setq erc--scrolltobottom-window-info nil))) (defun erc--scrolltobottom-on-pre-command-relaxed () @@ -372,7 +378,7 @@ erc-move-to-prompt-setup ;;;###autoload(autoload 'erc-keep-place-mode "erc-goodies" nil t) (define-erc-module keep-place nil "Leave point above un-viewed text in other channels." - ((add-hook 'erc-insert-pre-hook #'erc-keep-place 85)) + ((add-hook 'erc-insert-pre-hook #'erc-keep-place 65)) ((remove-hook 'erc-insert-pre-hook #'erc-keep-place))) (defcustom erc-keep-place-indicator-style t @@ -467,7 +473,7 @@ keep-place-indicator ((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 85 t))) + (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t))) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) ('server (not erc--target)) @@ -490,7 +496,7 @@ erc--keep-place-indicator-on-global-module 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 85 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. commit 6135fec6926af4c4fb29d4440b03df7cf3b26bd4 Author: F. Jason Park Date: Mon Sep 18 22:50:28 2023 -0700 ; Increase ERC test server queue size * test/lisp/erc/erc-scenarios-scrolltobottom.el (erc-scenarios-scrolltobottom--normal, erc-scenarios-scrolltobottom--all): Use updated name for test fixture. * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--initialize-client): For lengthy batches, `erc-d--filter' may run multiple times before `erc-d--on-request' can pull from the queue, which results in discarded incoming messages and match failures. (erc-d--m, erc-d--log): Convert to ordinary functions. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-scrolltobottom--normal, erc-scenarios-common-scrolltobottom--normal): Rename test fixture from former to latter and attempt to fix intermittent failure re `count-screen-lines'. diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el index dd0a8612388..206687ccab5 100644 --- a/test/lisp/erc/erc-scenarios-scrolltobottom.el +++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el @@ -35,7 +35,7 @@ erc-scenarios-scrolltobottom--normal (should-not erc-scrolltobottom-all) - (erc-scenarios-scrolltobottom--normal + (erc-scenarios-common-scrolltobottom--normal (lambda () (ert-info ("New insertion doesn't anchor prompt in other window") (let ((w (next-window))) @@ -52,7 +52,7 @@ erc-scenarios-scrolltobottom--all (let ((erc-scrolltobottom-all t)) - (erc-scenarios-scrolltobottom--normal + (erc-scenarios-common-scrolltobottom--normal (lambda () (ert-info ("New insertion anchors prompt in other window") (let ((w (next-window))) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index b86769220dd..f072c6b93b2 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -254,7 +254,7 @@ erc-d--initialize-client (ending (process-get process :dialog-ending)) (dialog (make-erc-d-dialog :name name :process process - :queue (make-ring 5) + :queue (make-ring 10) :exchanges (make-ring 10) :match-handlers mat-h :server-fqdn fqdn))) @@ -292,33 +292,27 @@ erc-d-load-replacement-dialog (defvar erc-d--m-debug (getenv "ERC_D_DEBUG")) -(defmacro erc-d--m (process format-string &rest args) - "Output ARGS using FORMAT-STRING somewhere depending on context. -PROCESS should be a client connection or a server network process." - `(let ((format-string (if erc-d--m-debug - (concat (format-time-string "%s.%N: ") - ,format-string) - ,format-string)) - (want-insert (and ,process erc-d--in-process)) - (buffer (process-buffer (process-get ,process :server)))) - (when (and want-insert (buffer-live-p buffer)) - (with-current-buffer buffer - (goto-char (point-max)) - (insert (concat (format ,format-string ,@args) "\n")))) - (when (or erc-d--m-debug (not want-insert)) - (message format-string ,@args)))) - -(defmacro erc-d--log (process string &optional outbound) - "Log STRING sent to (OUTBOUND) or received from PROCESS peer." - `(let ((id (or (process-get ,process :log-id) - (let ((port (erc-d-u--get-remote-port ,process))) - (process-put ,process :log-id port) - port))) - (name (erc-d-dialog-name (process-get ,process :dialog)))) - (if ,outbound - (erc-d--m process "-> %s:%s %s" name id ,string) - (dolist (line (split-string ,string (process-get process :ending))) - (erc-d--m process "<- %s:%s %s" name id line))))) +(defun erc-d--m (process format-string &rest args) + "Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere." + (when erc-d--m-debug + (setq format-string (concat (format-time-string "%s.%N: ") format-string))) + (let ((insertp (and process erc-d--in-process)) + (buffer (process-buffer (process-get process :server)))) + (when (and insertp (buffer-live-p buffer)) + (princ (concat (apply #'format format-string args) "\n") buffer)) + (when (or erc-d--m-debug (not insertp)) + (apply #'message format-string args)))) + +(defun erc-d--log (process string &optional outbound) + "Log STRING received from or OUTBOUND to PROCESS peer." + (let ((id (or (process-get process :log-id) + (let ((port (erc-d-u--get-remote-port process))) + (process-put process :log-id port) port))) + (name (erc-d-dialog-name (process-get process :dialog)))) + (if outbound + (erc-d--m process "-> %s:%s %s" name id string) + (dolist (line (split-string string (process-get process :ending))) + (erc-d--m process "<- %s:%s %s" name id line))))) (defun erc-d--log-process-event (server process msg) (erc-d--m server "%s: %s" process (string-trim-right msg))) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 19f26bf08bd..5354b300b47 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -341,7 +341,7 @@ erc-scenarios-common--recenter-top-bottom ;;;; Fixtures -(defun erc-scenarios-scrolltobottom--normal (test) +(defun erc-scenarios-common-scrolltobottom--normal (test) (erc-scenarios-common-with-noninteractive-in-term ((erc-scenarios-common-dialog "scrolltobottom") (dumb-server (erc-d-run "localhost" t 'help)) @@ -402,6 +402,7 @@ erc-scenarios-scrolltobottom--normal (erc-cmd-MSG "NickServ help register") (save-excursion (erc-d-t-search-for 10 "End of NickServ")) (should (= 1 (point))) + (redisplay) (should (zerop (count-screen-lines (window-start) (window-point)))) (should (erc-scenarios-common--prompt-past-win-end-p))) commit ffd5d2f38d3bf521aa97e22cb134bc687429f01b Author: F. Jason Park Date: Mon Sep 25 06:06:13 2023 -0700 Fix wrong "User" column count in erc-ibuffer (ibuffer-make-column-erc-members): Show tally of all server users for non-target buffers, and show correct count for targets. Thanks to Mattias Engdegård for reporting this. (erc-ibuffer-limit-map): Use "new" `define-ibuffer-filter' API. (Bug#66191) diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el index 612814ac6da..790efae97ac 100644 --- a/lisp/erc/erc-ibuffer.el +++ b/lisp/erc/erc-ibuffer.el @@ -27,6 +27,9 @@ ;; needs work. Usage: Type / C-e C-h when in Ibuffer-mode to see new ;; limiting commands +;; This library does not contain a module, but you can `require' it +;; after loading `erc' to make use of its functionality. + ;;; Code: (require 'ibuffer) @@ -118,11 +121,11 @@ erc-topic (define-ibuffer-column erc-members (:name "Users") - (if (and (eq major-mode 'erc-mode) - (boundp 'erc-channel-users) - (hash-table-p erc-channel-users) - (> (hash-table-size erc-channel-users) 0)) - (number-to-string (hash-table-size erc-channel-users)) + (if-let ((table (or erc-channel-users erc-server-users)) + ((hash-table-p table)) + (count (hash-table-count table)) + ((> count 0))) + (number-to-string count) "")) (define-ibuffer-column erc-away (:name "A") @@ -177,8 +180,7 @@ erc-ibuffer-formats (defvar erc-ibuffer-limit-map nil "Prefix keymap to use for ERC related limiting.") (define-prefix-command 'erc-ibuffer-limit-map) -;; FIXME: Where is `ibuffer-limit-by-erc-server' defined? -(define-key 'erc-ibuffer-limit-map (kbd "s") 'ibuffer-limit-by-erc-server) +(define-key 'erc-ibuffer-limit-map (kbd "s") #'ibuffer-filter-by-erc-server) (define-key ibuffer-mode-map (kbd "/ \C-e") 'erc-ibuffer-limit-map) (provide 'erc-ibuffer) commit 019baf28599783162659b668330a4dab3d368ffe Author: F. Jason Park Date: Mon Oct 2 16:29:28 2023 -0700 Remove newline from erc-fill regexp * lisp/erc/erc-fill.el (erc-fill): Remove newline from character alternative in pattern for skipping past blank and whitespace-only lines. It seems that as of e61a0398 "regex.c: Consolidate the two analysis functions", Emacs no longer sees a newline-dollar sequence as matching an empty line. Also lose `save-match-data', which doesn't appear to serve any purpose here. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index f4835f71278..0e6b5a3efb8 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -158,9 +158,8 @@ erc-fill (when (or erc-fill--function erc-fill-function) ;; skip initial empty lines (goto-char (point-min)) - (save-match-data - (while (and (looking-at "[ \t\n]*$") - (= (forward-line 1) 0)))) + (while (and (looking-at (rx bol (* (in " \t")) eol)) + (zerop (forward-line 1)))) (unless (eobp) (save-restriction (narrow-to-region (point) (point-max)) commit ad2bb3e9f36d1a4f25e1e2228586331b40a30a46 Author: Po Lu Date: Mon Oct 2 15:38:30 2023 +0800 Properly translate touch screen events into mouse drag ones * doc/lispref/commands.texi (Drag Events): Correct misleading example form and reword subsequent elaboration. * lisp/touch-screen.el (touch-screen-handle-point-up) : Set posns representing drag start and terminus to mouse position lists, in lieu of pairs between windows and posns employed previously. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index a69879c30a9..6601135cb85 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1854,20 +1854,19 @@ Drag Events position and the final position, like this: @example -(@var{event-type} - (@var{window1} START-POSITION) - (@var{window2} END-POSITION)) +(@var{event-type} @var{start-position} @var{end-position}) @end example For a drag event, the name of the symbol @var{event-type} contains the prefix @samp{drag-}. For example, dragging the mouse with button 2 held down generates a @code{drag-mouse-2} event. The second and third -elements of the event give the starting and ending position of the -drag, as mouse position lists (@pxref{Click Events}). You can access -the second element of any mouse event in the same way. However, the -drag event may end outside the boundaries of the frame that was -initially selected. In that case, the third element's position list -contains that frame in place of a window. +elements of the event, @var{start-position} and @var{end-position} in +the foregoing illustration, are set to the start and end positions of +the drag as mouse position lists (@pxref{Click Events}). You can +access the second element of any mouse event in the same way. +However, the drag event may end outside the boundaries of the frame +that was initially selected. In that case, the third element's +position list contains that frame in place of a window. The @samp{drag-} prefix follows the modifier key prefixes such as @samp{C-} and @samp{M-}. diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 23c5bbf71ff..2621aebf037 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1140,9 +1140,7 @@ touch-screen-handle-point-up ;; ... generate a mouse-1 event... (list 'mouse-1 posn) ;; ... otherwise, generate a drag-mouse-1 event. - (list 'drag-mouse-1 (cons old-window - old-posn) - (cons new-window posn)))) + (list 'drag-mouse-1 old-posn posn))) (if (and (eq new-window old-window) (eq new-point old-point) (windowp new-window) @@ -1150,9 +1148,7 @@ touch-screen-handle-point-up ;; ... generate a mouse-1 event... (list 'mouse-1 posn) ;; ... otherwise, generate a drag-mouse-1 event. - (list 'drag-mouse-1 (cons old-window - old-posn) - (cons new-window posn))))))) + (list 'drag-mouse-1 old-posn posn)))))) ((eq what 'mouse-1-menu) ;; Generate a `down-mouse-1' event at the position the tap ;; took place. commit bdd3013249634c86a2cd2b1973f8fe15da94ab8b Author: Eli Zaretskii Date: Mon Oct 2 10:18:10 2023 +0300 ; * lisp/image-mode.el (image-mode-to-text, image-mode-as-hex): Doc fixes. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index d701124f3f3..71b62d25a2d 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -772,9 +772,8 @@ image-minor-mode ;;;###autoload (defun image-mode-to-text () - "Set a non-image mode as major mode in combination with image minor mode. -A non-image major mode found from `auto-mode-alist' or fundamental mode -displays an image file as text." + "Set current buffer's modes be a non-image major mode, plus `image-minor-mode'. +A non-image major mode displays an image file as text." ;; image-mode-as-text = normal-mode + image-minor-mode (let ((previous-image-type image-type)) ; preserve `image-type' (major-mode-restore '(image-mode image-mode-as-text)) @@ -785,15 +784,14 @@ image-mode-to-text (image-toggle-display-text)))) (defun image-mode-as-hex () - "Set `hexl-mode' as major mode in combination with image minor mode. -A non-image major mode found from `auto-mode-alist' or fundamental mode -displays an image file as hex. `image-minor-mode' provides the key -\\\\[image-toggle-hex-display] to switch back to `image-mode' \ -to display an image file as -the actual image. + "Set current buffer's modes be `hexl-mode' major mode, plus `image-minor-mode'. +This will by default display an image file as hex. `image-minor-mode' +provides the key sequence \\\\[image-toggle-hex-display] to \ +switch back to `image-mode' to display +an image file's buffer as an image. You can use `image-mode-as-hex' in `auto-mode-alist' when you want to -display an image file as hex initially. +display image files as hex by default. See commands `image-mode' and `image-minor-mode' for more information on these modes." commit 5c2d9ae48ede95efac5f6919585ad3b98a51699a Author: Ikumi Keita Date: Mon Oct 2 15:54:51 2023 +0900 ; * lisp/image-mode.el: Fix typos in doc strings (bug#66302). diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 962e48bd9c6..d701124f3f3 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -773,7 +773,7 @@ image-minor-mode ;;;###autoload (defun image-mode-to-text () "Set a non-image mode as major mode in combination with image minor mode. -A non-mage major mode found from `auto-mode-alist' or fundamental mode +A non-image major mode found from `auto-mode-alist' or fundamental mode displays an image file as text." ;; image-mode-as-text = normal-mode + image-minor-mode (let ((previous-image-type image-type)) ; preserve `image-type' @@ -786,7 +786,7 @@ image-mode-to-text (defun image-mode-as-hex () "Set `hexl-mode' as major mode in combination with image minor mode. -A non-mage major mode found from `auto-mode-alist' or fundamental mode +A non-image major mode found from `auto-mode-alist' or fundamental mode displays an image file as hex. `image-minor-mode' provides the key \\\\[image-toggle-hex-display] to switch back to `image-mode' \ to display an image file as commit db704687bb9992212cec0d5435f6dcd75161e229 Author: Po Lu Date: Mon Oct 2 11:00:39 2023 +0800 Update Android port * java/AndroidManifest.xml.in: Exclude non-files from opening in Emacs. * java/org/gnu/emacs/EmacsOpenActivity.java (onCreate): Avert crash should scheme be NULL. diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in index d4017a055dd..9ba9dabde81 100644 --- a/java/AndroidManifest.xml.in +++ b/java/AndroidManifest.xml.in @@ -110,7 +110,10 @@ along with GNU Emacs. If not, see . --> - + + + + + + + + + + + + + + + + + + Date: Thu Sep 21 22:35:05 2023 +0100 Flymake: new 'short' option for flymake-show-diagnostics-at-end-of-line bug#66041 * lisp/progmodes/flymake.el (Version): Bump to 1.3.6 (flymake-eol-information-face): New face. (flymake-show-diagnostics-at-end-of-line): Support new value short. (flymake--eol-overlay-summary): Rework. (flymake--highlight-line): diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index ffe95cce6ca..6fabea3bda8 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,7 +4,7 @@ ;; Author: Pavel Kobyakov ;; Maintainer: João Távora -;; Version: 1.3.4 +;; Version: 1.3.6 ;; Keywords: c languages tools ;; Package-Requires: ((emacs "26.1") (eldoc "1.14.0") (project "0.7.1")) @@ -461,10 +461,22 @@ flymake-note-echo-at-eol "Face like `flymake-note-echo', but for end-of-line overlays." :package-version '(Flymake . "1.3.5")) +(defface flymake-eol-information-face + '((t :inherit (flymake-end-of-line-diagnostics-face) + :box nil + :slant italic)) + "Face used for information about end-of-line diagnostics." + :package-version '(Flymake . "1.3.6")) + (defcustom flymake-show-diagnostics-at-end-of-line nil - "If non-nil, add diagnostic summary messages at end-of-line." - :type 'boolean - :package-version '(Flymake . "1.3.4")) + "If non-nil, add diagnostic summary messages at end-of-line. +The value `short' means that only the most severe diagnostic +shall be shown. Any other non-nil value means show all +diagnostic summaries at end-of-line." + :type '(choice (const :tag "Display most severe diagnostic" short) + (const :tag "Display all diagnostics" t) + (const :tag "Don't display diagnostics at end-of-line" nil)) + :package-version '(Flymake . "1.3.6")) (define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1") (define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1") @@ -704,20 +716,34 @@ flymake--delete-overlay (defun flymake--eol-overlay-summary (src-ovs) "Helper function for `flymake--eol-overlay-update'." - (cl-loop - for s in src-ovs - for d = (overlay-get s 'flymake-diagnostic) - for type = (flymake--diag-type d) - for eol-face = (flymake--lookup-type-property type 'eol-face) - concat (propertize (flymake-diagnostic-oneliner d t) 'face eol-face) into retval - concat " " - into retval - finally - (setq retval (concat " " retval)) - (put-text-property 0 1 'cursor t retval) - (cl-return retval))) + (cl-flet ((summarize (d) + (propertize (flymake-diagnostic-oneliner d t) 'face + (flymake--lookup-type-property (flymake--diag-type d) + 'eol-face)))) + (let* ((diags + (cl-sort + (mapcar (lambda (o) (overlay-get o 'flymake-diagnostic)) src-ovs) + #'> + :key (lambda (d) (flymake--severity (flymake-diagnostic-type d))))) + (summary + (concat + " " + (cond ((eq flymake-show-diagnostics-at-end-of-line 'short) + (concat + (summarize (car diags)) + (and (cdr diags) + (concat + " " + (propertize (format "and %s more" + (1- (length diags))) + 'face 'flymake-eol-information-face))))) + (t + (mapconcat #'summarize diags " ")))))) + (put-text-property 0 1 'cursor t summary) + summary))) (defun flymake--update-eol-overlays () + "Update the `before-string' property of end-of-line overlays." (save-excursion (widen) (dolist (o (overlays-in (point-min) (point-max))) commit a45d33d8aa80482d185a130059dd099e24d7aec1 Author: Manphiz Date: Fri Sep 15 09:51:57 2023 +0200 ; Handle authentication properly when reconnecting to IRC * lisp/net/rcirc.el (rcirc-reconnect): Set 'rcirc-user-authenticated' to nil before reconnecting. (Bug#65882) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index a6dad4b640d..3f6242d9347 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -859,6 +859,7 @@ rcirc-reconnect (if (rcirc--connection-open-p process) (throw 'exit (or quiet (message "Server process is alive"))) (delete-process process)) + (setq rcirc-user-authenticated nil) (let ((conn-info rcirc-connection-info)) (setf (nth 5 conn-info) (cl-remove-if-not #'rcirc-channel-p commit 842411f09bc91f6722742268f750c7559a7b7c79 Author: Philip Kaludercic Date: Thu Sep 14 15:09:19 2023 +0200 package-tests.el: Add test Bug#65475 * test/lisp/emacs-lisp/package-tests.el (with-package-test): Bind package-selected-packages. (package-test-bug65475): Add test. diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 113b4ec12a8..e44ad3677d1 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -125,6 +125,7 @@ with-package-test abbreviated-home-dir package--initialized package-alist + package-selected-packages ,@(if update-news '(package-update-news-on-upload t) (list (cl-gensym))) @@ -307,6 +308,21 @@ package-test-bug58367 (package-delete (cadr (assq 'v7-withsub package-alist)))) )) +(ert-deftest package-test-bug65475 () + "Deleting the last package clears `package-selected-packages'." + (with-package-test (:basedir (ert-resource-directory)) + (package-initialize) + (let* ((pkg-el "simple-single-1.3.el") + (source-file (expand-file-name pkg-el (ert-resource-directory)))) + (package-install-file source-file) + (should package-alist) + (should package-selected-packages) + (let ((desc (cadr (assq 'simple-single package-alist)))) + (should desc) + (package-delete desc)) + (should-not package-alist) + (should-not package-selected-packages)))) + (ert-deftest package-test-install-file-EOLs () "Install same file multiple time with `package-install-file' but with a different end of line convention (bug#48137)." commit 24b8d13fc1ad2a6c5e3acbc794f34722508d5ab9 Author: Philip Kaludercic Date: Wed Sep 13 11:58:22 2023 +0200 ; Handle edge-case when deleting the last package * lisp/emacs-lisp/package.el (package-delete): Rebind 'package-alist' while calling 'package--used-elsewhere-p'. (bug#65475) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 0140a565e3b..5a508882dc3 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2521,8 +2521,12 @@ package-delete nil t))) (list (cdr (assoc package-name package-table)) current-prefix-arg nil)))) - (let ((dir (package-desc-dir pkg-desc)) - (name (package-desc-name pkg-desc)) + (let* ((dir (package-desc-dir pkg-desc)) + (name (package-desc-name pkg-desc)) + (new-package-alist (let ((pkgs (assq name package-alist))) + (if (null (remove pkg-desc (cdr pkgs))) + (remq pkgs package-alist) + package-alist))) pkg-used-elsewhere-by) ;; If the user is trying to delete this package, they definitely ;; don't want it marked as selected, so we remove it from @@ -2541,7 +2545,8 @@ package-delete (package-desc-full-name pkg-desc))) ((and (null force) (setq pkg-used-elsewhere-by - (package--used-elsewhere-p pkg-desc))) + (let ((package-alist new-package-alist)) + (package--used-elsewhere-p pkg-desc)))) ;See bug#65475 ;; Don't delete packages used as dependency elsewhere. (error "Package `%s' is used by `%s' as dependency, not deleting" (package-desc-full-name pkg-desc) @@ -2562,10 +2567,7 @@ package-delete (when (file-exists-p file) (delete-file file)))) ;; Update package-alist. - (let ((pkgs (assq name package-alist))) - (delete pkg-desc pkgs) - (unless (cdr pkgs) - (setq package-alist (delq pkgs package-alist)))) + (setq package-alist new-package-alist) (package--quickstart-maybe-refresh) (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))) commit cc9bfcafb9cb9efa606d0ac5747a4600d5ccafcb Author: Stefan Monnier Date: Thu Sep 21 11:58:44 2023 -0400 * src/regex-emacs.c (mutually_exclusive_aux) [ENABLE_CHECKING]: Fix if diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 06befe1b189..cf7b704ee95 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -3793,11 +3793,12 @@ mutually_exclusive_aux (struct re_pattern_buffer *bufp, re_char *p1, return true; /* Presumably already checked elsewhere. */ eassert (loop_entry && p2 >= loop_entry); if (p2 < loop_entry || (loop_exit && p2 > loop_exit)) - /* The assumptions about the shape of the code aren't true :-( */ + { /* The assumptions about the shape of the code aren't true :-( */ #ifdef ENABLE_CHECKING - error ("Broken assumption in regex.c:mutually_exclusive_aux"); + error ("Broken assumption in regex.c:mutually_exclusive_aux"); #endif - return false; + return false; + } /* Skip over open/close-group commands. If what follows this loop is a ...+ construct, commit 424b35fa24f07f85c5287c682e140c1c8daa25d0 Author: Stefan Monnier Date: Thu Sep 21 11:47:31 2023 -0400 regex-emacs.c (mutually_exclusive_aux): Rework again Rework the way we handle loops. This new code does not really work better than the previous one, but it has the advantage of being "fail safe" and also that we can dynamically check if our assumptions about the shape of the bytecode are satisfied or not. * src/regex-emacs.c (mutually_exclusive_aux): Replace `done_beg` and `done_end` with `loop_beg` and `loop_end`. (mutually_exclusive_p): Adjust accordingly. (analyze_first): Fix incorrect assertion. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 55d0a6e8df8..06befe1b189 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -1923,12 +1923,22 @@ regex_compile (re_char *pattern, ptrdiff_t size, if (!zero_times_ok && simple) { /* Since simple * loops can be made faster by using - on_failure_keep_string_jump, we turn simple P+ - into PP* if P is simple. */ + on_failure_keep_string_jump, we turn P+ into PP* + if P is simple. + We can't use `top: ; OFJS exit; J top; exit:` + because the OFJS needs to be at the beginning + so we can replace + top: OFJS exit; ; J top; exit + with + OFKSJ exit; loop: ; J loop; exit + i.e. a single OFJ at the beginning of the loop + rather than once per iteration. */ unsigned char *p1, *p2; startoffset = b - laststart; GET_BUFFER_SPACE (startoffset); p1 = b; p2 = laststart; + /* We presume that the code skipped + by `skip_one_char` is position-independent. */ while (p2 < p1) *b++ = *p2++; zero_times_ok = 1; @@ -3068,8 +3078,10 @@ analyze_first (re_char *p, re_char *pend, char *fastmap, bool multibyte) continue; case succeed_n: - /* If N == 0, it should be an on_failure_jump_loop instead. */ - DEBUG_STATEMENT (EXTRACT_NUMBER (j, p + 2); eassert (j > 0)); + /* If N == 0, it should be an on_failure_jump_loop instead. + `j` can be negative because `EXTRACT_NUMBER` extracts a + signed number whereas `succeed_n` treats it as unsigned. */ + DEBUG_STATEMENT (EXTRACT_NUMBER (j, p + 2); eassert (j != 0)); p += 4; /* We only care about one iteration of the loop, so we don't need to consider the case where this behaves like an @@ -3743,20 +3755,32 @@ mutually_exclusive_charset (struct re_pattern_buffer *bufp, re_char *p1, } /* True if "p1 matches something" implies "p2 fails". */ -/* Avoiding inf-loops: - We're trying to follow all paths reachable from `p2`, but since some +/* We're trying to follow all paths reachable from `p2`, but since some loops can match the empty string, this can loop back to `p2`. - To avoid inf-looping, we keep track of points that have been considered - "already". Instead of keeping a list of such points, `done_beg` and - `done_end` delimit a chunk of bytecode we already considered. - To guarantee termination, a lexical ordering between `done_*` and `p2` - should be obeyed: - At each recursion, either `done_beg` gets smaller, - or `done_beg` is unchanged and `done_end` gets larger - or they're both unchanged and `p2` gets larger. */ + + To avoid inf-looping, we take advantage of the fact that + the bytecode we generate is made of syntactically nested loops, more + specifically, every loop has a single entry point and single exit point. + + The function takes 2 more arguments (`loop_entry` and `loop_exit`). + `loop_entry` points to the sole entry point of the current loop and + `loop_exit` points to its sole exit point (when non-NULL). + + Jumps outside of `loop_entry..exit` should not occur. + The function can assume that `loop_exit` is "mutually exclusive". + The same holds for `loop_entry` except when `p2 == loop_entry`. + + To guarantee termination, recursive calls should make sure that either + `loop_entry` is larger, or it's unchanged but `p2` is larger. + + FIXME: This is failsafe (can't return true when it shouldn't) + but it could be too conservative if we start generating bytecode + with a different shape, so maybe we should bite the bullet and + replace done_beg/end with an actual list of positions we've + already processed. */ static bool mutually_exclusive_aux (struct re_pattern_buffer *bufp, re_char *p1, - re_char *p2, re_char *done_beg, re_char *done_end) + re_char *p2, re_char *loop_entry, re_char *loop_exit) { re_opcode_t op2; unsigned char *pend = bufp->buffer + bufp->used; @@ -3765,8 +3789,15 @@ mutually_exclusive_aux (struct re_pattern_buffer *bufp, re_char *p1, eassert (p1 >= bufp->buffer && p1 < pend && p2 >= bufp->buffer && p2 <= pend); - eassert (done_beg <= done_end); - eassert (done_end <= p2); + if (p2 == loop_exit) + return true; /* Presumably already checked elsewhere. */ + eassert (loop_entry && p2 >= loop_entry); + if (p2 < loop_entry || (loop_exit && p2 > loop_exit)) + /* The assumptions about the shape of the code aren't true :-( */ +#ifdef ENABLE_CHECKING + error ("Broken assumption in regex.c:mutually_exclusive_aux"); +#endif + return false; /* Skip over open/close-group commands. If what follows this loop is a ...+ construct, @@ -3858,29 +3889,43 @@ mutually_exclusive_aux (struct re_pattern_buffer *bufp, re_char *p1, int mcnt; p2++; EXTRACT_NUMBER_AND_INCR (mcnt, p2); - re_char *p2_other = p2 + mcnt; - - /* When we jump backward we bump `done_end` up to `p3` under - the assumption that any other position between `done_end` - and `p3` is either: - - checked by the other call to RECURSE. - - not reachable from here (e.g. for positions before the - `on_failure_jump`), or at least not without first - jumping before `done_beg`. - This should hold because our state machines are not arbitrary: - they consists of syntaxically nested loops with limited - control flow. - FIXME: This can fail (i.e. return true when it shouldn't) - if we start generating bytecode with a different shape, - so maybe we should bite the bullet and replace done_beg/end - with an actual list of positions we've already processed. */ -#define RECURSE(p3) \ - ((p3) < done_beg ? mutually_exclusive_aux (bufp, p1, p3, p3, p3) \ - : (p3) <= done_end ? true \ - : mutually_exclusive_aux (bufp, p1, p3, done_beg, \ - (p3) > p2_orig ? done_end : (p3))) - - return RECURSE (p2) && RECURSE (p2_other); + re_char *p2_other = p2 + mcnt, *tmp; + /* For `+` loops, we often have an `on_failure_jump` that skips forward + over a subsequent `jump` for lack of an `on_failure_dont_jump` + kind of thing. Recognize this pattern since that subsequent + `jump` is the one that jumps to the loop-entry. */ + if ((re_opcode_t) p2[0] == jump && mcnt == 3) + { + EXTRACT_NUMBER (mcnt, p2 + 1); + p2 += mcnt + 3; + } + + /* We have to check that both destinations are safe. + Arrange for `p2` to be the smaller of the two. */ + if (p2 > p2_other) + (tmp = p2, p2 = p2_other, p2_other = tmp); + + if (p2_other <= p2_orig /* Both destinations go backward! */ + || !mutually_exclusive_aux (bufp, p1, p2_other, + loop_entry, loop_exit)) + return false; + + /* Now that we know that `p2_other` is a safe (i.e. mutually-exclusive) + position, let's check `p2`. */ + if (p2 == loop_entry) + /* If we jump backward to the entry point of the current loop + it means it's a zero-length cycle through that loop, so + this cycle itself does not break mutual-exclusion. */ + return true; + else if (p2 > p2_orig) + /* Boring forward jump. */ + return mutually_exclusive_aux (bufp, p1, p2, loop_entry, loop_exit); + else if (loop_entry < p2 && p2 < p2_orig) + /* We jump backward to a new loop, nested within the current one. + `p2` is the entry point and `p2_other` the exit of that inner. */ + return mutually_exclusive_aux (bufp, p1, p2, p2, p2_other); + else + return false; } default: @@ -3895,7 +3940,7 @@ #define RECURSE(p3) \ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, re_char *p2) { - return mutually_exclusive_aux (bufp, p1, p2, p2, p2); + return mutually_exclusive_aux (bufp, p1, p2, bufp->buffer, NULL); } /* Matching routines. */ commit 57c6c067d35e519bc3787966cd6346904bc75e16 Author: João Távora Date: Thu Sep 21 14:02:59 2023 +0100 Flymake: fix bug in end-of-line overlay updates * lisp/progmodes/flymake.el (flymake--update-eol-overlays): Rename from flymake--eol-overlay-update and fix. (flymake--handle-report): Call flymake--update-eol-overlays. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 1b232050855..ffe95cce6ca 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -717,14 +717,14 @@ flymake--eol-overlay-summary (put-text-property 0 1 'cursor t retval) (cl-return retval))) -(defun flymake--eol-overlay-update () +(defun flymake--update-eol-overlays () (save-excursion (widen) - (cl-loop for o in (overlays-in (point-min) (point-max)) - for src-ovs = (overlay-get o 'flymake-eol-source-overlays) - if src-ovs - do (overlay-put o 'before-string (flymake--eol-overlay-summary src-ovs)) - else do (delete-overlay o)))) + (dolist (o (overlays-in (point-min) (point-max))) + (when (overlay-get o 'flymake--eol-overlay) + (if-let ((src-ovs (overlay-get o 'flymake-eol-source-overlays))) + (overlay-put o 'before-string (flymake--eol-overlay-summary src-ovs)) + (delete-overlay o)))))) (cl-defun flymake--highlight-line (diagnostic &optional foreign) "Attempt to overlay DIAGNOSTIC in current buffer. @@ -974,7 +974,7 @@ flymake--handle-report (when (and flymake-show-diagnostics-at-end-of-line (not (cl-set-difference (flymake-running-backends) (flymake-reporting-backends)))) - (flymake--eol-overlay-update)) + (flymake--update-eol-overlays)) (flymake--update-diagnostics-listings (current-buffer)))) (defun flymake--clear-foreign-diags (state) commit c966e7ec381fa32ad09dab4329d5ad27d87b5b98 Author: Michael Albinus Date: Thu Sep 21 09:21:20 2023 +0200 * lisp/net/tramp.el (tramp-skeleton-write-region): Fix missing comma. (Bug#66123) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 502ededcfb7..8ace0165ed9 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3734,7 +3734,7 @@ tramp-skeleton-write-region (let ((inhibit-file-name-handlers `(tramp-file-name-handler tramp-crypt-file-name-handler - . inhibit-file-name-handlers)) + . ,inhibit-file-name-handlers)) (inhibit-file-name-operation 'write-region)) (find-file-name-handler ,visit 'write-region)))) ;; We use this to save the value of commit d0b1e3647fb4e6d889f9f999388c53daf0e67f0d Author: Gerd Möllmann Date: Thu Sep 21 07:06:50 2023 +0200 macOS: only cp emacs.pdmp when installing (bug#66022) * Makefile.in (install-arch-dep): install emacs.pdmp here for self-contained build * nextstep/Makefile.in (${ns_applibexecdir}/Emacs.pdmp): Don't cp emacs.pdmp if self-contained build. diff --git a/Makefile.in b/Makefile.in index c82aad1af60..51a27cc1814 100644 --- a/Makefile.in +++ b/Makefile.in @@ -643,6 +643,7 @@ install-arch-dep: cd "$(DESTDIR)${bindir}" && $(LN_S_FILEONLY) "$(EMACSFULL)" "$(EMACS)" endif else + ${INSTALL_DATA} src/emacs.pdmp "$(DESTDIR)${libexecdir}/Emacs.pdmp" subdir=${ns_appresdir}/site-lisp && ${write_subdir} rm -rf ${ns_appresdir}/share endif diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in index 5e3465315af..89318a1efa8 100644 --- a/nextstep/Makefile.in +++ b/nextstep/Makefile.in @@ -71,11 +71,11 @@ ${ns_appbindir}/Emacs: ${MKDIR_P} ${ns_appbindir} cp -f ../src/emacs${EXEEXT} $@ -# FIXME: Don't install the dump file into the app bundle when -# self-contained install is disabled. ${ns_applibexecdir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}.pdmp ${MKDIR_P} ${ns_applibexecdir} +ifeq (${ns_self_contained},no) cp -f ../src/emacs${EXEEXT}.pdmp $@ +endif .PHONY: FORCE commit dad3afb7eb55932f7273a15895670e818fe144bd Author: Po Lu Date: Thu Sep 21 09:26:00 2023 +0800 ; * src/android.c (android_damage_window): Remove unused variable. diff --git a/src/android.c b/src/android.c index 6142f2be8ff..0996a84823d 100644 --- a/src/android.c +++ b/src/android.c @@ -5290,7 +5290,7 @@ android_lock_bitmap (android_window drawable, android_damage_window (android_drawable handle, struct android_rectangle *damage) { - jobject drawable, rect; + jobject drawable; drawable = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); commit 19857b51b0e04d62d7e82fa285db2f40dfbaf75d Author: Po Lu Date: Thu Sep 21 09:13:09 2023 +0800 Update Android port * src/android.c (android_query_tree, android_get_geometry) (android_translate_coordinates, android_wc_lookup_string) (android_get_keysym_name, android_browse_url) (android_query_battery): * src/androidmenu.c (android_dismiss_menu, android_menu_show): Circumvent JNI dynamic method dispatch overhead. diff --git a/src/android.c b/src/android.c index 4caaf377781..6142f2be8ff 100644 --- a/src/android.c +++ b/src/android.c @@ -4963,15 +4963,17 @@ android_query_tree (android_window handle, android_window *root_return, jsize nelements, i; android_window *children; jshort *shorts; + jmethodID method; window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); /* window can be NULL, so this is a service method. */ + method = service_class.query_tree; array - = (*android_java_env)->CallObjectMethod (android_java_env, - emacs_service, - service_class.query_tree, - window); + = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, + emacs_service, + service_class.class, + method, window); android_exception_check (); /* The first element of the array is the parent window. The rest @@ -5024,9 +5026,10 @@ android_get_geometry (android_window handle, get_geometry = window_class.get_window_geometry; window_geometry - = (*android_java_env)->CallObjectMethod (android_java_env, - window, - get_geometry); + = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, + window, + window_class.class, + get_geometry); android_exception_check (); /* window_geometry is an array containing x, y, width and @@ -5084,9 +5087,11 @@ android_translate_coordinates (android_window src, int x, window = android_resolve_handle (src, ANDROID_HANDLE_WINDOW); method = window_class.translate_coordinates; coordinates - = (*android_java_env)->CallObjectMethod (android_java_env, - window, method, - (jint) x, (jint) y); + = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, + window, + window_class.class, + method, (jint) x, + (jint) y); android_exception_check (); /* The array must contain two elements: X, Y translated to the root @@ -5124,7 +5129,9 @@ android_wc_lookup_string (android_key_pressed_event *event, const jchar *characters; jsize size; size_t i; + JNIEnv *env; + env = android_java_env; status = ANDROID_LOOKUP_NONE; rc = 0; @@ -5175,9 +5182,10 @@ android_wc_lookup_string (android_key_pressed_event *event, { window = android_handles[event->window].handle; string - = (*android_java_env)->CallObjectMethod (android_java_env, window, - window_class.lookup_string, - (jint) event->serial); + = (*env)->CallNonvirtualObjectMethod (env, window, + window_class.class, + window_class.lookup_string, + (jint) event->serial); android_exception_check (); if (!string) @@ -5185,13 +5193,11 @@ android_wc_lookup_string (android_key_pressed_event *event, else { /* Now return this input method string. */ - characters = (*android_java_env)->GetStringChars (android_java_env, - string, NULL); + characters = (*env)->GetStringChars (env, string, NULL); android_exception_check_nonnull ((void *) characters, string); - /* Figure out how big the string is. */ - size = (*android_java_env)->GetStringLength (android_java_env, - string); + /* Establish the size of the the string. */ + size = (*env)->GetStringLength (env, string); /* Copy over the string data. */ for (i = 0; i < MIN ((unsigned int) wchars_buffer, size); ++i) @@ -5210,8 +5216,7 @@ android_wc_lookup_string (android_key_pressed_event *event, else rc = size; - (*android_java_env)->ReleaseStringChars (android_java_env, string, - characters); + (*env)->ReleaseStringChars (env, string, characters); ANDROID_DELETE_LOCAL_REF (string); } } @@ -5425,11 +5430,15 @@ android_get_keysym_name (int keysym, char *name_return, size_t size) { jobject string; const char *buffer; + jmethodID method; - string = (*android_java_env)->CallObjectMethod (android_java_env, - emacs_service, - service_class.name_keysym, - (jint) keysym); + method = service_class.name_keysym; + string + = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, + emacs_service, + service_class.class, + method, + (jint) keysym); android_exception_check (); buffer = (*android_java_env)->GetStringUTFChars (android_java_env, @@ -6136,11 +6145,13 @@ android_browse_url (Lisp_Object url, Lisp_Object send) const char *buffer; string = android_build_string (url); - value = (*android_java_env)->CallObjectMethod (android_java_env, - emacs_service, - service_class.browse_url, - string, - (jboolean) !NILP (send)); + value + = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, + emacs_service, + service_class.class, + service_class.browse_url, + string, + (jboolean) !NILP (send)); android_exception_check (); ANDROID_DELETE_LOCAL_REF (string); @@ -6205,10 +6216,14 @@ android_query_battery (struct android_battery_state *status) { jlongArray array; jlong *longs; + jmethodID method; - array = (*android_java_env)->CallObjectMethod (android_java_env, - emacs_service, - service_class.query_battery); + method = service_class.query_battery; + array + = (*android_java_env)->CallNonvirtualObjectMethod (android_java_env, + emacs_service, + service_class.class, + method); android_exception_check (); /* A NULL return with no exception means that battery information diff --git a/src/androidmenu.c b/src/androidmenu.c index 70452b5dab0..3b34f032c35 100644 --- a/src/androidmenu.c +++ b/src/androidmenu.c @@ -162,10 +162,11 @@ android_dismiss_menu (void *pointer) struct android_dismiss_menu_data *data; data = pointer; - (*android_java_env)->CallVoidMethod (android_java_env, - data->menu, - menu_class.dismiss, - data->window); + (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, + data->menu, + menu_class.class, + menu_class.dismiss, + data->window); popup_activated_flag = 0; } @@ -362,14 +363,12 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, pane_string++; /* Add the pane. */ - temp = (*android_java_env)->NewStringUTF (android_java_env, - pane_string); + temp = (*env)->NewStringUTF (env, pane_string); android_exception_check (); - (*android_java_env)->CallVoidMethod (android_java_env, - current_context_menu, - menu_class.add_pane, - temp); + (*env)->CallNonvirtualVoidMethod (env, current_context_menu, + menu_class.class, + menu_class.add_pane, temp); android_exception_check (); ANDROID_DELETE_LOCAL_REF (temp); commit ef8458558d5d3b95c88e71ec88feb7f950e44b7e Author: João Távora Date: Thu Sep 21 01:13:50 2023 +0100 Flymake: fix eol overlay flicker due to untimely overlay deletion This commit helps in ensuring that `flymake--eol-overlay-update' is only called once per cycle. * lisp/progmodes/flymake.el (flymake--delete-overlay): Don't delete eol overlay here. (flymake--eol-overlay-summary): Rework again. (flymake--eol-overlay-update): Delete eol overlay here. (flymake-start): Make sure to set all backends reported-p to nil. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 80aa7e0a30e..1b232050855 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -699,14 +699,13 @@ flymake--delete-overlay (let ((eolov (overlay-get ov 'eol-ov))) (when eolov (let ((src-ovs (delq ov (overlay-get eolov 'flymake-eol-source-overlays)))) - (if src-ovs (overlay-put eolov 'flymake-eol-source-overlays src-ovs) - (delete-overlay eolov)))) + (overlay-put eolov 'flymake-eol-source-overlays src-ovs))) (delete-overlay ov))) -(defun flymake--eol-overlay-summary (eolov) - "Helper function for `flymake--highlight-line'." +(defun flymake--eol-overlay-summary (src-ovs) + "Helper function for `flymake--eol-overlay-update'." (cl-loop - for s in (overlay-get eolov 'flymake-eol-source-overlays) + for s in src-ovs for d = (overlay-get s 'flymake-diagnostic) for type = (flymake--diag-type d) for eol-face = (flymake--lookup-type-property type 'eol-face) @@ -722,8 +721,10 @@ flymake--eol-overlay-update (save-excursion (widen) (cl-loop for o in (overlays-in (point-min) (point-max)) - when (overlay-get o 'flymake--eol-overlay) - do (overlay-put o 'before-string (flymake--eol-overlay-summary o))))) + for src-ovs = (overlay-get o 'flymake-eol-source-overlays) + if src-ovs + do (overlay-put o 'before-string (flymake--eol-overlay-summary src-ovs)) + else do (delete-overlay o)))) (cl-defun flymake--highlight-line (diagnostic &optional foreign) "Attempt to overlay DIAGNOSTIC in current buffer. @@ -1187,6 +1188,11 @@ flymake-start (cl-reduce #'max (mapcar #'cadr flymake--recent-changes)))))) (setq flymake--recent-changes nil) + (run-hook-wrapped + 'flymake-diagnostic-functions + (lambda (backend) + (flymake--with-backend-state backend state + (setf (flymake--state-reported-p state) nil)))) (run-hook-wrapped 'flymake-diagnostic-functions (lambda (backend) commit f35818f2e762d5aec5cdd62b3fe778060812a0b5 Author: João Távora Date: Thu Sep 21 00:27:07 2023 +0100 Flymake: more fixes to the end-of-line overlays bug#66041 * lisp/progmodes/flymake.el (flymake--eol-overlay-summary): Rework. (flymake--eol-overlay-update): Rework. (flymake--highlight-line): Simplify. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 7cb1f222c22..80aa7e0a30e 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -703,24 +703,27 @@ flymake--delete-overlay (delete-overlay eolov)))) (delete-overlay ov))) -(defun flymake--eol-overlay-summary (_eolov src-ovs) +(defun flymake--eol-overlay-summary (eolov) "Helper function for `flymake--highlight-line'." (cl-loop - for s in src-ovs + for s in (overlay-get eolov 'flymake-eol-source-overlays) for d = (overlay-get s 'flymake-diagnostic) for type = (flymake--diag-type d) for eol-face = (flymake--lookup-type-property type 'eol-face) concat (propertize (flymake-diagnostic-oneliner d t) 'face eol-face) into retval concat " " into retval - finally (cl-return (concat " " retval)))) + finally + (setq retval (concat " " retval)) + (put-text-property 0 1 'cursor t retval) + (cl-return retval))) (defun flymake--eol-overlay-update () (save-excursion (widen) (cl-loop for o in (overlays-in (point-min) (point-max)) - when (overlay-get o 'flymake--eol-overlay-summary) - do (overlay-put o 'before-string it)))) + when (overlay-get o 'flymake--eol-overlay) + do (overlay-put o 'before-string (flymake--eol-overlay-summary o))))) (cl-defun flymake--highlight-line (diagnostic &optional foreign) "Attempt to overlay DIAGNOSTIC in current buffer. @@ -844,21 +847,17 @@ flymake--highlight-line (eolov (car (cl-remove-if-not (lambda (o) (overlay-get o 'flymake-eol-source-overlays)) - (overlays-in start end)))) - src-ovs - summary) + (overlays-in start end))))) ;; FIXME: 1. no checking if there are unexpectedly more than ;; one eolov at point. (if eolov - (setq src-ovs (push ov (overlay-get eolov 'flymake-eol-source-overlays))) + (push ov (overlay-get eolov 'flymake-eol-source-overlays)) (setq eolov (make-overlay start end nil t nil)) (overlay-put eolov 'flymake-overlay t) - (setq src-ovs (overlay-put eolov 'flymake-eol-source-overlays (list ov))) + (overlay-put eolov 'flymake--eol-overlay t) + (overlay-put eolov 'flymake-eol-source-overlays (list ov)) (overlay-put eolov 'evaporate (not (= start end)))) ; FIXME: fishy - (overlay-put ov 'eol-ov eolov) - (setq summary (flymake--eol-overlay-summary eolov src-ovs)) - (put-text-property 0 1 'cursor t summary) - (overlay-put eolov 'flymake--eol-overlay-summary summary)))) + (overlay-put ov 'eol-ov eolov)))) ov)) ;; Nothing in Flymake uses this at all any more, so this is just for @@ -971,8 +970,9 @@ flymake--handle-report ;; a call to update them. But check running and reporting ;; backends first to flickering when multiple backends touch the ;; same eol overlays. - (unless (cl-set-difference (flymake-running-backends) - (flymake-reporting-backends)) + (when (and flymake-show-diagnostics-at-end-of-line + (not (cl-set-difference (flymake-running-backends) + (flymake-reporting-backends)))) (flymake--eol-overlay-update)) (flymake--update-diagnostics-listings (current-buffer)))) commit 4da3ff1f0cc4eec6fa3780a73edb428f5b1e898a Author: João Távora Date: Thu Sep 21 00:05:07 2023 +0100 Flymake: do use condition-case-unless-debug The reasons previously highlighted in the FIXME either don't apply anymore or don't outweigh the advantages of using this macro. * lisp/progmodes/flymake.el (flymake--run-backend): Do use condition-case-unless-debug. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 30dc749349b..7cb1f222c22 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1120,15 +1120,7 @@ flymake--run-backend (setf (flymake--state-running state) run-token (flymake--state-disabled state) nil (flymake--state-reported-p state) nil)) - ;; FIXME: Should use `condition-case-unless-debug' here, but don't - ;; for two reasons: (1) that won't let me catch errors from inside - ;; `ert-deftest' where `debug-on-error' appears to be always - ;; t. (2) In cases where the user is debugging elisp somewhere - ;; else, and using flymake, the presence of a frequently - ;; misbehaving backend in the global hook (most likely the legacy - ;; backend) will trigger an annoying backtrace. - ;; - (condition-case err + (condition-case-unless-debug err (apply backend (flymake-make-report-fn backend run-token) args) (error commit 8b1947ffdd9d9eae26a308f0abaac45e06baac22 Author: João Távora Date: Thu Sep 21 00:03:32 2023 +0100 Flymake: more fixes to flymake--highlight-line Make it robust to diagonstics with invalid bounds. * lisp/progmodes/flymake.el (flymake--highlight-line): Robustify. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 1f55df47a46..30dc749349b 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -757,9 +757,9 @@ flymake--highlight-line (setq beg a end b)))) (setf (flymake--diag-beg diagnostic) beg (flymake--diag-end diagnostic) end) - ;; Try to fix the remedy the situation if there is the same - ;; diagnostic is already registered in the same place, which only - ;; happens for clashes between domestic and foreign diagnostics + ;; Try to remedy the situation if the same diagnostic is already + ;; registered in the same place. This happens for clashes between + ;; domestic and foreign diagnostics (cl-loop for e in (flymake-diagnostics beg end) for eov = (flymake--diag-overlay e) when (flymake--equal-diagnostic-p e diagnostic) @@ -778,7 +778,12 @@ flymake--highlight-line (flymake--diag-end e) (flymake--diag-orig-end e)) (flymake--delete-overlay eov))) - (setq ov (make-overlay end beg)) + (setq ov (make-overlay beg end)) + (when (= (overlay-start ov) (overlay-end ov)) + ;; Some backends report diagnostics with invalid bounds. Don't + ;; bother. + (delete-overlay ov) + (cl-return-from flymake--highlight-line nil)) (setf (flymake--diag-beg diagnostic) (overlay-start ov) (flymake--diag-end diagnostic) (overlay-end ov)) ;; First set `category' in the overlay commit e0ce4409b22b822560dd162c9145f5310568fcf9 Author: João Távora Date: Wed Sep 20 22:30:25 2023 +0100 Flymake: Fix bug in flymake-diagnostics * lisp/progmodes/flymake.el (flymake-diagnostics): Fix bug. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 269440fd8e1..1f55df47a46 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -356,7 +356,10 @@ flymake-diagnostics diagnostics at BEG." (save-restriction (widen) - (cl-loop for o in (overlays-in (or beg (point-min)) (or end (point-max))) + (cl-loop for o in + (cond (end (overlays-in beg end)) + (beg (overlays-at beg)) + (t (overlays-in (point-min) (point-max)))) when (overlay-get o 'flymake-diagnostic) collect it))) (defmacro flymake--diag-accessor (public internal thing) commit d989d14e131a6fd145d86a9fcff5531e86fbc592 Author: Jim Porter Date: Wed Sep 20 14:55:34 2023 +0100 Flymake: use 'compilation-info' as basis for "note" faces bug#66041 * lisp/progmodes/flymake.el (flymake-note-echo) (flymake-note-echo-at-eol): Inherit from 'compilation-info'. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 0d6722728d0..269440fd8e1 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -433,7 +433,7 @@ flymake-warning-echo :package-version '(Flymake . "1.3.4")) (defface flymake-note-echo - '((t :inherit flymake-note)) + '((t :inherit compilation-info)) "Face used for showing summarized descriptions of notes." :package-version '(Flymake . "1.3.4")) @@ -454,7 +454,7 @@ flymake-warning-echo-at-eol :package-version '(Flymake . "1.3.5")) (defface flymake-note-echo-at-eol - '((t :inherit (flymake-end-of-line-diagnostics-face flymake-note))) + '((t :inherit (flymake-end-of-line-diagnostics-face compilation-info))) "Face like `flymake-note-echo', but for end-of-line overlays." :package-version '(Flymake . "1.3.5")) commit f931cebce76d911dfc61274e0a8c1de3627b9179 Author: Alan Mackenzie Date: Wed Sep 20 15:51:17 2023 +0000 Insert symbol `debug' into two condition-case handlers This fixes bug#65622. Also correct a mismatch between a function to which advice is added, and that from which it is removed. * lisp/emacs-lisp/macroexp.el (internal-macroexpand-for-load): Add a `debug' to the condition-case handler for `error', so that a useful backtrace will be produced on a macro expansion error. * lisp/progmodes/elisp-mode.el (elisp--local-variables): Add `debug' to a condition-case handler, as above. In the advice-remove call, give the same function, macroexpand-1, as in the corresponding advice-add call. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index b21f0f0d47f..f96e0d74026 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -812,7 +812,7 @@ internal-macroexpand-for-load (if full-p (macroexpand--all-toplevel form) (macroexpand form))) - (error + ((debug error) ;; Hopefully this shouldn't happen thanks to the cycle detection, ;; but in case it does happen, let's catch the error and give the ;; code a chance to macro-expand later. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 8a12a154f72..664299df288 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -456,14 +456,14 @@ elisp--local-variables (lambda (expander form &rest args) (condition-case err (apply expander form args) - (error (message "Ignoring macroexpansion error: %S" err) - form)))) + ((debug error) + (message "Ignoring macroexpansion error: %S" err) form)))) (sexp (unwind-protect (let ((warning-minimum-log-level :emergency)) (advice-add 'macroexpand-1 :around macroexpand-advice) (macroexpand-all sexp elisp--local-macroenv)) - (advice-remove 'macroexpand macroexpand-advice))) + (advice-remove 'macroexpand-1 macroexpand-advice))) (vars (elisp--local-variables-1 nil sexp))) (delq nil (mapcar (lambda (var) commit 5792ea14ad69ae1ed5584dff8c9b7d5ee702aaed Author: João Távora Date: Wed Sep 20 14:45:24 2023 +0100 Flymake: fix many problems with the end-of-line overlays bug#66041 * lisp/progmodes/flymake.el (flymake-diagnostics): Rewrite. (flymake--really-all-overlays): Rename from flymake--overlays. (flymake--delete-overlay): Complexify. (flymake--highlight-line): Rework. (flymake--handle-report): Update eol overlays (flymake-mode): use flymake--really-all-overlays. (flymake-after-change-function): Simplify. (flymake-goto-next-error): Don't use flymake--overlays. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index b044a661911..0d6722728d0 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -354,8 +354,10 @@ flymake-diagnostics If neither BEG or END is supplied, use whole accessible buffer, otherwise if BEG is non-nil and END is nil, consider only diagnostics at BEG." - (mapcar (lambda (ov) (overlay-get ov 'flymake-diagnostic)) - (flymake--overlays :beg beg :end end))) + (save-restriction + (widen) + (cl-loop for o in (overlays-in (or beg (point-min)) (or end (point-max))) + when (overlay-get o 'flymake-diagnostic) collect it))) (defmacro flymake--diag-accessor (public internal thing) "Make PUBLIC an alias for INTERNAL, add doc using THING." @@ -385,7 +387,7 @@ flymake-diagnostic-oneliner (flymake--lookup-type-property (flymake-diagnostic-type diag) 'echo-face 'flymake-error))))) -(cl-defun flymake--overlays (&key beg end filter compare key) +(cl-defun flymake--really-all-overlays () "Get flymake-related overlays. If BEG is non-nil and END is nil, consider only `overlays-at' BEG. Otherwise consider `overlays-in' the region comprised by BEG @@ -393,19 +395,8 @@ flymake--overlays verify FILTER, a function, and sort them by COMPARE (using KEY)." (save-restriction (widen) - (let ((ovs (cl-remove-if-not - (lambda (ov) - (and (overlay-get ov 'flymake-diagnostic) - (or (not filter) - (funcall filter ov)))) - (if (and beg (null end)) - (overlays-at beg t) - (overlays-in (or beg (point-min)) - (or end (point-max))))))) - (if compare - (cl-sort ovs compare :key (or key - #'identity)) - ovs)))) + (cl-remove-if-not (lambda (o) (overlay-get o 'flymake-overlay)) + (overlays-in (point-min) (point-max))))) (defface flymake-error '((((supports :underline (:style wave))) @@ -703,9 +694,31 @@ flymake--equal-diagnostic-p (defun flymake--delete-overlay (ov) "Like `delete-overlay', delete OV, but do some more stuff." (let ((eolov (overlay-get ov 'eol-ov))) - (when eolov (delete-overlay eolov)) + (when eolov + (let ((src-ovs (delq ov (overlay-get eolov 'flymake-eol-source-overlays)))) + (if src-ovs (overlay-put eolov 'flymake-eol-source-overlays src-ovs) + (delete-overlay eolov)))) (delete-overlay ov))) +(defun flymake--eol-overlay-summary (_eolov src-ovs) + "Helper function for `flymake--highlight-line'." + (cl-loop + for s in src-ovs + for d = (overlay-get s 'flymake-diagnostic) + for type = (flymake--diag-type d) + for eol-face = (flymake--lookup-type-property type 'eol-face) + concat (propertize (flymake-diagnostic-oneliner d t) 'face eol-face) into retval + concat " " + into retval + finally (cl-return (concat " " retval)))) + +(defun flymake--eol-overlay-update () + (save-excursion + (widen) + (cl-loop for o in (overlays-in (point-min) (point-max)) + when (overlay-get o 'flymake--eol-overlay-summary) + do (overlay-put o 'before-string it)))) + (cl-defun flymake--highlight-line (diagnostic &optional foreign) "Attempt to overlay DIAGNOSTIC in current buffer. @@ -779,39 +792,6 @@ flymake--highlight-line (flymake--lookup-type-property type 'flymake-overlay-control)) (alist-get type flymake-diagnostic-types-alist)) do (overlay-put ov ov-prop value)) - ;; Handle `flymake-show-diagnostics-at-end-of-line' - ;; - (when-let ((eol-face (and flymake-show-diagnostics-at-end-of-line - (flymake--lookup-type-property type 'eol-face)))) - (save-excursion - (goto-char (overlay-start ov)) - (let* ((start (line-end-position)) - (end (min (1+ start) (point-max))) - (eolov (car - (cl-remove-if-not - (lambda (o) (overlay-get o 'flymake-eol-source-region)) - (overlays-at start)))) - (bs (flymake-diagnostic-oneliner diagnostic t))) - (setq bs (propertize bs 'face eol-face)) - ;; FIXME: 1. no checking if there are unexpectedly more than - ;; one eolov at point. 2. The first regular source ov to - ;; die also kills the eolov (very rare this matters, but - ;; could be improved). - (cond (eolov - (overlay-put eolov 'before-string - (concat (overlay-get eolov 'before-string) " " bs)) - (let ((e (overlay-get eolov 'flymake-eol-source-region))) - (setcar e (min (car e) (overlay-start ov))) - (setcdr e (max (cdr e) (overlay-end ov))))) - (t - (setq eolov (make-overlay start end nil t nil)) - (setq bs (concat " " bs)) - (put-text-property 0 1 'cursor t bs) - (overlay-put eolov 'before-string bs) - (overlay-put eolov 'evaporate (not (= start end))) - (overlay-put eolov 'flymake-eol-source-region - (cons (overlay-start ov) (overlay-end ov))) - (overlay-put ov 'eol-ov eolov)))))) ;; Now ensure some essential defaults are set ;; (cl-flet ((default-maybe @@ -843,8 +823,34 @@ flymake--highlight-line ;; Some properties can't be overridden. ;; (overlay-put ov 'evaporate t) + (overlay-put ov 'flymake-overlay t) (overlay-put ov 'flymake-diagnostic diagnostic) (setf (flymake--diag-overlay diagnostic) ov) + ;; Handle `flymake-show-diagnostics-at-end-of-line' + ;; + (when flymake-show-diagnostics-at-end-of-line + (save-excursion + (goto-char (overlay-start ov)) + (let* ((start (line-end-position)) + (end (min (1+ start) (point-max))) + (eolov (car + (cl-remove-if-not + (lambda (o) (overlay-get o 'flymake-eol-source-overlays)) + (overlays-in start end)))) + src-ovs + summary) + ;; FIXME: 1. no checking if there are unexpectedly more than + ;; one eolov at point. + (if eolov + (setq src-ovs (push ov (overlay-get eolov 'flymake-eol-source-overlays))) + (setq eolov (make-overlay start end nil t nil)) + (overlay-put eolov 'flymake-overlay t) + (setq src-ovs (overlay-put eolov 'flymake-eol-source-overlays (list ov))) + (overlay-put eolov 'evaporate (not (= start end)))) ; FIXME: fishy + (overlay-put ov 'eol-ov eolov) + (setq summary (flymake--eol-overlay-summary eolov src-ovs)) + (put-text-property 0 1 'cursor t summary) + (overlay-put eolov 'flymake--eol-overlay-summary summary)))) ov)) ;; Nothing in Flymake uses this at all any more, so this is just for @@ -953,6 +959,13 @@ flymake--handle-report (float-time (time-since flymake-check-start-time)))))) (setf (flymake--state-reported-p state) t) + ;; All of the above might have touched the eol overlays, so issue + ;; a call to update them. But check running and reporting + ;; backends first to flickering when multiple backends touch the + ;; same eol overlays. + (unless (cl-set-difference (flymake-running-backends) + (flymake-reporting-backends)) + (flymake--eol-overlay-update)) (flymake--update-diagnostics-listings (current-buffer)))) (defun flymake--clear-foreign-diags (state) @@ -1244,7 +1257,7 @@ flymake-mode ;; existing diagnostic overlays, lest we forget them by blindly ;; reinitializing `flymake--state' in the next line. ;; See https://github.com/joaotavora/eglot/issues/223. - (mapc #'flymake--delete-overlay (flymake--overlays)) + (mapc #'flymake--delete-overlay (flymake--really-all-overlays)) (setq flymake--state (make-hash-table)) (setq flymake--recent-changes nil) @@ -1291,7 +1304,7 @@ flymake-mode (when flymake-timer (cancel-timer flymake-timer) (setq flymake-timer nil)) - (mapc #'flymake--delete-overlay (flymake--overlays)) + (mapc #'flymake--delete-overlay (flymake--really-all-overlays)) (when flymake--state (maphash (lambda (_backend state) (flymake--clear-foreign-diags state)) @@ -1351,8 +1364,10 @@ flymake-after-change-function (when-let* ((probe (search-forward "\n" stop t)) (eolovs (cl-remove-if-not (lambda (o) - (let ((reg (overlay-get o 'flymake-eol-source-region))) - (and reg (< (car reg) (1- probe))))) + (let ((lbound + (cl-loop for s in (overlay-get o 'flymake-eol-source-overlays) + minimizing (overlay-start s)))) + (and lbound (< lbound (1- probe))))) (overlays-at (line-end-position))))) (goto-char start) (let ((newend (line-end-position))) @@ -1401,20 +1416,17 @@ flymake-goto-next-error '(:error :warning)) t)) (let* ((n (or n 1)) - (ovs (flymake--overlays :filter - (lambda (ov) - (let ((diag (overlay-get - ov - 'flymake-diagnostic))) - (and diag - (or - (not filter) - (cl-find - (flymake--severity - (flymake-diagnostic-type diag)) - filter :key #'flymake--severity))))) - :compare (if (cl-plusp n) #'< #'>) - :key #'overlay-start)) + (ovs (cl-loop + for o in (overlays-in (point-min) (point-max)) + for diag = (overlay-get o 'flymake-diagnostic) + when (and diag (or (not filter) (cl-find + (flymake--severity + (flymake-diagnostic-type diag)) + filter :key #'flymake--severity))) + collect o into retval + finally (cl-return + (cl-sort retval (if (cl-plusp n) #'< #'>) + :key #'overlay-start)))) (tail (cl-member-if (lambda (ov) (if (cl-plusp n) (> (overlay-start ov) commit ea12230039c23160077b6928fb7a04dd38c4d5f7 Author: Andrea Corallo Date: Wed Sep 20 12:08:02 2023 +0200 * lisp/emacs-lisp/comp.el (comp-compute-dominator-tree): Simplify. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 37771eb004e..181e5ca96a1 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2918,7 +2918,7 @@ comp-compute-dominator-tree finger2 (comp-block-post-num b2)))) b1)) (first-processed (l) - (if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l))) + (if-let ((p (cl-find-if #'comp-block-idom l))) p (signal 'native-ice '("can't find first preprocessed"))))) commit 76cdf293c480c3825eb99eae0ab863d185cf6570 Author: João Távora Date: Wed Sep 20 11:00:19 2023 +0100 Eglot: better consider diagnostics at point on code action requests * lisp/progmodes/eglot.el (eglot--code-action-bounds): Rename from eglot--code-action-bounds. Rework to consider diagnostics. (eglot-code-actions): Use new eglot--code-action-bounds. (eglot--code-action): Use new eglot--code-action-bounds. * etc/EGLOT-NEWS: mention change. GitHub-reference: https://github.com/joaotavora/eglot/discussions/1295 diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index ffc8095f752..f5f78ccd483 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -43,6 +43,13 @@ For 'newline' commands, Eglot sometimes sent the wrong character code to the server. Also made this feature less chatty in the mode-line and messages buffer. +** Improve mouse invocation of code actions + +When invoking code actions by middle clicking with the mouse on +Flymake diagnostics, it was often the case that Eglot didn't request +code actions correctly and thus no actions were offered to the user. +This has been fixed. github#1295 + * Changes in Eglot 1.15 (29/4/2023) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 79b3dbb2994..e511df01850 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3579,11 +3579,18 @@ eglot-rename :newName ,newname)) this-command)) -(defun eglot--region-bounds () - "Region bounds if active, else bounds of things at point." - (if (use-region-p) `(,(region-beginning) ,(region-end)) - (let ((boftap (bounds-of-thing-at-point 'sexp))) - (list (car boftap) (cdr boftap))))) +(defun eglot--code-action-bounds () + "Calculate appropriate bounds depending on region and point." + (let (diags) + (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)))) + (t + (let ((boftap (bounds-of-thing-at-point 'sexp))) + (list (car boftap) (cdr boftap))))))) (defun eglot-code-actions (beg &optional end action-kind interactive) "Find LSP code actions of type ACTION-KIND between BEG and END. @@ -3593,7 +3600,7 @@ eglot-code-actions point and END is nil, which results in a request for code actions at point. With prefix argument, prompt for ACTION-KIND." (interactive - `(,@(eglot--region-bounds) + `(,@(eglot--code-action-bounds) ,(and current-prefix-arg (completing-read "[eglot] Action kind: " '("quickfix" "refactor.extract" "refactor.inline" @@ -3656,7 +3663,7 @@ eglot--code-action "Define NAME to execute KIND code action." `(defun ,name (beg &optional end) ,(format "Execute `%s' code actions between BEG and END." kind) - (interactive (eglot--region-bounds)) + (interactive (eglot--code-action-bounds)) (eglot-code-actions beg end ,kind t))) (eglot--code-action eglot-code-action-organize-imports "source.organizeImports") commit f0794ac9cafb8354119ef0052c67f092ed059eb4 Author: Mattias Engdegård Date: Wed Sep 20 11:22:17 2023 +0200 Re-enable -Wswitch when building with Clang * configure.ac (WERROR_CFLAGS): Remove -Wno-switch, inserted a decade ago but doesn't seem to be needed now. Please tell me if you observe otherwise. diff --git a/configure.ac b/configure.ac index 7ca75be996d..855c4ec7df1 100644 --- a/configure.ac +++ b/configure.ac @@ -1713,7 +1713,6 @@ AC_DEFUN AS_IF([test "$emacs_cv_clang" = yes], [ # Turn off some warnings if supported. - gl_WARN_ADD([-Wno-switch]) gl_WARN_ADD([-Wno-pointer-sign]) gl_WARN_ADD([-Wno-string-plus-int]) gl_WARN_ADD([-Wno-unknown-attributes]) commit a82785e29785f070465c5db10953ecebca49e257 Author: Mattias Engdegård Date: Wed Sep 20 10:34:12 2023 +0200 Reorder type tests for efficiency * src/fns.c (Flength, Fdelete, Fnreverse): Test types in descending order of frequency, roughly. diff --git a/src/fns.c b/src/fns.c index 4731e416125..a3f89637dfd 100644 --- a/src/fns.c +++ b/src/fns.c @@ -141,6 +141,10 @@ DEFUN ("length", Flength, Slength, 1, 1, 0, if (STRINGP (sequence)) val = SCHARS (sequence); + else if (CONSP (sequence)) + val = list_length (sequence); + else if (NILP (sequence)) + val = 0; else if (VECTORP (sequence)) val = ASIZE (sequence); else if (CHAR_TABLE_P (sequence)) @@ -149,10 +153,6 @@ DEFUN ("length", Flength, Slength, 1, 1, 0, val = bool_vector_size (sequence); else if (COMPILEDP (sequence) || RECORDP (sequence)) val = PVSIZE (sequence); - else if (CONSP (sequence)) - val = list_length (sequence); - else if (NILP (sequence)) - val = 0; else wrong_type_argument (Qsequencep, sequence); @@ -2104,7 +2104,27 @@ DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0, does not modify the argument. */) (Lisp_Object elt, Lisp_Object seq) { - if (VECTORP (seq)) + if (NILP (seq)) + ; + else if (CONSP (seq)) + { + Lisp_Object prev = Qnil, tail = seq; + + FOR_EACH_TAIL (tail) + { + if (!NILP (Fequal (elt, XCAR (tail)))) + { + if (NILP (prev)) + seq = XCDR (tail); + else + Fsetcdr (prev, XCDR (tail)); + } + else + prev = tail; + } + CHECK_LIST_END (tail, seq); + } + else if (VECTORP (seq)) { ptrdiff_t n = 0; ptrdiff_t size = ASIZE (seq); @@ -2193,23 +2213,7 @@ DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0, } } else - { - Lisp_Object prev = Qnil, tail = seq; - - FOR_EACH_TAIL (tail) - { - if (!NILP (Fequal (elt, XCAR (tail)))) - { - if (NILP (prev)) - seq = XCDR (tail); - else - Fsetcdr (prev, XCDR (tail)); - } - else - prev = tail; - } - CHECK_LIST_END (tail, seq); - } + wrong_type_argument (Qsequencep, seq); return seq; } @@ -2222,8 +2226,6 @@ DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0, { if (NILP (seq)) return seq; - else if (STRINGP (seq)) - return Freverse (seq); else if (CONSP (seq)) { Lisp_Object prev, tail, next; @@ -2263,6 +2265,8 @@ DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0, bool_vector_set (seq, size - i - 1, tem); } } + else if (STRINGP (seq)) + return Freverse (seq); else wrong_type_argument (Qarrayp, seq); return seq; commit 054fc8a5e030d19d3c041391369d727d10287c50 Author: Mattias Engdegård Date: Tue Sep 19 21:48:19 2023 +0200 * src/alloc.c: (cleanup_vector) Dispatch on pseudovector type Enable the compiler to generate a jump table instead of a chain of conditional branches. diff --git a/src/alloc.c b/src/alloc.c index addbb54e01f..67b39c5e57d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3328,93 +3328,134 @@ #define PSEUDOVEC_STRUCT(p, t) \ cleanup_vector (struct Lisp_Vector *vector) { detect_suspicious_free (vector); - - if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BIGNUM)) - mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value); - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_OVERLAY)) - { - struct Lisp_Overlay *ol = PSEUDOVEC_STRUCT (vector, Lisp_Overlay); - xfree (ol->interval); - } - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FINALIZER)) - unchain_finalizer (PSEUDOVEC_STRUCT (vector, Lisp_Finalizer)); - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)) + if ((vector->header.size & PSEUDOVECTOR_FLAG) == 0) + return; /* nothing more to do for plain vectors */ + switch (PSEUDOVECTOR_TYPE (vector)) { - if ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX) - { - struct font *font = PSEUDOVEC_STRUCT (vector, font); - struct font_driver const *drv = font->driver; + case PVEC_BIGNUM: + mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value); + break; + case PVEC_OVERLAY: + { + struct Lisp_Overlay *ol = PSEUDOVEC_STRUCT (vector, Lisp_Overlay); + xfree (ol->interval); + } + break; + case PVEC_FINALIZER: + unchain_finalizer (PSEUDOVEC_STRUCT (vector, Lisp_Finalizer)); + break; + case PVEC_FONT: + { + if ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX) + { + struct font *font = PSEUDOVEC_STRUCT (vector, font); + struct font_driver const *drv = font->driver; - /* The font driver might sometimes be NULL, e.g. if Emacs was - interrupted before it had time to set it up. */ - if (drv) - { - /* Attempt to catch subtle bugs like Bug#16140. */ - eassert (valid_font_driver (drv)); - drv->close_font (font); - } - } + /* The font driver might sometimes be NULL, e.g. if Emacs was + interrupted before it had time to set it up. */ + if (drv) + { + /* Attempt to catch subtle bugs like Bug#16140. */ + eassert (valid_font_driver (drv)); + drv->close_font (font); + } + } #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY - /* The Android font driver needs the ability to associate extra - information with font entities. */ - if (((vector->header.size & PSEUDOVECTOR_SIZE_MASK) - == FONT_ENTITY_MAX) - && PSEUDOVEC_STRUCT (vector, font_entity)->is_android) - android_finalize_font_entity (PSEUDOVEC_STRUCT (vector, font_entity)); + /* The Android font driver needs the ability to associate extra + information with font entities. */ + if (((vector->header.size & PSEUDOVECTOR_SIZE_MASK) + == FONT_ENTITY_MAX) + && PSEUDOVEC_STRUCT (vector, font_entity)->is_android) + android_finalize_font_entity (PSEUDOVEC_STRUCT (vector, font_entity)); #endif - } - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD)) - finalize_one_thread (PSEUDOVEC_STRUCT (vector, thread_state)); - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX)) - finalize_one_mutex (PSEUDOVEC_STRUCT (vector, Lisp_Mutex)); - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR)) - finalize_one_condvar (PSEUDOVEC_STRUCT (vector, Lisp_CondVar)); - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MARKER)) - { + } + break; + case PVEC_THREAD: + finalize_one_thread (PSEUDOVEC_STRUCT (vector, thread_state)); + break; + case PVEC_MUTEX: + finalize_one_mutex (PSEUDOVEC_STRUCT (vector, Lisp_Mutex)); + break; + case PVEC_CONDVAR: + finalize_one_condvar (PSEUDOVEC_STRUCT (vector, Lisp_CondVar)); + break; + case PVEC_MARKER: /* sweep_buffer should already have unchained this from its buffer. */ eassert (! PSEUDOVEC_STRUCT (vector, Lisp_Marker)->buffer); - } - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_USER_PTR)) - { - struct Lisp_User_Ptr *uptr = PSEUDOVEC_STRUCT (vector, Lisp_User_Ptr); - if (uptr->finalizer) - uptr->finalizer (uptr->p); - } + break; + case PVEC_USER_PTR: + { + struct Lisp_User_Ptr *uptr = PSEUDOVEC_STRUCT (vector, Lisp_User_Ptr); + if (uptr->finalizer) + uptr->finalizer (uptr->p); + } + break; + case PVEC_TS_PARSER: +#ifdef HAVE_TREE_SITTER + treesit_delete_parser (PSEUDOVEC_STRUCT (vector, Lisp_TS_Parser)); +#endif + break; + case PVEC_TS_COMPILED_QUERY: #ifdef HAVE_TREE_SITTER - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_TS_PARSER)) - treesit_delete_parser (PSEUDOVEC_STRUCT (vector, Lisp_TS_Parser)); - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_TS_COMPILED_QUERY)) - treesit_delete_query (PSEUDOVEC_STRUCT (vector, Lisp_TS_Query)); + treesit_delete_query (PSEUDOVEC_STRUCT (vector, Lisp_TS_Query)); #endif + break; + case PVEC_MODULE_FUNCTION: #ifdef HAVE_MODULES - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION)) - { - ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function - = (struct Lisp_Module_Function *) vector; - module_finalize_function (function); - } + { + ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function + = (struct Lisp_Module_Function *) vector; + module_finalize_function (function); + } #endif + break; + case PVEC_NATIVE_COMP_UNIT: #ifdef HAVE_NATIVE_COMP - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) - { - struct Lisp_Native_Comp_Unit *cu = - PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); - unload_comp_unit (cu); - } - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR)) - { - struct Lisp_Subr *subr = - PSEUDOVEC_STRUCT (vector, Lisp_Subr); - if (!NILP (subr->native_comp_u)) - { - /* FIXME Alternative and non invasive solution to this - cast? */ - xfree ((char *)subr->symbol_name); - xfree (subr->native_c_name); - } - } + { + struct Lisp_Native_Comp_Unit *cu = + PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); + unload_comp_unit (cu); + } +#endif + break; + case PVEC_SUBR: +#ifdef HAVE_NATIVE_COMP + { + struct Lisp_Subr *subr = PSEUDOVEC_STRUCT (vector, Lisp_Subr); + if (!NILP (subr->native_comp_u)) + { + /* FIXME Alternative and non invasive solution to this cast? */ + xfree ((char *)subr->symbol_name); + xfree (subr->native_c_name); + } + } #endif + break; + /* Keep the switch exhaustive. */ + case PVEC_NORMAL_VECTOR: + case PVEC_FREE: + case PVEC_SYMBOL_WITH_POS: + case PVEC_MISC_PTR: + case PVEC_PROCESS: + case PVEC_FRAME: + case PVEC_WINDOW: + case PVEC_BOOL_VECTOR: + case PVEC_BUFFER: + case PVEC_HASH_TABLE: + case PVEC_TERMINAL: + case PVEC_WINDOW_CONFIGURATION: + case PVEC_OTHER: + case PVEC_XWIDGET: + case PVEC_XWIDGET_VIEW: + case PVEC_TS_NODE: + case PVEC_SQLITE: + case PVEC_COMPILED: + case PVEC_CHAR_TABLE: + case PVEC_SUB_CHAR_TABLE: + case PVEC_RECORD: + break; + } } /* Reclaim space used by unmarked vectors. */ commit fb8dfba0f14c5db43fa161103b28764ff198db8f Author: Paul Eggert Date: Wed Sep 20 01:04:32 2023 -0700 Fix off-by-1 typo in vadd_to_log * src/xdisp.c (vadd_to_log): Fix off-by-1 typo that I introduced in commit fbee6265a72a4129d2efbf15a622b13e8b4aae9f dated Thu Aug 13 13:48:28 2015 -0700. Problem and fix reported by Robert Pluim (Bug#66098#11). diff --git a/src/xdisp.c b/src/xdisp.c index 2944f3964e8..f1980c4f20c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -11808,7 +11808,7 @@ vadd_to_log (char const *format, va_list ap) eassert (nargs <= ARRAYELTS (args)); AUTO_STRING (args0, format); args[0] = args0; - for (ptrdiff_t i = 1; i <= nargs; i++) + for (ptrdiff_t i = 1; i < nargs; i++) args[i] = va_arg (ap, Lisp_Object); Lisp_Object msg = Qnil; msg = Fformat_message (nargs, args); commit 74dffcdf4f25ce4dc9074b0215f9967fb3e245a5 Author: Juri Linkov Date: Tue Sep 19 20:51:07 2023 +0300 * lisp/tab-bar.el (tab-bar-auto-width): Don't check if width changes. Remove the condition '(< curr-width prev-width)' that was intended to check if the width stopped to change. But actually it's not only unneeded, but causes a bug: when the name contains a combining character, then the width doesn't change, and the name truncation stops too early. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index e4379b97d8b..d2815c03ebf 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1234,8 +1234,7 @@ tab-bar-auto-width space (substring name ins-pos))) (setq curr-width (string-pixel-width name)) - (if (and (< curr-width width) - (> curr-width prev-width)) + (if (< curr-width width) (setq prev-width curr-width prev-name name) ;; Set back a shorter name @@ -1249,8 +1248,7 @@ tab-bar-auto-width (and del-pos2 (substring name del-pos2)))) (setq curr-width (string-pixel-width name)) - (if (and (> curr-width width) - (< curr-width prev-width)) + (if (> curr-width width) (setq prev-width curr-width) (setq continue nil))) (let* ((len (length name)) commit 3c14cab797752e78c21ac2a69a7e854276802c22 Author: Juri Linkov Date: Tue Sep 19 20:44:16 2023 +0300 ; * tab-bar, tab-line: Use integer 1 instead of float for height em. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 7484f5b79e4..e4379b97d8b 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -161,7 +161,7 @@ tab-bar--load-buttons (define-icon tab-bar-new nil `((image "symbols/plus_16.svg" "tabs/new.xpm" :face shadow - :height (1.0 . em) + :height (1 . em) :margin ,tab-bar-button-margin :ascent center) ;; (emoji "➕") @@ -176,7 +176,7 @@ tab-bar--load-buttons (define-icon tab-bar-close nil `((image "symbols/cross_16.svg" "tabs/close.xpm" :face shadow - :height (1.0 . em) + :height (1 . em) :margin ,tab-bar-button-margin :ascent center) ;; (emoji " ❌") @@ -191,7 +191,7 @@ tab-bar--load-buttons (unless (iconp 'tab-bar-menu-bar) (define-icon tab-bar-menu-bar nil `((image "symbols/menu_16.svg" - :height (1.0 . em) + :height (1 . em) :margin ,tab-bar-button-margin :ascent center) ;; (emoji "🍔") @@ -2282,7 +2282,7 @@ tab-bar-history-mode (unless (iconp 'tab-bar-back) (define-icon tab-bar-back nil `((image "symbols/chevron_left_16.svg" "tabs/left-arrow.xpm" - :height (1.0 . em) + :height (1 . em) :margin ,tab-bar-button-margin :ascent center) (text " < ")) @@ -2293,7 +2293,7 @@ tab-bar-history-mode (unless (iconp 'tab-bar-forward) (define-icon tab-bar-forward nil `((image "symbols/chevron_right_16.svg" "tabs/right-arrow.xpm" - :height (1.0 . em) + :height (1 . em) :margin ,tab-bar-button-margin :ascent center) (text " > ")) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index bdf1db7033f..d3b9720d729 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -194,7 +194,7 @@ tab-line-new-button-show (define-icon tab-line-new nil `((image "symbols/plus_16.svg" "tabs/new.xpm" :face shadow - :height (1.0 . em) + :height (1 . em) :margin (2 . 0) :ascent center) (text " + ")) @@ -230,7 +230,7 @@ tab-line-close-button-show (define-icon tab-line-close nil `((image "symbols/cross_16.svg" "tabs/close.xpm" :face shadow - :height (1.0 . em) + :height (1 . em) :margin (2 . 0) :ascent center) (text " x")) @@ -249,7 +249,7 @@ tab-line-close-button (define-icon tab-line-left nil `((image "symbols/chevron_left_16.svg" "tabs/left-arrow.xpm" :face shadow - :height (1.0 . em) + :height (1 . em) :margin (2 . 0) :ascent center) (text " <")) @@ -267,7 +267,7 @@ tab-line-left-button (define-icon tab-line-right nil `((image "symbols/chevron_right_16.svg" "tabs/right-arrow.xpm" :face shadow - :height (1.0 . em) + :height (1 . em) :margin (2 . 0) :ascent center) (text "> ")) commit b03338c70d81f2cba9c8a0b4fefbf83ef7a346e0 Author: Mattias Engdegård Date: Tue Sep 19 15:18:11 2023 +0200 Warn about duplicated :tag strings in defcustom choices It is bad user experience when two menu items have identical labels. * lisp/emacs-lisp/bytecomp.el (bytecomp--check-cus-type): Add check. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-defcustom-type): Add test case. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1474acc1638..387d7ef4de1 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5272,7 +5272,8 @@ bytecomp--check-cus-type (unless tail (bytecomp--cus-warn type "`%s' without any types inside" head)) (let ((clauses tail) - (constants nil)) + (constants nil) + (tags nil)) (while clauses (let* ((ty (car clauses)) (ty-head (car-safe ty))) @@ -5291,6 +5292,12 @@ bytecomp--check-cus-type (bytecomp--cus-warn ty "duplicated value in `%s': `%S'" head val)) (push val constants))) + (let ((tag (and (consp ty) (plist-get (cdr ty) :tag)))) + (when (stringp tag) + (when (member tag tags) + (bytecomp--cus-warn + ty "duplicated :tag string in `%s': %S" head tag)) + (push tag tags))) (bytecomp--check-cus-type ty)) (setq clauses (cdr clauses))))) ((eq head 'cons) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a335a7fa1f8..e644417c3d4 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1875,7 +1875,7 @@ bytecomp-tests-byte-compile--wide-docstring-p/func-arg-list (FIXTURE-FN \\='#\\='electric-pair-mode))" fill-column))) (ert-deftest bytecomp-test-defcustom-type () - (cl-flet ((dc (type) `(defcustom mytest nil "doc" :type ',type))) + (cl-flet ((dc (type) `(defcustom mytest nil "doc" :type ',type :group 'test))) (bytecomp--with-warning-test (rx "type should not be quoted") (dc ''integer)) (bytecomp--with-warning-test @@ -1890,6 +1890,9 @@ bytecomp-test-defcustom-type (bytecomp--with-warning-test (rx "duplicated value in `choice': `a'") (dc '(choice (const a) (const b) (const a)))) + (bytecomp--with-warning-test + (rx "duplicated :tag string in `choice': \"X\"") + (dc '(choice (const :tag "X" a) (const :tag "Y" b) (other :tag "X" c)))) (bytecomp--with-warning-test (rx "`cons' requires 2 type specs, found 1") (dc '(cons :tag "a" integer))) commit 321f2e1e4d4b2f209b072dc891cc89cbab19f032 Author: Mattias Engdegård Date: Mon Sep 18 19:16:05 2023 +0200 Don't use pointer arithmetic for pointer tagging (bug#65491) This makes for safer code when tagging null pointers in particular, since pointer arithmetic on NULL is undefined and therefore can be assumed, by the compiler, not to occur. * src/lisp.h (untagged_ptr): Remove. (TAG_PTR): Cast to uintptr_t instead of untagged_ptr. diff --git a/src/lisp.h b/src/lisp.h index 79ce8e5fa8e..39aa51531fe 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -919,20 +919,11 @@ #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) -/* untagged_ptr represents a pointer before tagging, and Lisp_Word_tag - contains a possibly-shifted tag to be added to an untagged_ptr to - convert it to a Lisp_Word. */ +/* Lisp_Word_tag is big enough for a possibly-shifted tag, to be + added to a pointer value for conversion to a Lisp_Word. */ #if LISP_WORDS_ARE_POINTERS -/* untagged_ptr is a pointer so that the compiler knows that TAG_PTR - yields a pointer. It is char * so that adding a tag uses simple - machine addition. */ -typedef char *untagged_ptr; typedef uintptr_t Lisp_Word_tag; #else -/* untagged_ptr is an unsigned integer instead of a pointer, so that - it can be added to the possibly-wider Lisp_Word_tag type without - losing information. */ -typedef uintptr_t untagged_ptr; typedef EMACS_UINT Lisp_Word_tag; #endif @@ -942,7 +933,7 @@ #define LISP_WORD_TAG(tag) \ /* An initializer for a Lisp_Object that contains TAG along with PTR. */ #define TAG_PTR(tag, ptr) \ - LISP_INITIALLY ((Lisp_Word) ((untagged_ptr) (ptr) + LISP_WORD_TAG (tag))) + LISP_INITIALLY ((Lisp_Word) ((uintptr_t) (ptr) + LISP_WORD_TAG (tag))) /* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is designed for use as an initializer, even for a constant initializer. */ commit 7be5c8f47c9df01a5accdbf954d952b9bbe5b5f0 Author: Protesilaos Stavrou Date: Tue Sep 19 16:03:11 2023 +0300 Update modus-themes to their version 4.3.0 * doc/misc/modus-themes.org (Option for reloading the theme on custom change) (Option for disabling other themes while loading Modus) (Option for completion framework aesthetics) (Option for org-mode block styles, Get a single color from the palette) (Add padding to mode line, Note on SHR fonts) (Note on goto-address-mode faces): Use correct markup for 'nil'. (Custom Org todo keyword and priority faces): Reword statements and update the value of sample configuration blocks. (Use more spacious margins or padding in Emacs frames): Mention the 'spacious-padding' package on GNU ELPA. (Full support for packages or face groups): Document newly supported packages and remove those that are no longer covered explicitly. (Indirectly covered packages): Note that css-mode is covered indirectly. (Acknowledgements): Expand list of people who have helped with the project. * etc/themes/modus-operandi-deuteranopia-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-operandi-deuteranopia): Expand or tweak the palette, where necessary. * etc/themes/modus-operandi-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-operandi): Expand or tweak the palette, where necessary. * etc/themes/modus-operandi-tinted-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-operandi-tinted): Expand or tweak the palette, where necessary. * etc/themes/modus-operandi-tritanopia-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-operandi-tritanopia): Expand or tweak the palette, where necessary. * etc/themes/modus-vivendi-deuteranopia-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-vivendi-deuteranopia): Expand or tweak the palette, where necessary. * etc/themes/modus-vivendi-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-vivendi): Expand or tweak the palette, where necessary. * etc/themes/modus-vivendi-tinted-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-vivendi-tinted): Expand or tweak the palette, where necessary. * etc/themes/modus-vivendi-tritanopia-theme.el (unless): Add theme-autoload cookie and relevant metadata. (modus-vivendi-tritanopia): Expand or tweak the palette, where necessary. * etc/themes/modus-themes.el (modus-themes-preset-overrides-faint) (modus-themes-preset-overrides-intense) (modus-themes-preset-overrides-warmer): Make minor tweaks. (modus-themes--annotate-theme, modus-themes--select-prompt) (modus-themes--toggle-theme-p, modus-themes-toggle) (modus-themes--list-colors-prompt, modus-themes--heading) (modus-themes-faces): Refine internal functions. The detailed release notes are available here: . diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index ae760624b6f..5a53426dfee 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.2.0 -#+macro: release-date 2023-05-30 -#+macro: development-version 4.3.0-dev +#+macro: stable-version 4.3.0 +#+macro: release-date 2023-09-19 +#+macro: development-version 4.4.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -581,11 +581,11 @@ Possible values: All theme user options take effect when a theme is loaded. Any subsequent changes require the theme to be reloaded. -When this variable has a non-nil value, any change made via the Custom +When this variable has a non-~nil~ value, any change made via the Custom UI or related functions such as ~customize-set-variable~ and ~setopt~ (Emacs 29), will trigger a reload automatically. -With a nil value, changes to user options have no further consequences: +With a ~nil~ value, changes to user options have no further consequences: the user must manually reload the theme ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). ** Option for disabling other themes while loading Modus @@ -605,20 +605,20 @@ Possible values: 1. ~nil~ 2. ~t~ (default) -When the value is non-nil, the commands ~modus-themes-toggle~ and +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. -When the value is nil, the aforementioned commands and function will +When the value is ~nil~, the aforementioned commands and function will only disable other themes within the Modus collection. This option is provided because Emacs themes are not necessarily limited to colors/faces: they can consist of an arbitrary set of customizations. Users who use such customization bundles must set -this variable to a nil value. +this variable to a ~nil~ value. ** Option for more bold constructs :properties: @@ -794,7 +794,7 @@ followed by a description of the particularities: #+end_src The ~matches~ key refers to the highlighted characters that correspond -to the user's input. When its properties are nil or an empty list, +to the user's input. When its properties are ~nil~ or an empty list, matching characters in the user interface will have a bold weight and a colored foreground. The list of properties may include any of the following symbols regardless of the order they may appear in: @@ -810,7 +810,7 @@ following symbols regardless of the order they may appear in: The ~selection~ key applies to the current line or currently matched candidate, depending on the specifics of the user interface. When its -properties are nil or an empty list, it has a subtle gray background, +properties are ~nil~ or an empty list, it has a subtle gray background, a bold weight, and the base foreground value for the text. The list of properties it accepts is as follows (order is not significant): @@ -861,10 +861,10 @@ Possible values: 2. ~gray-background~ 3. ~tinted-background~ -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 ~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 @@ -883,9 +883,9 @@ 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 +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. +~org-fontify-quote-and-verse-blocks~ to a non-~nil~ value. [[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter fontification]]. @@ -2730,7 +2730,7 @@ 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 +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]]. @@ -2884,7 +2884,7 @@ above: #+end_src 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 +non-~nil~ value for ~x-underline-at-descent-line~. That variable affects ALL underlines, including those of links. The effect is intrusive and looks awkard in prose. @@ -3150,20 +3150,20 @@ have something like this: #+end_src You could then use a variant of the following to inherit from a face -that uses the styles you want and also to preserve the properties -applied by the ~org-todo~ face (in case there is a difference between the -two): +that uses the styles you want and also to preserve the attributes +applied by the ~org-todo~ face (in case there is a difference between +the two): #+begin_src emacs-lisp (setq org-todo-keyword-faces - '(("MEET" . '(bold org-todo)) - ("STUDY" . '(warning org-todo)) - ("WRITE" . '(shadow org-todo)))) + '(("MEET" . (:inherit (bold org-todo))) + ("STUDY" . (:inherit (warning org-todo))) + ("WRITE" . (:inherit (shadow org-todo))))) #+end_src This will refashion the keywords you specify, while letting the other -items in ~org-todo-keywords~ use their original styles (which are defined -in the ~org-todo~ and ~org-done~ faces). +items in ~org-todo-keywords~ use their original styles, which are +defined in the ~org-todo~ and ~org-done~ faces. If you want back the defaults, try specifying just the ~org-todo~ face: @@ -3174,24 +3174,27 @@ If you want back the defaults, try specifying just the ~org-todo~ face: ("WRITE" . org-todo))) #+end_src -When you inherit from multiple faces, you need to quote the list as +Or set ~org-todo-keyword-faces~ to ~nil~. + +When you inherit from multiple faces, you need to do it the way it is shown further above. The order is significant: the first entry is -applied on top of the second, overriding any properties that are -explicitly set for both of them: any property that is not specified is -not overridden, so, for example, if ~org-todo~ has a background and a -foreground, while ~font-lock-type-face~ only has a foreground, the merged -face will include the background of the former and the foreground of the -latter. If you do not want to blend multiple faces, you do not need a -quoted list. A pattern of =keyword . face= will suffice. +applied on top of the second, overriding any attributes that are +explicitly set for both of them: any attribute that is not specified +is not overridden, so, for example, if ~org-todo~ has a background and +a foreground, while ~font-lock-type-face~ only has a foreground, the +merged face will include the background of the former and the +foreground of the latter. If you do not want to blend multiple faces, +you only specify one by name without parentheses or an =:inherit= +keyword. A pattern of =keyword . face= will suffice. Both approaches can be used simultaneously, as illustrated in this configuration of the priority cookies: #+begin_src emacs-lisp (setq org-priority-faces - '((?A . '(bold org-priority)) + '((?A . (:inherit (bold org-priority))) (?B . org-priority) - (?C . '(shadow org-priority)))) + (?C . (:inherit (shadow org-priority))))) #+end_src To find all the faces that are loaded in your current Emacs session, use @@ -3636,6 +3639,10 @@ need to (provided they understand the implications). :CUSTOM_ID: h:43bcb5d0-e25f-470f-828c-662cee9e21f1 :END: +[ UPDATE 2023-06-25: Instead of following these instructions, you can + simply install my ~spacious-padding~ package from GNU ELPA. It + implements the padding and provides relevant user options. ] + By default, Emacs frames try to maximize the number of characters that fit in the current visible portion of the buffer. Users may prefer to have some extra padding instead. This can make Emacs frames look more @@ -3847,6 +3854,7 @@ have lots of extensions, so the "full support" may not be 100% true… + avy + bbdb + binder ++ breadcrumb + bongo + boon + bookmark @@ -3864,11 +3872,11 @@ have lots of extensions, so the "full support" may not be 100% true… + completions + consult + corfu ++ corfu-candidate-overlay + corfu-quick + counsel* + cperl-mode + crontab-mode -+ css-mode + csv-mode + ctrlf + custom (what you get with {{{kbd(M-x customize)}}}) @@ -3905,6 +3913,7 @@ have lots of extensions, so the "full support" may not be 100% true… + epa + erc + ert ++ erts-mode + eshell + eshell-fringe-status + evil* (evil-mode) @@ -3951,6 +3960,7 @@ have lots of extensions, so the "full support" may not be 100% true… + isearch, occur, etc. + ivy* + ivy-posframe ++ japanese-holidays + jira (org-jira) + jit-spell + jinx @@ -3975,6 +3985,10 @@ have lots of extensions, so the "full support" may not be 100% true… + mpdel + mu4e + multiple-cursors ++ nerd-icons ++ nerd-icons-completion ++ nerd-icons-dired ++ nerd-icons-ibuffer + neotree + notmuch + num3-mode @@ -4038,7 +4052,6 @@ have lots of extensions, so the "full support" may not be 100% true… + suggest + switch-window + swiper -+ sx + symbol-overlay + syslog-mode + tab-bar-mode @@ -4099,6 +4112,7 @@ supported by the themes. + bufler + counsel-notmuch + counsel-org-capture-string ++ css-mode + dashboard (emacs-dashboard) + define-word + denote @@ -4722,7 +4736,7 @@ Consult the doc string of ~shr-use-colors~. By default, packages that build on top of the Simple HTML Remember (~shr~) use proportionately spaced fonts. This is controlled by the user option ~shr-use-fonts~, which is set to non-~nil~ by default. To -use the standard font instead, set that variable to nil. +use the standard font instead, set that variable to ~nil~. [[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. @@ -4859,7 +4873,7 @@ consider including (or equivalent) this in their setup: goto-address-mail-mouse-face 'highlight) #+end_src -My personal preference is to set ~goto-address-mail-face~ to nil, as +My personal preference is to set ~goto-address-mail-face~ to ~nil~, as it otherwise adds too much visual noise to the buffer (email addresses stand out more, due to the use of the uncommon =@= character but also because they are often enclosed in angled brackets). @@ -5345,8 +5359,9 @@ The Modus themes are a collective effort. Every bit of work matters. 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 Gildea, Steve Downey, Tomasz Hołubowicz, Utkarsh Singh, - Vincent Murphy, Xinglu Chen, Yuanchen Xie, okamsn. + 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 @@ -5363,25 +5378,25 @@ The Modus themes are a collective effort. Every bit of work matters. 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, 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 Willcock, - Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Nicolas - Semrau, Oliver Epper, Pablo Stafforini, Paul Poloskov, Pengji Zhang, - Pete Kazmier, Peter Wu, Philip Kaludercic, Pierre Téchoueyres, - Przemysław Kryger, Robert Hepple, Roman Rudakov, Russell Sim, Ryan - Phillips, Rytis Paškauskas, Rudolf Adamkovič, Sam Kleinman, Samuel - Culpepper, Saša Janiška, Shreyas 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, 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. + 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 + 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 + Kaludercic, Pierre Téchoueyres, Przemysław Kryger, Robert Hepple, + Roman Rudakov, Russell Sim, Ryan Phillips, Rytis Paškauskas, Rudolf + Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška, Shreyas + 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, + 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. + 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 5817d8f674c..6a2105a1c4d 100644 --- a/etc/themes/modus-operandi-deuteranopia-theme.el +++ b/etc/themes/modus-operandi-deuteranopia-theme.el @@ -43,6 +43,7 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-operandi-deuteranopia "Deuteranopia-optimized theme with a white background. This variant is optimized for users with red-green color @@ -50,14 +51,17 @@ 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 7:1 (WCAG AAA -standard).") +standard)." + :background-mode 'light + :kind 'color-scheme + :family 'modus) (defconst modus-operandi-deuteranopia-palette '( ;;; Basic values (bg-main "#ffffff") - (bg-dim "#f0f0f0") + (bg-dim "#f2f2f2") (fg-main "#000000") (fg-dim "#595959") (fg-alt "#193668") @@ -155,7 +159,7 @@ ;;; Special purpose (bg-completion "#c0deff") - (bg-hover "#97dfed") + (bg-hover "#b2e4dc") (bg-hover-secondary "#f5d0a0") (bg-hl-line "#dae5ec") (bg-region "#bdbdbd") @@ -198,7 +202,7 @@ (bg-removed "#f4f099") (bg-removed-faint "#f6f6b7") - (bg-removed-refine "#f0e56f") + (bg-removed-refine "#ede06f") (bg-removed-fringe "#c0b200") (fg-removed "#553d00") (fg-removed-intense "#7f6f00") @@ -284,6 +288,7 @@ (date-deadline yellow-warmer) (date-event fg-alt) (date-holiday yellow-warmer) + (date-holiday-other blue) (date-now blue-faint) (date-range fg-alt) (date-scheduled yellow-cooler) @@ -367,6 +372,48 @@ (fg-space border) (bg-space-err bg-yellow-intense) +;;;; Terminal mappings + + (bg-term-black "black") + (fg-term-black "black") + (bg-term-black-bright "gray35") + (fg-term-black-bright "gray35") + + (bg-term-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -436,7 +483,4 @@ (provide-theme 'modus-operandi-deuteranopia)) -;;;###theme-autoload -(put 'modus-operandi-deuteranopia 'theme-properties '(:background-mode light :kind color-scheme :family modus)) - ;;; modus-operandi-deuteranopia-theme.el ends here diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index 9a69e3290b7..b9f9ee3834a 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -43,19 +43,23 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-operandi "Elegant, highly legible theme with a white 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 -7:1 (WCAG AAA standard).") +7:1 (WCAG AAA standard)." + :background-mode 'light + :kind 'color-scheme + :family 'modus) (defconst modus-operandi-palette '( ;;; Basic values (bg-main "#ffffff") - (bg-dim "#f0f0f0") + (bg-dim "#f2f2f2") (fg-main "#000000") (fg-dim "#595959") (fg-alt "#193668") @@ -153,7 +157,7 @@ ;;; Special purpose (bg-completion "#c0deff") - (bg-hover "#94d4ff") + (bg-hover "#b2e4dc") (bg-hover-secondary "#f5d0a0") (bg-hl-line "#dae5ec") (bg-region "#bdbdbd") @@ -282,6 +286,7 @@ (date-deadline red) (date-event fg-alt) (date-holiday red-cooler) + (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-warmer) @@ -365,6 +370,48 @@ (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-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -434,7 +481,4 @@ (provide-theme 'modus-operandi)) -;;;###theme-autoload -(put 'modus-operandi 'theme-properties '(:background-mode light :kind color-scheme :family modus)) - ;;; modus-operandi-theme.el ends here diff --git a/etc/themes/modus-operandi-tinted-theme.el b/etc/themes/modus-operandi-tinted-theme.el index 341a7d29e84..e66a030650c 100644 --- a/etc/themes/modus-operandi-tinted-theme.el +++ b/etc/themes/modus-operandi-tinted-theme.el @@ -42,19 +42,23 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-operandi-tinted "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 -7:1 (WCAG AAA standard).") +7:1 (WCAG AAA standard)." + :background-mode 'light + :kind 'color-scheme + :family 'modus) (defconst modus-operandi-tinted-palette '( ;;; Basic values (bg-main "#fbf7f0") - (bg-dim "#ede7db") + (bg-dim "#efe9dd") (fg-main "#000000") (fg-dim "#595959") (fg-alt "#193668") @@ -152,7 +156,7 @@ ;;; Special purpose (bg-completion "#f0c1cf") - (bg-hover "#94d4ff") + (bg-hover "#b2e4dc") (bg-hover-secondary "#f5d0a0") (bg-hl-line "#f1d5d0") (bg-region "#c2bcb5") @@ -281,6 +285,7 @@ (date-deadline red) (date-event fg-alt) (date-holiday red-cooler) + (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-warmer) @@ -364,6 +369,48 @@ (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-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -433,7 +480,4 @@ (provide-theme 'modus-operandi-tinted)) -;;;###theme-autoload -(put 'modus-operandi-tinted 'theme-properties '(:background-mode light :kind color-scheme :family modus)) - ;;; modus-operandi-tinted-theme.el ends here diff --git a/etc/themes/modus-operandi-tritanopia-theme.el b/etc/themes/modus-operandi-tritanopia-theme.el index 5d143fa7514..b7e9aa99748 100644 --- a/etc/themes/modus-operandi-tritanopia-theme.el +++ b/etc/themes/modus-operandi-tritanopia-theme.el @@ -43,6 +43,7 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-operandi-tritanopia "Tritanopia-optimized theme with a white background. This variant is optimized for users with blue-yellow color @@ -50,14 +51,17 @@ 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 7:1 (WCAG AAA -standard).") +standard)." + :background-mode 'light + :kind 'color-scheme + :family 'modus) (defconst modus-operandi-tritanopia-palette '( ;;; Basic values (bg-main "#ffffff") - (bg-dim "#f0f0f0") + (bg-dim "#f2f2f2") (fg-main "#000000") (fg-dim "#595959") (fg-alt "#193668") @@ -161,9 +165,9 @@ (bg-region "#bdbdbd") (fg-region "#000000") - (bg-char-0 "#ff8a5f") - (bg-char-1 "#bf7aff") - (bg-char-2 "#7fe0e0") + (bg-char-0 "#ff908f") + (bg-char-1 "#bfbfff") + (bg-char-2 "#5fcfdf") (bg-mode-line-active "#afe0f2") (fg-mode-line-active "#0f0f0f") @@ -284,6 +288,7 @@ (date-deadline red) (date-event fg-alt) (date-holiday red) + (date-holiday-other cyan) (date-now fg-main) (date-range fg-alt) (date-scheduled magenta) @@ -367,6 +372,48 @@ (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-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -436,7 +483,4 @@ (provide-theme 'modus-operandi-tritanopia)) -;;;###theme-autoload -(put 'modus-operandi-tritanopia 'theme-properties '(:background-mode light :kind color-scheme :family modus)) - ;;; modus-operandi-tritanopia-theme.el ends here diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 43c10043bc5..34130a05515 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -6,7 +6,7 @@ ;; 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.2.0 +;; Version: 4.3.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -841,8 +841,6 @@ modus-themes-common-palette-overrides (defvar modus-themes-preset-overrides-faint '((bg-completion bg-inactive) - (bg-hover bg-cyan-subtle) - (bg-hover-secondary bg-magenta-subtle) (bg-hl-line bg-dim) (bg-paren-match bg-cyan-subtle) (bg-region bg-active) @@ -997,9 +995,9 @@ modus-themes-preset-overrides-intense (prose-block red-faint) (prose-done green-intense) - (prose-metadata cyan-faint) + (prose-metadata magenta-faint) (prose-metadata-value blue-cooler) - (prose-table cyan) + (prose-table blue) (prose-todo red-intense) (fg-heading-0 blue-cooler) @@ -1031,7 +1029,7 @@ modus-themes-preset-overrides-intense (overline-heading-6 yellow-cooler) (overline-heading-7 red-cooler) (overline-heading-8 magenta)) - "Preset for palette overrides with faint coloration. + "Preset for palette overrides with intense coloration. This changes many parts of the theme to make them look more colorful/intense. Many background colors are accented and @@ -1111,7 +1109,7 @@ modus-themes-preset-overrides-warmer (fnname magenta-cooler) (keyword magenta-warmer) (preprocessor red-cooler) - (string olive) + (string green-warmer) (type cyan-cooler) (variable cyan) (rx-construct blue-cooler) @@ -1322,7 +1320,20 @@ modus-themes--select-theme-history (defun modus-themes--annotate-theme (theme) "Return completion annotation for THEME." - (format " -- %s" (car (split-string (get (intern theme) 'theme-documentation) "\\.")))) + (when-let ((symbol (intern-soft theme)) + (doc-string (get symbol 'theme-documentation))) + (format " -- %s" (car (split-string doc-string "\\."))))) + +(defun modus-themes--completion-table (category candidates) + "Pass appropriate metadata CATEGORY to completion CANDIDATES." + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata (category . ,category)) + (complete-with-action action candidates string pred)))) + +(defun modus-themes--completion-table-candidates () + "Render `modus-themes--list-known-themes' as completion with theme category." + (modus-themes--completion-table 'theme (modus-themes--list-known-themes))) (defun modus-themes--select-prompt () "Minibuffer prompt to select a Modus theme." @@ -1330,7 +1341,7 @@ modus-themes--select-prompt (intern (completing-read "Select Modus theme: " - (modus-themes--list-known-themes) + (modus-themes--completion-table-candidates) nil t nil 'modus-themes--select-theme-history)))) @@ -1344,12 +1355,13 @@ modus-themes-select (defun modus-themes--toggle-theme-p () "Return non-nil if `modus-themes-to-toggle' are valid." - (mapc (lambda (theme) - (if (or (memq theme modus-themes-items) - (memq theme (modus-themes--list-known-themes))) - theme - (user-error "`%s' is not part of `modus-themes-items'" theme))) - modus-themes-to-toggle)) + (mapc + (lambda (theme) + (if (or (memq theme modus-themes-items) + (memq theme (modus-themes--list-known-themes))) + theme + (user-error "`%s' is not part of `modus-themes-items'" theme))) + modus-themes-to-toggle)) ;;;###autoload (defun modus-themes-toggle () @@ -1364,9 +1376,7 @@ modus-themes-toggle (if-let* ((themes (modus-themes--toggle-theme-p)) (one (car themes)) (two (cadr themes))) - (if (eq (car custom-enabled-themes) one) - (modus-themes-load-theme two) - (modus-themes-load-theme one)) + (modus-themes-load-theme (if (eq (car custom-enabled-themes) one) two one)) (modus-themes-load-theme (modus-themes--select-prompt)))) (defun modus-themes--list-colors-render (buffer theme &optional mappings &rest _) @@ -1424,7 +1434,8 @@ modus-themes--list-colors-prompt (completion-extra-properties `(:annotation-function ,#'modus-themes--annotate-theme))) (completing-read (format "Use palette from theme [%s]: " def) - (modus-themes--list-known-themes) nil t nil + (modus-themes--completion-table-candidates) + nil t nil 'modus-themes--list-colors-prompt-history def))) (defun modus-themes-list-colors (theme &optional mappings) @@ -1552,20 +1563,22 @@ modus-themes--heading (style (or key (alist-get t modus-themes-headings))) (style-listp (listp style)) (properties style) - (var (when (memq 'variable-pitch properties) 'variable-pitch)) + (var (when (and style-listp (memq 'variable-pitch properties)) 'variable-pitch)) (weight (when style-listp (modus-themes--weight style)))) - (list :inherit - (cond - ;; `no-bold' is for backward compatibility because we cannot - ;; deprecate a variable's value. - ((or weight (memq 'no-bold properties)) - var) - (var (append (list 'bold) (list var))) - ('bold)) + (list :inherit (cond + ((not style-listp) 'bold) + ;; `no-bold' is for backward compatibility because we cannot + ;; deprecate a variable's value. + ((or weight (memq 'no-bold properties)) + var) + (var (append (list 'bold) (list var))) + (t 'bold)) :background (or bg 'unspecified) :foreground fg :overline (or ol 'unspecified) - :height (modus-themes--property-lookup properties 'height #'floatp 'unspecified) + :height (if style-listp + (modus-themes--property-lookup properties 'height #'floatp 'unspecified) + 'unspecified) :weight (or weight 'unspecified)))) (defun modus-themes--org-block (fg bg) @@ -1747,6 +1760,8 @@ modus-themes-faces `(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))) `(bold ((,c :weight bold))) `(bold-italic ((,c :inherit (bold italic)))) `(underline ((,c :underline ,fg-dim))) @@ -1824,9 +1839,9 @@ modus-themes-faces `(agda2-highlight-unsolved-meta-face ((,c :inherit modus-themes-lang-warning))) ;;;;; all-the-icons `(all-the-icons-blue ((,c :foreground ,blue-cooler))) - `(all-the-icons-blue-warmer ((,c :foreground ,blue-warmer))) - `(all-the-icons-cyan ((,c :foreground ,cyan-intense))) - `(all-the-icons-cyan-warmer ((,c :foreground ,cyan-warmer))) + `(all-the-icons-blue-alt ((,c :foreground ,blue-warmer))) + `(all-the-icons-cyan ((,c :foreground ,cyan))) + `(all-the-icons-cyan-alt ((,c :foreground ,cyan-warmer))) `(all-the-icons-dblue ((,c :foreground ,blue-faint))) `(all-the-icons-dcyan ((,c :foreground ,cyan-faint))) `(all-the-icons-dgreen ((,c :foreground ,green-faint))) @@ -1834,7 +1849,7 @@ modus-themes-faces `(all-the-icons-dorange ((,c :foreground ,red-faint))) `(all-the-icons-dpink ((,c :foreground ,magenta-faint))) `(all-the-icons-dpurple ((,c :foreground ,magenta-cooler))) - `(all-the-icons-dred ((,c :foreground ,red-faint))) + `(all-the-icons-dred ((,c :foreground ,red))) `(all-the-icons-dsilver ((,c :foreground ,cyan-faint))) `(all-the-icons-dyellow ((,c :foreground ,yellow-faint))) `(all-the-icons-green ((,c :foreground ,green))) @@ -1845,12 +1860,18 @@ modus-themes-faces `(all-the-icons-lorange ((,c :foreground ,red-warmer))) `(all-the-icons-lpink ((,c :foreground ,magenta))) `(all-the-icons-lpurple ((,c :foreground ,magenta-faint))) - `(all-the-icons-lred ((,c :foreground ,red))) + `(all-the-icons-lred ((,c :foreground ,red-faint))) + `(all-the-icons-lsilver ((,c :foreground "gray50"))) `(all-the-icons-lyellow ((,c :foreground ,yellow-warmer))) - `(all-the-icons-maroon ((,c :foreground ,yellow-cooler))) - `(all-the-icons-red ((,c :foreground ,red-intense))) - `(all-the-icons-red-warmer ((,c :foreground ,red-cooler))) - `(all-the-icons-yellow ((,c :foreground ,yellow-intense))) + `(all-the-icons-maroon ((,c :foreground ,magenta))) + `(all-the-icons-orange ((,c :foreground ,yellow-warmer))) + `(all-the-icons-pink ((,c :foreground ,magenta-warmer))) + `(all-the-icons-purple ((,c :foreground ,magenta-cooler))) + `(all-the-icons-purple-alt ((,c :foreground ,blue-warmer))) + `(all-the-icons-red ((,c :foreground ,red))) + `(all-the-icons-red-alt ((,c :foreground ,red-cooler))) + `(all-the-icons-silver ((,c :foreground "gray50"))) + `(all-the-icons-yellow ((,c :foreground ,yellow))) ;;;;; all-the-icons-dired `(all-the-icons-dired-dir-face ((,c :foreground ,cyan-faint))) ;;;;; all-the-icons-ibuffer @@ -1865,23 +1886,23 @@ modus-themes-faces `(annotate-highlight-secondary ((,c :background ,bg-magenta-subtle :underline ,magenta-intense))) ;;;;; ansi-color ;; Those are in Emacs28. - `(ansi-color-black ((,c :background "black" :foreground "black"))) - `(ansi-color-blue ((,c :background ,blue :foreground ,blue))) + `(ansi-color-black ((,c :background ,bg-term-black :foreground ,fg-term-black))) + `(ansi-color-blue ((,c :background ,bg-term-blue :foreground ,fg-term-blue))) `(ansi-color-bold ((,c :inherit bold))) - `(ansi-color-bright-black ((,c :background "gray35" :foreground "gray35"))) - `(ansi-color-bright-blue ((,c :background ,blue-warmer :foreground ,blue-warmer))) - `(ansi-color-bright-cyan ((,c :background ,cyan-cooler :foreground ,cyan-cooler))) - `(ansi-color-bright-green ((,c :background ,green-cooler :foreground ,green-cooler))) - `(ansi-color-bright-magenta ((,c :background ,magenta-cooler :foreground ,magenta-cooler))) - `(ansi-color-bright-red ((,c :background ,red-warmer :foreground ,red-warmer))) - `(ansi-color-bright-white ((,c :background "white" :foreground "white"))) - `(ansi-color-bright-yellow ((,c :background ,yellow-warmer :foreground ,yellow-warmer))) - `(ansi-color-cyan ((,c :background ,cyan :foreground ,cyan))) - `(ansi-color-green ((,c :background ,green :foreground ,green))) - `(ansi-color-magenta ((,c :background ,magenta :foreground ,magenta))) - `(ansi-color-red ((,c :background ,red :foreground ,red))) - `(ansi-color-white ((,c :background "gray65" :foreground "gray65"))) - `(ansi-color-yellow ((,c :background ,yellow :foreground ,yellow))) + `(ansi-color-bright-black ((,c :background ,bg-term-black-bright :foreground ,fg-term-black-bright))) + `(ansi-color-bright-blue ((,c :background ,bg-term-blue-bright :foreground ,fg-term-blue-bright))) + `(ansi-color-bright-cyan ((,c :background ,bg-term-cyan-bright :foreground ,fg-term-cyan-bright))) + `(ansi-color-bright-green ((,c :background ,bg-term-green-bright :foreground ,fg-term-green-bright))) + `(ansi-color-bright-magenta ((,c :background ,bg-term-magenta-bright :foreground ,fg-term-magenta-bright))) + `(ansi-color-bright-red ((,c :background ,bg-term-red-bright :foreground ,fg-term-red-bright))) + `(ansi-color-bright-white ((,c :background ,bg-term-white-bright :foreground ,fg-term-white-bright))) + `(ansi-color-bright-yellow ((,c :background ,bg-term-yellow-bright :foreground ,fg-term-yellow-bright))) + `(ansi-color-cyan ((,c :background ,bg-term-cyan :foreground ,fg-term-cyan))) + `(ansi-color-green ((,c :background ,bg-term-green :foreground ,fg-term-green))) + `(ansi-color-magenta ((,c :background ,bg-term-magenta :foreground ,fg-term-magenta))) + `(ansi-color-red ((,c :background ,bg-term-red :foreground ,fg-term-red))) + `(ansi-color-white ((,c :background ,bg-term-white :foreground ,fg-term-white))) + `(ansi-color-yellow ((,c :background ,bg-term-yellow :foreground ,fg-term-yellow))) ;;;;; anzu `(anzu-match-1 ((,c :inherit modus-themes-subtle-cyan))) `(anzu-match-2 ((,c :inherit modus-themes-search-current))) @@ -1932,6 +1953,10 @@ modus-themes-faces `(binder-sidebar-marked ((,c :inherit modus-themes-mark-sel))) `(binder-sidebar-missing ((,c :inherit modus-themes-mark-del))) `(binder-sidebar-tags ((,c :foreground ,variable))) +;;;;; breadcrumb + `(breadcrumb-face ((,c :foreground ,fg-alt))) + `(breadcrumb-imenu-leaf-face ((,c :inherit bold :foreground ,modeline-info))) ; same as `which-func' + `(breadcrumb-project-leaf-face ((,c :inherit bold))) ;;;;; bongo `(bongo-album-title (( ))) `(bongo-artist ((,c :foreground ,accent-0))) @@ -2009,7 +2034,7 @@ modus-themes-faces `(change-log-name ((,c :foreground ,name))) `(log-edit-header ((,c :inherit bold))) `(log-edit-headers-separator ((,c :height 1 :background ,border :extend t))) - `(log-edit-summary ((,c :inherit bold :foreground ,blue))) + `(log-edit-summary ((,c :inherit success))) `(log-edit-unknown-header ((,c :inherit shadow))) `(log-view-commit-body (( ))) `(log-view-file ((,c :inherit bold))) @@ -2084,6 +2109,8 @@ modus-themes-faces `(corfu-bar ((,c :background ,fg-dim))) `(corfu-border ((,c :background ,bg-active))) `(corfu-default ((,c :background ,bg-dim))) +;;;;; corfu-candidate-overlay + `(corfu-candidate-overlay-face ((t :inherit shadow))) ;;;;; corfu-quick `(corfu-quick1 ((,c :inherit bold :background ,bg-char-0))) `(corfu-quick2 ((,c :inherit bold :background ,bg-char-1))) @@ -2104,9 +2131,6 @@ modus-themes-faces `(crontab-month ((,c :foreground ,constant))) `(crontab-week-day ((,c :foreground ,variable))) `(crontab-predefined ((,c :foreground ,string))) -;;;;; css-mode - `(css-property ((,c :inherit font-lock-type-face))) - `(css-selector ((,c :inherit font-lock-keyword-face))) ;;;;; csv-mode `(csv-separator-face ((,c :foreground ,red-intense))) ;;;;; ctrlf @@ -2413,6 +2437,11 @@ modus-themes-faces ;;;;; ert `(ert-test-result-expected ((,c :inherit modus-themes-prominent-note))) `(ert-test-result-unexpected ((,c :inherit modus-themes-prominent-error))) +;;;;; erts-mode + `(erts-mode-end-test ((,c :inherit error))) + `(erts-mode-specification-name ((,c :inherit bold))) + `(erts-mode-specification-value ((,c :foreground ,string))) + `(erts-mode-start-test ((,c :inherit success))) ;;;;; eshell `(eshell-ls-archive ((,c :foreground ,accent-2))) `(eshell-ls-backup ((,c :inherit shadow))) @@ -2524,7 +2553,7 @@ modus-themes-faces `(git-commit-keyword ((,c :foreground ,keyword))) `(git-commit-nonempty-second-line ((,c :inherit error))) `(git-commit-overlong-summary ((,c :inherit warning))) - `(git-commit-summary ((,c :inherit bold :foreground ,blue))) + `(git-commit-summary ((,c :inherit success))) ;;;;; git-gutter `(git-gutter:added ((,c :background ,bg-added-fringe))) `(git-gutter:deleted ((,c :background ,bg-removed-fringe))) @@ -2799,6 +2828,8 @@ modus-themes-faces ;;;;; ivy-posframe `(ivy-posframe-border ((,c :background ,border))) `(ivy-posframe-cursor ((,c :background ,fg-main :foreground ,bg-main))) +;;;;; japanese-holidays + `(japanese-holiday-saturday ((,c :foreground ,date-holiday-other))) ;;;;; jira (org-jira) `(jiralib-comment-face ((,c :background ,bg-inactive))) `(jiralib-comment-header-face ((,c :inherit bold))) @@ -3127,6 +3158,50 @@ modus-themes-faces `(mc/cursor-bar-face ((,c :height 1 :foreground ,fg-main :background ,bg-main))) `(mc/cursor-face ((,c :inverse-video t))) `(mc/region-face ((,c :inherit region))) +;;;;; nerd-icons + `(nerd-icons-blue ((,c :foreground ,blue-cooler))) + `(nerd-icons-blue-alt ((,c :foreground ,blue-warmer))) + `(nerd-icons-cyan ((,c :foreground ,cyan))) + `(nerd-icons-cyan-alt ((,c :foreground ,cyan-warmer))) + `(nerd-icons-dblue ((,c :foreground ,blue-faint))) + `(nerd-icons-dcyan ((,c :foreground ,cyan-faint))) + `(nerd-icons-dgreen ((,c :foreground ,green-faint))) + `(nerd-icons-dmaroon ((,c :foreground ,magenta-faint))) + `(nerd-icons-dorange ((,c :foreground ,red-faint))) + `(nerd-icons-dpink ((,c :foreground ,magenta-faint))) + `(nerd-icons-dpurple ((,c :foreground ,magenta-cooler))) + `(nerd-icons-dred ((,c :foreground ,red))) + `(nerd-icons-dsilver ((,c :foreground ,cyan-faint))) + `(nerd-icons-dyellow ((,c :foreground ,yellow-faint))) + `(nerd-icons-green ((,c :foreground ,green))) + `(nerd-icons-lblue ((,c :foreground ,blue-cooler))) + `(nerd-icons-lcyan ((,c :foreground ,cyan))) + `(nerd-icons-lgreen ((,c :foreground ,green-warmer))) + `(nerd-icons-lmaroon ((,c :foreground ,magenta-warmer))) + `(nerd-icons-lorange ((,c :foreground ,red-warmer))) + `(nerd-icons-lpink ((,c :foreground ,magenta))) + `(nerd-icons-lpurple ((,c :foreground ,magenta-faint))) + `(nerd-icons-lred ((,c :foreground ,red-faint))) + `(nerd-icons-lsilver ((,c :foreground "gray50"))) + `(nerd-icons-lyellow ((,c :foreground ,yellow-warmer))) + `(nerd-icons-maroon ((,c :foreground ,magenta))) + `(nerd-icons-orange ((,c :foreground ,yellow-warmer))) + `(nerd-icons-pink ((,c :foreground ,magenta-warmer))) + `(nerd-icons-purple ((,c :foreground ,magenta-cooler))) + `(nerd-icons-purple-alt ((,c :foreground ,blue-warmer))) + `(nerd-icons-red ((,c :foreground ,red))) + `(nerd-icons-red-alt ((,c :foreground ,red-cooler))) + `(nerd-icons-silver ((,c :foreground "gray50"))) + `(nerd-icons-yellow ((,c :foreground ,yellow))) +;;;;; nerd-icons-completion + `(nerd-icons-completion-dir-face ((,c :foreground ,cyan-faint))) +;;;;; nerd-icons-dired + `(nerd-icons-dired-dir-face ((,c :foreground ,cyan-faint))) +;;;;; nerd-icons-ibuffer + `(nerd-icons-ibuffer-dir-face ((,c :foreground ,cyan-faint))) + `(nerd-icons-ibuffer-file-face ((,c :foreground ,blue-faint))) + `(nerd-icons-ibuffer-mode-face ((,c :foreground ,cyan))) + `(nerd-icons-ibuffer-size-face ((,c :foreground ,cyan-cooler))) ;;;;; neotree `(neo-banner-face ((,c :foreground ,accent-0))) `(neo-button-face ((,c :inherit button))) @@ -3247,7 +3322,7 @@ modus-themes-faces `(org-date ((,c :inherit modus-themes-fixed-pitch :foreground ,date-common))) `(org-date-selected ((,c :foreground ,date-common :inverse-video t))) `(org-document-info ((,c :foreground ,prose-metadata-value))) - `(org-document-info-keyword ((,c :foreground ,prose-metadata))) + `(org-document-info-keyword ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) `(org-document-title ((,c :inherit modus-themes-heading-0))) `(org-done ((,c :foreground ,prose-done))) `(org-drawer ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) @@ -3707,16 +3782,19 @@ modus-themes-faces `(terraform--resource-name-face ((,c :foreground ,keyword))) `(terraform--resource-type-face ((,c :foreground ,type))) ;;;;; term + ;; NOTE 2023-08-10: `term-color-black' and `term-color-white' use + ;; the "bright" semantic color mappings to make sure they are + ;; distinct from `term'. `(term ((,c :background ,bg-main :foreground ,fg-main))) `(term-bold ((,c :inherit bold))) - `(term-color-black ((,c :background "gray35" :foreground "gray35"))) - `(term-color-blue ((,c :background ,blue :foreground ,blue))) - `(term-color-cyan ((,c :background ,cyan :foreground ,cyan))) - `(term-color-green ((,c :background ,green :foreground ,green))) - `(term-color-magenta ((,c :background ,magenta :foreground ,magenta))) - `(term-color-red ((,c :background ,red :foreground ,red))) - `(term-color-white ((,c :background "gray65" :foreground "gray65"))) - `(term-color-yellow ((,c :background ,yellow :foreground ,yellow))) + `(term-color-black ((,c :background ,bg-term-black-bright :foreground ,fg-term-black-bright))) + `(term-color-blue ((,c :background ,bg-term-blue :foreground ,fg-term-blue))) + `(term-color-cyan ((,c :background ,bg-term-cyan :foreground ,fg-term-cyan))) + `(term-color-green ((,c :background ,bg-term-green :foreground ,fg-term-green))) + `(term-color-magenta ((,c :background ,bg-term-magenta :foreground ,fg-term-magenta))) + `(term-color-red ((,c :background ,bg-term-red :foreground ,fg-term-red))) + `(term-color-white ((,c :background ,bg-term-white-bright :foreground ,fg-term-white-bright))) + `(term-color-yellow ((,c :background ,bg-term-yellow :foreground ,fg-term-yellow))) `(term-underline ((,c :underline t))) ;;;;; textsec `(textsec-suspicious (( ))) @@ -3847,17 +3925,20 @@ modus-themes-faces `(vr/match-1 ((,c :inherit modus-themes-intense-yellow))) `(vr/match-separator-face ((,c :inherit bold :background ,bg-active))) ;;;;; vterm - `(vterm-color-black ((,c :background "gray35" :foreground "black"))) - `(vterm-color-blue ((,c :background ,blue-warmer :foreground ,blue))) - `(vterm-color-cyan ((,c :background ,cyan-cooler :foreground ,cyan))) + ;; NOTE 2023-08-10: `vterm-color-black' and `vterm-color-white' + ;; use the "bright" semantic color mappings to make sure they are + ;; distinct from `vterm-color-default'. + `(vterm-color-black ((,c :background ,bg-term-black :foreground ,fg-term-black))) + `(vterm-color-blue ((,c :background ,bg-term-blue :foreground ,fg-term-blue))) + `(vterm-color-cyan ((,c :background ,bg-term-cyan :foreground ,fg-term-cyan))) `(vterm-color-default ((,c :background ,bg-main :foreground ,fg-main))) - `(vterm-color-green ((,c :background ,green-cooler :foreground ,green))) + `(vterm-color-green ((,c :background ,bg-term-green :foreground ,fg-term-green))) `(vterm-color-inverse-video ((,c :background ,bg-main :inverse-video t))) - `(vterm-color-magenta ((,c :background ,magenta-cooler :foreground ,magenta))) - `(vterm-color-red ((,c :background ,red-warmer :foreground ,red))) + `(vterm-color-magenta ((,c :background ,bg-term-magenta :foreground ,fg-term-magenta))) + `(vterm-color-red ((,c :background ,bg-term-red :foreground ,fg-term-red))) `(vterm-color-underline ((,c :underline t))) - `(vterm-color-white ((,c :background "white" :foreground "gray65"))) - `(vterm-color-yellow ((,c :background ,yellow-warmer :foreground ,yellow))) + `(vterm-color-white ((,c :background ,bg-term-white :foreground ,fg-term-white))) + `(vterm-color-yellow ((,c :background ,bg-term-yellow :foreground ,fg-term-yellow))) ;;;;; vundo `(vundo-default ((,c :inherit shadow))) `(vundo-highlight ((,c :inherit (bold vundo-node) :foreground ,red))) @@ -3941,7 +4022,7 @@ modus-themes-faces `(wgrep-file-face ((,c :foreground ,fg-alt))) `(wgrep-reject-face ((,c :inherit error))) ;;;;; which-function-mode - `(which-func ((,c :inherit bold :foreground ,modeline-info))) + `(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))) diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el b/etc/themes/modus-vivendi-deuteranopia-theme.el index 60c3c62b38f..6de293ad5bc 100644 --- a/etc/themes/modus-vivendi-deuteranopia-theme.el +++ b/etc/themes/modus-vivendi-deuteranopia-theme.el @@ -42,6 +42,7 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-vivendi-deuteranopia "Deuteranopia-optimized theme with a black background. This variant is optimized for users with red-green color @@ -49,7 +50,10 @@ 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 7:1 (WCAG AAA -standard).") +standard)." + :background-mode 'dark + :kind 'color-scheme + :family 'modus) (defconst modus-vivendi-deuteranopia-palette '( @@ -154,7 +158,7 @@ ;;; Special purpose (bg-completion "#2f447f") - (bg-hover "#004f70") + (bg-hover "#45605e") (bg-hover-secondary "#654a39") (bg-hl-line "#2f3849") (bg-region "#5a5a5a") @@ -197,7 +201,7 @@ (bg-removed "#3d3d00") (bg-removed-faint "#281f00") - (bg-removed-refine "#515100") + (bg-removed-refine "#555500") (bg-removed-fringe "#d0c03f") (fg-removed "#d4d48f") (fg-removed-intense "#d0b05f") @@ -283,6 +287,7 @@ (date-deadline yellow-warmer) (date-event fg-alt) (date-holiday yellow-warmer) + (date-holiday-other blue) (date-now blue-faint) (date-range fg-alt) (date-scheduled yellow-cooler) @@ -366,6 +371,48 @@ (fg-space border) (bg-space-err bg-yellow-intense) +;;;; Terminal mappings + + (bg-term-black "black") + (fg-term-black "black") + (bg-term-black-bright "gray35") + (fg-term-black-bright "gray35") + + (bg-term-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -435,7 +482,4 @@ (provide-theme 'modus-vivendi-deuteranopia)) -;;;###theme-autoload -(put 'modus-vivendi-deuteranopia 'theme-properties '(:background-mode dark :kind color-scheme :family modus)) - ;;; modus-vivendi-deuteranopia-theme.el ends here diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 70dd0f78675..b193a96524f 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -42,12 +42,16 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-vivendi "Elegant, highly legible theme with a black 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 -7:1 (WCAG AAA standard).") +7:1 (WCAG AAA standard)." + :background-mode 'dark + :kind 'color-scheme + :family 'modus) (defconst modus-vivendi-palette '( @@ -152,7 +156,7 @@ ;;; Special purpose (bg-completion "#2f447f") - (bg-hover "#004f70") + (bg-hover "#45605e") (bg-hover-secondary "#654a39") (bg-hl-line "#2f3849") (bg-region "#5a5a5a") @@ -281,6 +285,7 @@ (date-deadline red) (date-event fg-alt) (date-holiday red-cooler) + (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-warmer) @@ -364,6 +369,48 @@ (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-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -434,7 +481,4 @@ (provide-theme 'modus-vivendi)) -;;;###theme-autoload -(put 'modus-vivendi 'theme-properties '(:background-mode dark :kind color-scheme :family modus)) - ;;; modus-vivendi-theme.el ends here diff --git a/etc/themes/modus-vivendi-tinted-theme.el b/etc/themes/modus-vivendi-tinted-theme.el index b6443bdf6cc..bf72f88d8e0 100644 --- a/etc/themes/modus-vivendi-tinted-theme.el +++ b/etc/themes/modus-vivendi-tinted-theme.el @@ -42,12 +42,16 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-vivendi-tinted "Elegant, highly legible theme with a night sky 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 -7:1 (WCAG AAA standard).") +7:1 (WCAG AAA standard)." + :background-mode 'dark + :kind 'color-scheme + :family 'modus) (defconst modus-vivendi-tinted-palette '( @@ -146,7 +150,7 @@ ;;; Special purpose (bg-completion "#483d8a") - (bg-hover "#004f70") + (bg-hover "#45605e") (bg-hover-secondary "#654a39") (bg-hl-line "#303a6f") (bg-region "#555a66") @@ -281,6 +285,7 @@ (date-deadline red) (date-event fg-alt) (date-holiday red-cooler) + (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-warmer) @@ -364,6 +369,48 @@ (bg-space unspecified) (fg-space border) +;;;; Terminal mappings + + (bg-term-black "black") + (fg-term-black "black") + (bg-term-black-bright "gray35") + (fg-term-black-bright "gray35") + + (bg-term-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -433,7 +480,4 @@ (provide-theme 'modus-vivendi-tinted)) -;;;###theme-autoload -(put 'modus-vivendi-tinted 'theme-properties '(:background-mode dark :kind color-scheme :family modus)) - ;;; modus-vivendi-tinted-theme.el ends here diff --git a/etc/themes/modus-vivendi-tritanopia-theme.el b/etc/themes/modus-vivendi-tritanopia-theme.el index 0d09989e2a7..d808d0250fc 100644 --- a/etc/themes/modus-vivendi-tritanopia-theme.el +++ b/etc/themes/modus-vivendi-tritanopia-theme.el @@ -6,6 +6,7 @@ ;; 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 +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -42,6 +43,7 @@ (require-theme 'modus-themes t)) (require 'modus-themes)) +;;;###theme-autoload (deftheme modus-vivendi-tritanopia "Tritanopia-optimized theme with a black background. This variant is optimized for users with blue-yellow color @@ -49,7 +51,10 @@ 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 7:1 (WCAG AAA -standard).") +standard)." + :background-mode 'dark + :kind 'color-scheme + :family 'modus) (defconst modus-vivendi-tritanopia-palette '( @@ -161,8 +166,8 @@ (fg-region "#ffffff") (bg-char-0 "#922a00") - (bg-char-1 "#4f3f7f") - (bg-char-2 "#00709f") + (bg-char-1 "#00709f") + (bg-char-2 "#5f3faf") (bg-mode-line-active "#003c52") (fg-mode-line-active "#f0f0f0") @@ -283,6 +288,7 @@ (date-deadline red) (date-event fg-alt) (date-holiday red-intense) + (date-holiday-other cyan-warmer) (date-now fg-main) (date-range fg-alt) (date-scheduled magenta) @@ -366,6 +372,48 @@ (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-red red) + (fg-term-red red) + (bg-term-red-bright red-warmer) + (fg-term-red-bright red-warmer) + + (bg-term-green green) + (fg-term-green green) + (bg-term-green-bright green-cooler) + (fg-term-green-bright green-cooler) + + (bg-term-yellow yellow) + (fg-term-yellow yellow) + (bg-term-yellow-bright yellow-warmer) + (fg-term-yellow-bright yellow-warmer) + + (bg-term-blue blue) + (fg-term-blue blue) + (bg-term-blue-bright blue-warmer) + (fg-term-blue-bright blue-warmer) + + (bg-term-magenta magenta) + (fg-term-magenta magenta) + (bg-term-magenta-bright magenta-cooler) + (fg-term-magenta-bright magenta-cooler) + + (bg-term-cyan cyan) + (fg-term-cyan cyan) + (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") + ;;;; Heading mappings (fg-heading-0 cyan-cooler) @@ -435,7 +483,4 @@ (provide-theme 'modus-vivendi-tritanopia)) -;;;###theme-autoload -(put 'modus-vivendi-tritanopia 'theme-properties '(:background-mode dark :kind color-scheme :family modus)) - ;;; modus-vivendi-tritanopia-theme.el ends here commit a2953ea30034e9ae5a8be8198bdd8a3d63f87777 Merge: a3a9ed40d89 5cba5ee8905 Author: Eli Zaretskii Date: Tue Sep 19 15:10:58 2023 +0300 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit 7fd2a601ab8d6eb5d937db0478ed9e17f5e9e391 Author: Po Lu Date: Tue Sep 19 19:59:21 2023 +0800 ; Fix typos in last change * src/android.c (android_exception_check_2) (android_exception_check_3, android_exception_check_4): Fix typos. diff --git a/src/android.c b/src/android.c index bdf99b46eca..4caaf377781 100644 --- a/src/android.c +++ b/src/android.c @@ -5752,7 +5752,7 @@ android_exception_check_2 (jobject object, jobject object1) if (object) ANDROID_DELETE_LOCAL_REF (object); - if (object) + if (object1) ANDROID_DELETE_LOCAL_REF (object1); memory_full (0); @@ -5778,10 +5778,10 @@ android_exception_check_3 (jobject object, jobject object1, if (object) ANDROID_DELETE_LOCAL_REF (object); - if (object) + if (object1) ANDROID_DELETE_LOCAL_REF (object1); - if (object) + if (object2) ANDROID_DELETE_LOCAL_REF (object2); memory_full (0); @@ -5807,13 +5807,13 @@ android_exception_check_4 (jobject object, jobject object1, if (object) ANDROID_DELETE_LOCAL_REF (object); - if (object) + if (object1) ANDROID_DELETE_LOCAL_REF (object1); - if (object) + if (object2) ANDROID_DELETE_LOCAL_REF (object2); - if (object) + if (object3) ANDROID_DELETE_LOCAL_REF (object3); memory_full (0); commit d18be275946eaf4e0297adacb37258cf94e46682 Author: Po Lu Date: Tue Sep 19 19:57:14 2023 +0800 Update Android port * src/android.c (android_exception_check_1) (android_exception_check_2, android_exception_check_3) (android_exception_check_4): Permit each object to be NULL. (android_browse_url): Release VALUE if an exception transpires. diff --git a/src/android.c b/src/android.c index 2cc86d8c56f..bdf99b46eca 100644 --- a/src/android.c +++ b/src/android.c @@ -5710,8 +5710,9 @@ android_exception_check (void) } /* Check for JNI exceptions. If there is one such exception, clear - it, then delete the local reference to OBJECT and call - memory_full. */ + it, then delete the local reference to OBJECT and call memory_full. + OBJECT can be NULL, which is a valid local reference to the Java + null object. */ void android_exception_check_1 (jobject object) @@ -5725,7 +5726,10 @@ android_exception_check_1 (jobject object) /* Describe exactly what went wrong. */ (*android_java_env)->ExceptionDescribe (android_java_env); (*android_java_env)->ExceptionClear (android_java_env); - ANDROID_DELETE_LOCAL_REF (object); + + if (object) + ANDROID_DELETE_LOCAL_REF (object); + memory_full (0); } @@ -5744,8 +5748,13 @@ android_exception_check_2 (jobject object, jobject object1) /* Describe exactly what went wrong. */ (*android_java_env)->ExceptionDescribe (android_java_env); (*android_java_env)->ExceptionClear (android_java_env); - ANDROID_DELETE_LOCAL_REF (object); - ANDROID_DELETE_LOCAL_REF (object1); + + if (object) + ANDROID_DELETE_LOCAL_REF (object); + + if (object) + ANDROID_DELETE_LOCAL_REF (object1); + memory_full (0); } @@ -5765,9 +5774,16 @@ android_exception_check_3 (jobject object, jobject object1, /* Describe exactly what went wrong. */ (*android_java_env)->ExceptionDescribe (android_java_env); (*android_java_env)->ExceptionClear (android_java_env); - ANDROID_DELETE_LOCAL_REF (object); - ANDROID_DELETE_LOCAL_REF (object1); - ANDROID_DELETE_LOCAL_REF (object2); + + if (object) + ANDROID_DELETE_LOCAL_REF (object); + + if (object) + ANDROID_DELETE_LOCAL_REF (object1); + + if (object) + ANDROID_DELETE_LOCAL_REF (object2); + memory_full (0); } @@ -5787,10 +5803,19 @@ android_exception_check_4 (jobject object, jobject object1, /* Describe exactly what went wrong. */ (*android_java_env)->ExceptionDescribe (android_java_env); (*android_java_env)->ExceptionClear (android_java_env); - ANDROID_DELETE_LOCAL_REF (object); - ANDROID_DELETE_LOCAL_REF (object1); - ANDROID_DELETE_LOCAL_REF (object2); - ANDROID_DELETE_LOCAL_REF (object3); + + if (object) + ANDROID_DELETE_LOCAL_REF (object); + + if (object) + ANDROID_DELETE_LOCAL_REF (object1); + + if (object) + ANDROID_DELETE_LOCAL_REF (object2); + + if (object) + ANDROID_DELETE_LOCAL_REF (object3); + memory_full (0); } @@ -6127,7 +6152,7 @@ android_browse_url (Lisp_Object url, Lisp_Object send) buffer = (*android_java_env)->GetStringUTFChars (android_java_env, (jstring) value, NULL); - android_exception_check_1 (string); + android_exception_check_1 (value); /* Otherwise, build the string describing the error. */ tem = build_string_from_utf8 (buffer); commit 761f8901fffdb155cbcc7f3b5a2329161c2c1826 Author: Alan Mackenzie Date: Tue Sep 19 10:25:34 2023 +0000 Don't use ellipses while cl-printing strings. This fixes bug#65680. The former use of print-length as a bound on the length of the printed string was erroneous, causing error messages preceding backtracees to get unnecessarily truncated to 50 characters. * lisp/emacs-lisp/cl-print.el (cl-print-object ): Remove the substitution of ellipses for long strings. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-ellipsis-string): Remove this test. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 71929caabb8..627b6cc3089 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -264,27 +264,17 @@ cl-print-object-contents (cl-defmethod cl-print-object ((object string) stream) (unless stream (setq stream standard-output)) (let* ((has-properties (or (text-properties-at 0 object) - (next-property-change 0 object))) - (len (length object)) - (limit (if (natnump print-length) (min print-length len) len))) + (next-property-change 0 object)))) (if (and has-properties cl-print--depth (natnump print-level) (> cl-print--depth print-level)) (cl-print-insert-ellipsis object nil stream) - ;; Print all or part of the string + ;; Print the string. (when has-properties (princ "#(" stream)) - (if (= limit len) - (prin1 (if has-properties (substring-no-properties object) object) - stream) - (let ((part (concat (substring-no-properties object 0 limit) "..."))) - (prin1 part stream) - (when (bufferp stream) - (with-current-buffer stream - (cl-print-propertize-ellipsis object limit - (- (point) 4) - (- (point) 1) stream))))) + (prin1 (if has-properties (substring-no-properties object) object) + stream) ;; Print the property list. (when has-properties (cl-print--string-props object 0 stream) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 3073a42e39d..e44a8e5ccc4 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -58,21 +58,6 @@ cl-print-tests-ellipsis-vector (cl-print-tests-check-ellipsis-expansion [a [b [c [d [e]]]]] "[a [b [c ...]]]" "[d [e]]"))) -(ert-deftest cl-print-tests-ellipsis-string () - "Ellipsis expansion works in strings." - (let ((print-length 4) - (print-level 3)) - (cl-print-tests-check-ellipsis-expansion - "abcdefg" "\"abcd...\"" "efg") - (cl-print-tests-check-ellipsis-expansion - "abcdefghijk" "\"abcd...\"" "efgh...") - (cl-print-tests-check-ellipsis-expansion - '(1 (2 (3 #("abcde" 0 5 (test t))))) - "(1 (2 (3 ...)))" "#(\"abcd...\" 0 5 (test t))") - (cl-print-tests-check-ellipsis-expansion - #("abcd" 0 1 (bold t) 1 2 (invisible t) 3 4 (italic t)) - "#(\"abcd\" 0 1 (bold t) ...)" "1 2 (invisible t) ..."))) - (ert-deftest cl-print-tests-ellipsis-struct () "Ellipsis expansion works in structures." (let ((print-length 4) @@ -144,7 +129,7 @@ cl-print-tests-print-to-string-with-limit ;; Print something which needs to be abbreviated and which can be. (should (< (length (cl-print-to-string-with-limit #'cl-prin1 thing100 100)) - 100 + 150 ;; 100. The LIMIT argument is advisory rather than absolute. (length (cl-prin1-to-string thing100)))) ;; Print something resistant to easy abbreviation. commit ea5ae08b0623f091666373765d831667895c4351 Author: Andrea Corallo Date: Tue Sep 19 10:37:33 2023 +0200 * lisp/emacs-lisp/comp.el (comp-final1): Clean-up unused form. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a8567c5da00..37771eb004e 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3757,13 +3757,10 @@ comp-compile-ctxt-to-file (comp--compile-ctxt-to-file name))) (defun comp-final1 () - (let (compile-result) - (comp--init-ctxt) - (unwind-protect - (setf compile-result - (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt))) - (and (comp--release-ctxt) - compile-result)))) + (comp--init-ctxt) + (unwind-protect + (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) + (comp--release-ctxt))) (defvar comp-async-compilation nil "Non-nil while executing an asynchronous native compilation.") commit 438d71e83b7d51faf7ef2d11bea3d5fd743390f6 Author: Andrea Corallo Date: Tue Sep 19 10:32:50 2023 +0200 * lisp/emacs-lisp/comp.el (comp-op-to-fun): Use `string-replace'. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e1bb70fe5d4..a8567c5da00 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1851,7 +1851,7 @@ comp-emit-set-call-subr (eval-when-compile (defun comp-op-to-fun (x) "Given the LAP op strip \"byte-\" to have the subr name." - (intern (replace-regexp-in-string "byte-" "" x))) + (intern (string-replace "byte-" "" x))) (defun comp-body-eff (body op-name sp-delta) "Given the original BODY, compute the effective one. commit 5cba5ee8905a41484beef4100976acd52b5b1531 Author: Yuan Fu Date: Sat Sep 16 09:03:16 2023 -0700 Fix tree-sitter range update function * lisp/treesit.el (treesit-update-ranges): If an embedded language doesn't have any range, don't set its range to nil (which means whole buffer), instead, set its range to a dummy (1 . 1) zero range. diff --git a/lisp/treesit.el b/lisp/treesit.el index 41ebc62fca6..8163ffdf329 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -544,7 +544,12 @@ treesit-update-ranges (when (eq (treesit-parser-language parser) language) (treesit-parser-set-included-ranges - parser set-ranges)))))))) + parser (or set-ranges + ;; When there's no range for the embedded + ;; language, set it's range to a dummy (1 + ;; . 1), otherwise it would be set to the + ;; whole buffer, which is not what we want. + `((,(point-min) . ,(point-min)))))))))))) (defun treesit-parser-range-on (parser beg &optional end) "Check if PARSER's range covers the portion between BEG and END. commit fc7c1f1e93e48ea17657da247590439bff831798 Author: Yuan Fu Date: Mon Sep 18 20:47:50 2023 -0700 Fix treesit--update-ranges-local * lisp/treesit.el (treesit--update-ranges-local): Don't forget to set local parser's range when creating it. diff --git a/lisp/treesit.el b/lisp/treesit.el index 00a19f6188f..f0d6f32b421 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -681,7 +681,9 @@ treesit--update-ranges-local (let ((embedded-parser (treesit-parser-create embedded-lang nil t 'embedded)) (ov (make-overlay beg end nil nil t))) - (overlay-put ov 'treesit-parser embedded-parser))))))) + (overlay-put ov 'treesit-parser embedded-parser) + (treesit-parser-set-included-ranges + embedded-parser `((,beg . ,end))))))))) (defun treesit-update-ranges (&optional beg end) "Update the ranges for each language in the current buffer. commit acdb77c28947f0349e63fdb9759c90729b64956b Author: Jim Porter Date: Mon Sep 18 18:00:07 2023 -0700 ; Add debug instrumention for queueing commands in Eshell * lisp/eshell/esh-cmd.el (eshell-eval-command): Log the new command form. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index af50a485226..b4d9b044a7b 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -990,15 +990,19 @@ eshell-eval-command (:eshell-background . PROCESS)" (if eshell-current-command - ;; We can just stick the new command at the end of the current - ;; one, and everything will happen as it should. - (setcdr (last (cdr eshell-current-command)) - (list `(let ((here (and (eobp) (point)))) - ,(and input - `(insert-and-inherit ,(concat input "\n"))) - (if here - (eshell-update-markers here)) - (eshell-do-eval ',command)))) + (progn + ;; We can just stick the new command at the end of the current + ;; one, and everything will happen as it should. + (setcdr (last (cdr eshell-current-command)) + (list `(let ((here (and (eobp) (point)))) + ,(and input + `(insert-and-inherit ,(concat input "\n"))) + (if here + (eshell-update-markers here)) + (eshell-do-eval ',command)))) + (eshell-debug-command 'form + "enqueued command form for %S\n\n%s" + (or input "") (eshell-stringify eshell-current-command))) (eshell-debug-command-start input) (setq eshell-current-command command) (let* (result commit e942581488a139eaf82d77f4d430cf18ace6c728 Author: Paul Eggert Date: Mon Sep 18 14:09:24 2023 -0700 Improve XUNTAG comment * src/lisp.h (XUNTAG): Shorten (and I hope clarify) new comment. diff --git a/src/lisp.h b/src/lisp.h index de6746f1c07..79ce8e5fa8e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -808,10 +808,9 @@ definitely_will_not_unexec_p (void) } /* Extract A's pointer value, assuming A's Lisp type is TYPE and the - extracted pointer's type is CTYPE *. - Note that the second term vanishes if EMACS_INT is wider than pointers - and the tag is in the upper bits (ie, USE_LSB_TAG=0); this makes - untagging slightly cheaper in that case. */ + extracted pointer's type is CTYPE *. When !USE_LSB_TAG this simply + extracts A's low-order bits, as (uintptr_t) LISP_WORD_TAG (type) is + always zero then. */ #define XUNTAG(a, type, ctype) \ ((ctype *) ((uintptr_t) XLP (a) - (uintptr_t) LISP_WORD_TAG (type))) commit 861f9cb78370e2b78f852e5ccde9b63c94486ca8 Author: Mattias Engdegård Date: Mon Aug 28 11:13:10 2023 +0200 Don't use pointer arithmetic for untagging Lisp values (bug#65491) * src/lisp.h (XUNTAG): Instead of casting a Lisp value to char * and subtracting the tag, cast it to a suitable integral type and work on that. This should result in identical or at least equivalent code, except that it avoids potential problems arising from the restrictions on pointer arithmetic in C. In particular, a null pointer can be neither an operand in nor the result of pointer arithmetic. C compilers know this and would, prior to this change, optimise XUNTAG(obj, Lisp_Int0, mytype) != NULL to 1. This means, for example, that make_pointer_integer and XFIXNUMPTR could not be entrusted with null pointers, and next_vector in alloc.c was unsafe to use. diff --git a/src/lisp.h b/src/lisp.h index 50b68f2e767..de6746f1c07 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -808,10 +808,12 @@ definitely_will_not_unexec_p (void) } /* Extract A's pointer value, assuming A's Lisp type is TYPE and the - extracted pointer's type is CTYPE *. */ - -#define XUNTAG(a, type, ctype) ((ctype *) \ - ((char *) XLP (a) - LISP_WORD_TAG (type))) + extracted pointer's type is CTYPE *. + Note that the second term vanishes if EMACS_INT is wider than pointers + and the tag is in the upper bits (ie, USE_LSB_TAG=0); this makes + untagging slightly cheaper in that case. */ +#define XUNTAG(a, type, ctype) \ + ((ctype *) ((uintptr_t) XLP (a) - (uintptr_t) LISP_WORD_TAG (type))) /* A forwarding pointer to a value. It uses a generic pointer to avoid alignment bugs that could occur if it used a pointer to a commit 146bd41ddef21a19634e2b90db4bfb619a2091b2 Author: Jim Porter Date: Mon Sep 18 10:17:12 2023 -0700 Fix another race condition when waiting for Eshell processes When checking if the other processes in our pipeline are "alive", we also need to check whether their sentinels are finished. Otherwise, we might proceed with command evaluation while one of the other processes is still cleaning up. * lisp/eshell/esh-proc.el (eshell-process-active-p): New function... (eshell-wait-for-process) * lisp/eshell/esh-cmd.el (eshell-resume-command): ... use it. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 0d73b2d6e69..af50a485226 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1018,7 +1018,7 @@ eshell-resume-command ;; Make sure PROC is one of our foreground processes and ;; that all of those processes are now dead. (member proc eshell-last-async-procs) - (not (seq-some #'process-live-p eshell-last-async-procs))) + (not (seq-some #'eshell-process-active-p eshell-last-async-procs))) (eshell-resume-eval))) (defun eshell-resume-eval () diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index aed8f8af93d..e564c755320 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -157,15 +157,21 @@ eshell-reset-after-proc (declare-function eshell-reset "esh-mode" (&optional no-hooks)) (eshell-reset))) +(defun eshell-process-active-p (process) + "Return non-nil if PROCESS is active. +This is like `process-live-p', but additionally checks whether +`eshell-sentinel' has finished all of its work yet." + (or (process-live-p process) + ;; If we have handles, this is an Eshell-managed + ;; process. Wait until we're 100% done and have + ;; cleared out the handles (see `eshell-sentinel'). + (process-get process :eshell-handles))) + (defun eshell-wait-for-process (&rest procs) "Wait until PROCS have successfully completed." (dolist (proc procs) (when (eshell-processp proc) - (while (or (process-live-p proc) - ;; If we have handles, this is an Eshell-managed - ;; process. Wait until we're 100% done and have - ;; cleared out the handles (see `eshell-sentinel'). - (process-get proc :eshell-handles)) + (while (eshell-process-active-p proc) (when (input-pending-p) (discard-input)) (sit-for eshell-process-wait-seconds commit 41333cb2d5f42d5fe23f77d4a8c7ae25bb88f8f0 Author: Michael Albinus Date: Mon Sep 18 18:00:07 2023 +0200 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index 2aa1f148f90..1b3532b5657 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -35,10 +35,10 @@ using 'emacsclient': Previously, users had to manually configure their GNU/Linux desktop environment to open 'org-protocol' links in Emacs. These links should -now open in Emacs automatically, as the 'emacsclient.desktop' file now +now open in Emacs automatically, as the "emacsclient.desktop" file now arranges for Emacs to be the default application for the 'org-protocol' -URI scheme. See the Org mode manual, Info node '(org) Protocols for -External Access' for more details. +URI scheme. See the Org mode manual, Info node "(org) Protocols" for +more details. * Changes in Emacs 29.2 commit a3a9ed40d894ec5c91a97b36c23f8fffcef83c40 Author: Eli Zaretskii Date: Mon Sep 18 14:21:22 2023 +0300 ; * CONTRIBUTE: Clarify "mark" wrt NEWS entries. (Bug#66067) diff --git a/CONTRIBUTE b/CONTRIBUTE index 9e3b1c7a646..9f08bbe7387 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -120,9 +120,9 @@ Emacs version in which they will appear. Likewise with defcustom's whose value is changed -- update their ':version' tag. Think about whether your change requires updating the manuals. If you -know it does not, mark the NEWS entry with "---". If you know -that *all* the necessary documentation updates have been made as part -of your changes or those by others, mark the entry with "+++". +know it does not, mark the NEWS entry with "---" before the entry. If +you know that *all* the necessary documentation updates have been made +as part of your changes or those by others, mark the entry with "+++". Otherwise, do not mark it. If your change requires updating the manuals to document new commit 0a6a9ac6f1498bd7c05001400f3be8e93caeba91 Author: Eli Zaretskii Date: Mon Sep 18 14:10:30 2023 +0300 ; * etc/NEWS: Fix last change. diff --git a/etc/NEWS b/etc/NEWS index 4e7e2671d1d..2aa1f148f90 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -27,7 +27,7 @@ applies, and please also update docstrings as needed. * Startup Changes in Emacs 29.2 -** Emacs is now the default application for the 'org-protocol' URI scheme. +** On GNU/Linux, Emacs is now the default application for 'org-protocol'. Org mode provides a way to quickly capture bookmarks, notes, and links using 'emacsclient': @@ -35,8 +35,10 @@ using 'emacsclient': Previously, users had to manually configure their GNU/Linux desktop environment to open 'org-protocol' links in Emacs. These links should -now open in Emacs automatically. See the Org mode manual, Info node -'(org) Protocols for External Access' for more details. +now open in Emacs automatically, as the 'emacsclient.desktop' file now +arranges for Emacs to be the default application for the 'org-protocol' +URI scheme. See the Org mode manual, Info node '(org) Protocols for +External Access' for more details. * Changes in Emacs 29.2 commit 5611274bbdad683b2d78c64ce57e28d5eff35f35 Author: Ihor Radchenko Date: Mon Sep 18 11:26:27 2023 +0300 Announce handling 'org-protocol' URI scheme in NEWS * etc/NEWS: Document handling 'org-protocol' URI scheme. The commit implementing the new functionality is 05a7c91b91c. (Bug#65469) diff --git a/etc/NEWS b/etc/NEWS index e74cbee4a53..4e7e2671d1d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -27,6 +27,17 @@ applies, and please also update docstrings as needed. * Startup Changes in Emacs 29.2 +** Emacs is now the default application for the 'org-protocol' URI scheme. +Org mode provides a way to quickly capture bookmarks, notes, and links +using 'emacsclient': + + emacsclient "org-protocol://store-link?url=URL&title=TITLE" + +Previously, users had to manually configure their GNU/Linux desktop +environment to open 'org-protocol' links in Emacs. These links should +now open in Emacs automatically. See the Org mode manual, Info node +'(org) Protocols for External Access' for more details. + * Changes in Emacs 29.2 commit 1500e4b4329d4d3d0141263230d74e1b314373b1 Author: Ihor Radchenko Date: Wed Aug 23 12:24:18 2023 +0300 Make emacsclient handle org-protocol:// links Org mode provides a way to quickly capture bookmarks, notes, and links using emacsclient: emacsclient "org-protocol://store-link?url=URL&title=TITLE" * etc/emacsclient.desktop: Make Emacs the default application for org-protocol. (Bug#65469) (cherry picked from commit 05a7c91b91c02c34ec6527119a465e5408dea2b1) diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop index a9f840c7033..4395d3b02bc 100644 --- a/etc/emacsclient.desktop +++ b/etc/emacsclient.desktop @@ -2,7 +2,7 @@ Name=Emacs (Client) GenericName=Text Editor Comment=Edit text -MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++; +MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++;x-scheme-handler/org-protocol; Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient --alternate-editor= --create-frame; fi" sh %F Icon=emacs Type=Application commit 6bc3800000c6d4ed87330df5eee0958e29aa6521 Author: Robert Pluim Date: Mon Sep 18 10:41:01 2023 +0200 Ensure ucs-names is consistent with Unicode names * lisp/international/mule-cmds.el (ucs-names): Skip adding an old-name if it conflicts with the offical name of a codepoint. Adjust the ranges iterated over to account for new Unicode codepoints. * test/lisp/international/mule-tests.el (mule-cmds-tests--ucs-names-old-name-override, mule-cmds-tests--ucs-names-missing-names): New tests for checking 'ucs-names' consistency. Bug#65997 diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 3d6d66970d3..a906c032b9a 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3094,6 +3094,10 @@ ucs-names (defun ucs-names () "Return table of CHAR-NAME keys and CHAR-CODE values cached in `ucs-names'." (or ucs-names + ;; Sometimes these ranges will need adjusting as codepoints are + ;; added to unicode. The test case + ;; 'mule-cmds-tests--ucs-names-missing-names' will tell you + ;; which are missing (Bug#65997). (let ((ranges '((#x0000 . #x33FF) ;; (#x3400 . #x4DBF) CJK Ideographs Extension A @@ -3106,14 +3110,16 @@ ucs-names (#x14400 . #x14646) ;; (#x14647 . #x167FF) unused (#x16800 . #x16F9F) - (#x16FE0 . #x16FE3) + (#x16FE0 . #x16FF1) ;; (#x17000 . #x187FF) Tangut Ideographs ;; (#x18800 . #x18AFF) Tangut Components ;; (#x18B00 . #x18CFF) Khitan Small Script ;; (#x18D00 . #x18D0F) Tangut Ideograph Supplement ;; (#x18D10 . #x1AFEF) unused - (#x1AFF0 . #x1B12F) - ;; (#x1B130 . #x1B14F) unused + (#x1AFF0 . #x1B122) + ;; (#x1B123 . #x1B131) unused + (#x1B132 . #x1B132) + ;; (#x1B133 . #x1B14F) unused (#x1B150 . #x1B16F) (#x1B170 . #x1B2FF) ;; (#x1B300 . #x1BBFF) unused @@ -3130,12 +3136,16 @@ ucs-names (while (<= c end) (let ((new-name (get-char-code-property c 'name)) (old-name (get-char-code-property c 'old-name))) - ;; In theory this code could end up pushing an "old-name" that - ;; shadows a "new-name" but in practice every time an - ;; `old-name' conflicts with a `new-name', the newer one has a - ;; higher code, so it gets pushed later! + ;; This code used to push both old-name and new-name + ;; on the assumption that the new-name codepoint would + ;; always be higher, which was true for a long time. + ;; As of at latest 2023-09-15, this is no longer true, + ;; so we now skip the old-name if it conflicts with an + ;; existing new-name (Bug#65997). (if new-name (puthash new-name c names)) - (if old-name (puthash old-name c names)) + (when (and old-name + (not (gethash old-name names))) + (puthash old-name c names)) ;; Unicode uses the spelling "lamda" in character ;; names, instead of "lambda", due to "preferences ;; expressed by the Greek National Body" (Bug#30513). diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 3e0c5bf9f4b..4dc099a18af 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -49,6 +49,30 @@ mule-cmds--test-universal-coding-system-argument (kbd "C-x RET c u t f - 8 RET C-u C-u c a b RET") (read-string "prompt:")))))) +;;Bug#65997, ensure that old-names haven't overriden new names. +(ert-deftest mule-cmds-tests--ucs-names-old-name-override () + (let (code-points) + (dotimes (u (1+ (max-char 'ucs))) + (when-let* ((name (get-char-code-property u 'name)) + (c (char-from-name name))) + (when (and (not (<= #xD800 u #xDFFF)) + (not (= c u))) + (push (format "%X" u) code-points)))) + (setq code-points (nreverse code-points)) + (should (null code-points)))) + +;; Bug#65997, ensure that all codepoints with names are in '(ucs-names)'. +(ert-deftest mule-cmds-tests--ucs-names-missing-names () + (let (code-points) + (dotimes (u (1+ (max-char 'ucs))) + (when-let ((name (get-char-code-property u 'name))) + (when (and (not (<= #xD800 u #xDFFF)) + (not (<= #x18800 u #x18AFF)) + (not (char-from-name name))) + (push (format "%X" u) code-points)))) + (setq code-points (nreverse code-points)) + (should (null code-points)))) + (ert-deftest mule-utf-7 () ;; utf-7 and utf-7-imap are not ASCII-compatible. (should-not (coding-system-get 'utf-7 :ascii-compatible-p)) commit 93134bb9c2f46b906b1b31b8fec264123d1962ee Author: Shynur Date: Thu Sep 7 09:58:59 2023 +0200 Make key-translate actually work * lisp/keymap.el (key-translate): Use the first element of the parsed keys rather than the whole vector. (Bug#65735) diff --git a/lisp/keymap.el b/lisp/keymap.el index 093536eda93..7e659c42002 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -382,15 +382,17 @@ key-translate This function creates a `keyboard-translate-table' if necessary and then modifies one entry in it. -Both KEY and TO should be specified by strings that satisfy `key-valid-p'." +Both FROM and TO should be specified by strings that satisfy `key-valid-p'." (declare (compiler-macro (lambda (form) (keymap--compile-check from to) form))) (keymap--check from) (keymap--check to) (or (char-table-p keyboard-translate-table) (setq keyboard-translate-table - (make-char-table 'keyboard-translate-table nil))) - (aset keyboard-translate-table (key-parse from) (key-parse to))) + (make-char-table 'keyboard-translate-table nil))) + (aset keyboard-translate-table + (aref (key-parse from) 0) + (aref (key-parse to) 0))) (defun keymap-lookup (keymap key &optional accept-default no-remap position) "Return the binding for command KEY in KEYMAP. commit 991bf3f0f5dff66794785ebfcc867611fe75e0da Author: Andrea Corallo Date: Mon Sep 18 10:04:57 2023 +0200 * Fix comp-function-type-spec for non symbol input (bug#66021) * lisp/emacs-lisp/comp.el (comp-function-type-spec): Make it robust against closures (bug#66021). diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index bb4552459dd..e1bb70fe5d4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4506,8 +4506,10 @@ comp-function-type-spec type-spec ) (when-let ((res (gethash function comp-known-func-cstr-h))) (setf type-spec (comp-cstr-to-type-spec res))) - (let ((f (symbol-function function))) - (when (and (null type-spec) + (let ((f (and (symbolp function) + (symbol-function function)))) + (when (and f + (null type-spec) (subr-native-elisp-p f)) (setf kind 'inferred type-spec (subr-type f)))) commit b331bf6d8a21ef3ac7e70d3f4a937e4256178d55 Author: Po Lu Date: Mon Sep 18 14:14:20 2023 +0800 Correct build on systems without PAGE_MASK * exec/exec.c (write_load_command) : Uniformly define even if !HAVE_GETPAGESIZE. diff --git a/exec/exec.c b/exec/exec.c index dae05755675..231b5b1c46a 100644 --- a/exec/exec.c +++ b/exec/exec.c @@ -309,10 +309,10 @@ write_load_command (program_header *header, bool use_alternate, #else /* HAVE_GETPAGESIZE */ if (!pagesize) pagesize = sysconf (_SC_PAGESIZE); +#endif /* HAVE_GETPAGESIZE */ #define PAGE_MASK (~(pagesize - 1)) #define PAGE_SIZE (pagesize) -#endif /* HAVE_GETPAGESIZE */ #endif /* PAGE_MASK */ start = header->p_vaddr & PAGE_MASK; commit cd69120731f3407a4ba8c62cc195edaf411134ce Author: Po Lu Date: Mon Sep 18 14:13:30 2023 +0800 Correct crash in child processes under armeabi Android * exec/trace.c (process_system_call) : Examine tracee->waiting_for_syscall and avoid rewriting user arguments if a system call is presently being executed by the kernel. Reported by Romário Rios . diff --git a/exec/trace.c b/exec/trace.c index 3b384792d0a..f9deef8eb2d 100644 --- a/exec/trace.c +++ b/exec/trace.c @@ -1039,16 +1039,22 @@ process_system_call (struct exec_tracee *tracee) #endif /* READLINK_SYSCALL */ case READLINKAT_SYSCALL: - /* Handle this readlinkat system call. */ - rc = handle_readlinkat (callno, ®s, tracee, - &result); + /* This system call is already in progress if + TRACEE->waiting_for_syscall is true. */ - /* rc means the same as in `handle_exec'. */ + if (!tracee->waiting_for_syscall) + { + /* Handle this readlinkat system call. */ + rc = handle_readlinkat (callno, ®s, tracee, + &result); + + /* rc means the same as in `handle_exec'. */ - if (rc == 1) - goto report_syscall_error; - else if (rc == 2) - goto emulate_syscall; + if (rc == 1) + goto report_syscall_error; + else if (rc == 2) + goto emulate_syscall; + } /* Fallthrough. */ commit b892da5f615306c04d9d1b2e95954d14e1481752 Author: Danny Freeman Date: Fri Sep 15 11:29:05 2023 -0400 Offset ranges before applying embedded tree-sitter parser This feature would allow treesitter major modes to easily specify offsets when using embeded parsers. A potential use case for this is javascript template strings, when we want to apply a different parser to the string's contents, but do not want to include the template string's delimiters. * lisp/treesit.el (treesit-query-range): Accept an optional offest arg, apply the offset to all returned ranges. (treesit-range-rules): Accept an optional :offset keyword arg to adjust ranges an embded parser is applied to. (treesit-update-ranges): Forward optional :offset setting from `treesit-range-rules' to `treesit-query-rang'. * test/lisp/treesit-tests.el (treesit-range-offset): Tests the new offset functionality. diff --git a/lisp/treesit.el b/lisp/treesit.el index 78bd149b7e2..00a19f6188f 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -449,34 +449,40 @@ treesit-query-string (treesit-parser-root-node parser) query)))) -(defun treesit-query-range (node query &optional beg end) +(defun treesit-query-range (node query &optional beg end offset) "Query the current buffer and return ranges of captured nodes. QUERY, NODE, BEG, END are the same as in `treesit-query-capture'. This function returns a list of (START . END), where START and -END specifics the range of each captured node. Capture names -generally don't matter, but names that starts with an underscore -are ignored." - (cl-loop for capture - in (treesit-query-capture node query beg end) - for name = (car capture) - for node = (cdr capture) - if (not (string-prefix-p "_" (symbol-name name))) - collect (cons (treesit-node-start node) - (treesit-node-end node)))) +END specifics the range of each captured node. OFFSET is an +optional pair of numbers (START-OFFSET . END-OFFSET). The +respective offset values are added to each (START . END) range +being returned. Capture names generally don't matter, but names +that starts with an underscore are ignored." + (let ((offset-left (or (car offset) 0)) + (offset-right (or (cdr offset) 0))) + (cl-loop for capture + in (treesit-query-capture node query beg end) + for name = (car capture) + for node = (cdr capture) + if (not (string-prefix-p "_" (symbol-name name))) + collect (cons (+ (treesit-node-start node) offset-left) + (+ (treesit-node-end node) offset-right))))) ;;; Range API supplement (defvar-local treesit-range-settings nil "A list of range settings. -Each element of the list is of the form (QUERY LANGUAGE LOCAL-P). -When updating the range of each parser in the buffer, +Each element of the list is of the form (QUERY LANGUAGE LOCAL-P +OFFSET). When updating the range of each parser in the buffer, `treesit-update-ranges' queries each QUERY, and sets LANGUAGE's range to the range spanned by captured nodes. QUERY must be a compiled query. If LOCAL-P is t, give each range a separate local parser rather than using a single parser for all the -ranges. +ranges. If OFFSET is non-nil, it should be a cons of +numbers (START-OFFSET . END-OFFSET), where the start and end +offset are added to each queried range to get the result ranges. Capture names generally don't matter, but names that starts with an underscore are ignored. @@ -509,6 +515,7 @@ treesit-range-rules (treesit-range-rules :embed \\='javascript :host \\='html + :offset \\='(1 . -1) \\='((script_element (raw_text) @cap))) The `:embed' keyword specifies the embedded language, and the @@ -521,13 +528,20 @@ treesit-range-rules this QUERY is given a dedicated local parser. Otherwise, the range shares the same parser with other ranges. +If there's an `:offset' keyword with a pair of numbers, each +captured range is offset by those numbers. For example, an +offset of (1 . -1) will update a captured range of (2 . 8) to +be (3 . 7). This can be used to exclude things like surrounding +delimiters from being included in the range covered by an +embedded parser. + QUERY can also be a function that takes two arguments, START and END. If QUERY is a function, it doesn't need the :KEYWORD VALUE pair preceding it. This function should set the ranges for parsers in the current buffer in the region between START and END. It is OK for this function to set ranges in a larger region that encompasses the region between START and END." - (let (host embed result local) + (let (host embed offset result local) (while query-specs (pcase (pop query-specs) (:local (when (eq t (pop query-specs)) @@ -540,6 +554,12 @@ treesit-range-rules (unless (symbolp embed-lang) (signal 'treesit-error (list "Value of :embed option should be a symbol" embed-lang))) (setq embed embed-lang))) + (:offset (let ((range-offset (pop query-specs))) + (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))) (query (if (functionp query) (push (list query nil nil) result) (when (null embed) @@ -547,9 +567,9 @@ treesit-range-rules (when (null host) (signal 'treesit-error (list "Value of :host option cannot be omitted"))) (push (list (treesit-query-compile host query) - embed local) + embed local offset) result)) - (setq host nil embed nil)))) + (setq host nil embed nil offset nil)))) (nreverse result))) (defun treesit--merge-ranges (old-ranges new-ranges start end) @@ -676,6 +696,7 @@ treesit-update-ranges (let ((query (nth 0 setting)) (language (nth 1 setting)) (local (nth 2 setting)) + (offset (nth 3 setting)) (beg (or beg (point-min))) (end (or end (point-max)))) (cond @@ -687,7 +708,7 @@ treesit-update-ranges (parser (treesit-parser-create language)) (old-ranges (treesit-parser-included-ranges parser)) (new-ranges (treesit-query-range - host-lang query beg end)) + host-lang query beg end offset)) (set-ranges (treesit--clip-ranges (treesit--merge-ranges old-ranges new-ranges beg end) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 65994ce608f..4308e4048f6 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -662,6 +662,20 @@ treesit-range ;; TODO: More tests. ))) +(ert-deftest treesit-range-offset () + "Tests if range offsets work." + (skip-unless (treesit-language-available-p 'javascript)) + (with-temp-buffer + (let ((query '(((call_expression (identifier) @_html_template_fn + (template_string) @capture) + (:equal "html" @_html_template_fn))))) + (progn + (insert "const x = html`

Hello

`;") + (treesit-parser-create 'javascript)) + (should (equal '((15 . 29)) (treesit-query-range 'javascript query))) + (should (equal '((16 . 28)) (treesit-query-range + 'javascript query nil nil '(1 . -1))))))) + ;;; Multiple language (ert-deftest treesit-multi-lang () commit 9ab8b968d63d9287639bbc574873bf8fde769fea Author: Jim Porter Date: Sun Sep 17 21:06:46 2023 -0700 Use 'eshell-with-temp-command' (indirectly) to parse Eshell script files * lisp/eshell/esh-cmd.el (eshell--region-p): New function. (eshell-with-temp-command, eshell-parse-command): Support '(:file . FILENAME)' to use the contents of FILENAME. * lisp/eshell/em-script.el (eshell-source-file): Call 'eshell-parse-command' and use backticks. diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index 55a05076342..9f6f720b8b0 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -89,26 +89,13 @@ eshell-script-initialize (defun eshell-source-file (file &optional args subcommand-p) "Execute a series of Eshell commands in FILE, passing ARGS. Comments begin with `#'." - (let ((orig (point)) - (here (point-max))) - (goto-char (point-max)) - (with-silent-modifications - ;; FIXME: Why not use a temporary buffer and avoid this - ;; "insert&delete" business? --Stef - (insert-file-contents file) - (goto-char (point-max)) - (throw 'eshell-replace-command - (prog1 - (list 'let - (list (list 'eshell-command-name (list 'quote file)) - (list 'eshell-command-arguments - (list 'quote args))) - (let ((cmd (eshell-parse-command (cons here (point))))) - (if subcommand-p - (setq cmd (list 'eshell-as-subcommand cmd))) - cmd)) - (delete-region here (point)) - (goto-char orig)))))) + (let ((cmd (eshell-parse-command `(:file . ,file)))) + (when subcommand-p + (setq cmd `(eshell-as-subcommand ,cmd))) + (throw 'eshell-replace-command + `(let ((eshell-command-name ',file) + (eshell-command-arguments ',args)) + ,cmd)))) (defun eshell/source (&rest args) "Source a file in a subshell environment." diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index a4542dd917d..0d73b2d6e69 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -350,48 +350,62 @@ eshell-complete-lisp-symbols ;; Command parsing -(defmacro eshell-with-temp-command (region &rest body) - "Narrow the buffer to REGION and execute the forms in BODY. +(defsubst eshell--region-p (object) + "Return non-nil if OBJECT is a pair of numbers or markers." + (and (consp object) + (number-or-marker-p (car object)) + (number-or-marker-p (cdr object)))) -REGION is a cons cell (START . END) that specifies the region to -which to narrow the buffer. REGION can also be a string, in -which case the macro temporarily inserts it into the buffer at -point, and narrows the buffer to the inserted string. Before -executing BODY, point is set to the beginning of the narrowed -REGION. +(defmacro eshell-with-temp-command (command &rest body) + "Temporarily insert COMMAND into the buffer and execute the forms in BODY. + +COMMAND can be a string to insert, a cons cell (START . END) +specifying a region in the current buffer, or (:file . FILENAME) +to temporarily insert the contents of FILENAME. + +Before executing BODY, narrow the buffer to the text for COMMAND +and and set point to the beginning of the narrowed region. The value returned is the last form in BODY." (declare (indent 1)) - `(let ((reg ,region)) - (if (stringp reg) + (let ((command-sym (make-symbol "command")) + (begin-sym (make-symbol "begin")) + (end-sym (make-symbol "end"))) + `(let ((,command-sym ,command)) + (if (eshell--region-p ,command-sym) + (save-restriction + (narrow-to-region (car ,command-sym) (cdr ,command-sym)) + (goto-char (car ,command-sym)) + ,@body) ;; Since parsing relies partly on buffer-local state ;; (e.g. that of `eshell-parse-argument-hook'), we need to ;; perform the parsing in the Eshell buffer. - (let ((begin (point)) end) + (let ((,begin-sym (point)) ,end-sym) (with-silent-modifications - (insert reg) - (setq end (point)) + (if (stringp ,command-sym) + (insert ,command-sym) + (forward-char (cadr (insert-file-contents (cdr ,command-sym))))) + (setq ,end-sym (point)) (unwind-protect (save-restriction - (narrow-to-region begin end) - (goto-char begin) + (narrow-to-region ,begin-sym ,end-sym) + (goto-char ,begin-sym) ,@body) - (delete-region begin end)))) - (save-restriction - (narrow-to-region (car reg) (cdr reg)) - (goto-char (car reg)) - ,@body)))) + (delete-region ,begin-sym ,end-sym)))))))) (defun eshell-parse-command (command &optional args toplevel) "Parse the COMMAND, adding ARGS if given. -COMMAND can either be a string, or a cons cell demarcating a buffer -region. TOPLEVEL, if non-nil, means that the outermost command (the -user's input command) is being parsed, and that pre and post command -hooks should be run before and after the command." +COMMAND can be a string, a cons cell (START . END) demarcating a +buffer region, or (:file . FILENAME) to parse the contents of +FILENAME. + +TOPLEVEL, if non-nil, means that the outermost command (the +user's input command) is being parsed, and that pre and post +command hooks should be run before and after the command." (pcase-let* ((terms (append - (if (consp command) + (if (eshell--region-p command) (eshell-parse-arguments (car command) (cdr command)) (eshell-with-temp-command command (goto-char (point-max)) commit 4e46df96510335c086a3764e002c99348e0e9624 Author: Po Lu Date: Mon Sep 18 10:59:55 2023 +0800 Optimize damage region tracking under Android * java/org/gnu/emacs/EmacsDrawLine.java (perform): * java/org/gnu/emacs/EmacsDrawRectangle.java (perform): Call damageRect with integer coordinates in lieu of consing a new Rect. * java/org/gnu/emacs/EmacsDrawable.java (damageRect) : Declare a new variant of damageRect, accepting four integers designating the extents of the damage rectangle. * java/org/gnu/emacs/EmacsPixmap.java (damageRect) : New stub. * java/org/gnu/emacs/EmacsView.java (damageRect) : Implement this overloaded variant of damageRect. * java/org/gnu/emacs/EmacsWindow.java (damageRect): Ditto. * src/android.c (android_init_emacs_drawable) (android_init_emacs_window): Move search for `damageRect' to android_init_emacs_window. (android_damage_window): Call IIII variant of `damageRect' to avoid consing a new rectangle. Ameliorate dynamic method dispatch overhead. diff --git a/java/org/gnu/emacs/EmacsDrawLine.java b/java/org/gnu/emacs/EmacsDrawLine.java index d367ccff9c4..be4da54c075 100644 --- a/java/org/gnu/emacs/EmacsDrawLine.java +++ b/java/org/gnu/emacs/EmacsDrawLine.java @@ -29,7 +29,6 @@ public final class EmacsDrawLine perform (EmacsDrawable drawable, EmacsGC gc, int x, int y, int x2, int y2) { - Rect rect; Canvas canvas; Paint paint; int x0, x1, y0, y1; @@ -48,7 +47,6 @@ public final class EmacsDrawLine /* And the clip rectangle. */ paint = gc.gcPaint; - rect = new Rect (x0, y0, x1, y1); canvas = drawable.lockCanvas (gc); if (canvas == null) @@ -74,6 +72,6 @@ public final class EmacsDrawLine /* DrawLine with clip mask not implemented; it is not used by Emacs. */ - drawable.damageRect (rect); + drawable.damageRect (x0, y0, x1, y1); } } diff --git a/java/org/gnu/emacs/EmacsDrawRectangle.java b/java/org/gnu/emacs/EmacsDrawRectangle.java index e1261b4a2d2..ee9110daaaf 100644 --- a/java/org/gnu/emacs/EmacsDrawRectangle.java +++ b/java/org/gnu/emacs/EmacsDrawRectangle.java @@ -114,7 +114,6 @@ maskRect, new Rect (0, 0, maskBitmap.recycle (); } - drawable.damageRect (new Rect (x, y, x + width + 1, - y + height + 1)); + drawable.damageRect (x, y, x + width + 1, y + height + 1); } } diff --git a/java/org/gnu/emacs/EmacsDrawable.java b/java/org/gnu/emacs/EmacsDrawable.java index f2f8885e976..3ed72a836e5 100644 --- a/java/org/gnu/emacs/EmacsDrawable.java +++ b/java/org/gnu/emacs/EmacsDrawable.java @@ -27,6 +27,7 @@ public interface EmacsDrawable { public Canvas lockCanvas (EmacsGC gc); public void damageRect (Rect damageRect); + public void damageRect (int left, int top, int right, int bottom); public Bitmap getBitmap (); public boolean isDestroyed (); }; diff --git a/java/org/gnu/emacs/EmacsPixmap.java b/java/org/gnu/emacs/EmacsPixmap.java index 2cbf7a430cf..e02699ecba7 100644 --- a/java/org/gnu/emacs/EmacsPixmap.java +++ b/java/org/gnu/emacs/EmacsPixmap.java @@ -175,6 +175,13 @@ else if (Build.VERSION.SDK_INT < Build.VERSION_CODES.KITKAT) } + @Override + public void + damageRect (int left, int top, int right, int bottom) + { + + } + @Override public Bitmap getBitmap () diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 0f83af882ae..d09dcc7e50d 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -437,6 +437,16 @@ else if (child.getVisibility () != GONE) damageRegion.union (damageRect); } + /* This function enables damage to be recorded without consing a new + Rect object. */ + + public void + damageRect (int left, int top, int right, int bottom) + { + EmacsService.checkEmacsThread (); + damageRegion.op (left, top, right, bottom, Region.Op.UNION); + } + /* This method is called from both the UI thread and the Emacs thread. */ diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 3738376a6f4..1f28d5f4f53 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -514,7 +514,17 @@ private static class Coordinate public void damageRect (Rect damageRect) { - view.damageRect (damageRect); + view.damageRect (damageRect.left, + damageRect.top, + damageRect.right, + damageRect.bottom); + } + + @Override + public void + damageRect (int left, int top, int right, int bottom) + { + view.damageRect (left, top, right, bottom); } public void diff --git a/src/android.c b/src/android.c index e07b3a99352..2cc86d8c56f 100644 --- a/src/android.c +++ b/src/android.c @@ -87,7 +87,6 @@ Copyright (C) 2023 Free Software Foundation, Inc. { jclass class; jmethodID get_bitmap; - jmethodID damage_rect; }; struct android_emacs_window @@ -111,6 +110,7 @@ Copyright (C) 2023 Free Software Foundation, Inc. jmethodID set_dont_accept_focus; jmethodID set_dont_focus_on_map; jmethodID define_cursor; + jmethodID damage_rect; }; struct android_emacs_cursor @@ -1712,7 +1712,6 @@ #define FIND_METHOD(c_name, name, signature) \ assert (drawable_class.c_name); FIND_METHOD (get_bitmap, "getBitmap", "()Landroid/graphics/Bitmap;"); - FIND_METHOD (damage_rect, "damageRect", "(Landroid/graphics/Rect;)V"); #undef FIND_METHOD } @@ -1766,6 +1765,12 @@ #define FIND_METHOD(c_name, name, signature) \ FIND_METHOD (set_dont_accept_focus, "setDontAcceptFocus", "(Z)V"); FIND_METHOD (define_cursor, "defineCursor", "(Lorg/gnu/emacs/EmacsCursor;)V"); + + /* In spite of the declaration of this function being located within + EmacsDrawable, the ID of the `damage_rect' method is retrieved + from EmacsWindow, which avoids virtual function dispatch within + android_damage_window. */ + FIND_METHOD (damage_rect, "damageRect", "(IIII)V"); #undef FIND_METHOD } @@ -5284,25 +5289,18 @@ android_damage_window (android_drawable handle, drawable = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); - /* Now turn DAMAGE into a Java rectangle. */ - rect = (*android_java_env)->NewObject (android_java_env, - android_rect_class, - android_rect_constructor, - (jint) damage->x, - (jint) damage->y, - (jint) (damage->x - + damage->width), - (jint) (damage->y - + damage->height)); - android_exception_check (); - /* Post the damage to the drawable. */ - (*android_java_env)->CallVoidMethod (android_java_env, - drawable, - drawable_class.damage_rect, - rect); - android_exception_check_1 (rect); - ANDROID_DELETE_LOCAL_REF (rect); + (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, + drawable, + window_class.class, + window_class.damage_rect, + (jint) damage->x, + (jint) damage->y, + (jint) (damage->x + + damage->width), + (jint) (damage->y + + damage->height)); + android_exception_check (); } commit 85f49a9bc8b9bf699a692787820efc0f8aa67545 Author: Kyle Meyer Date: Sun Sep 17 22:11:36 2023 -0400 Update to Org 9.6.9 diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 23a2f73dba7..62ba687c19f 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.8} +\def\orgversionnumber{9.6.9} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index c19af0ab331..6c05d1c8b2a 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -235,7 +235,7 @@ org-babel-python-initiate-session-by-key ;; multiple prompts during initialization. (with-current-buffer py-buffer (while (not org-babel-python--initialized) - (org-babel-comint-wait-for-output py-buffer))) + (sleep-for 0 10))) (org-babel-comint-wait-for-output py-buffer)) (setq org-babel-python-buffers (cons (cons session py-buffer) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 3b58ea06818..a859fe6d412 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.6.8")) + (let ((org-release "9.6.9")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.6.8-3-g21171d")) + (let ((org-git-version "release_9.6.9")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 750c8f97201..f97b9b6c753 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9,7 +9,7 @@ ;; URL: https://orgmode.org ;; Package-Requires: ((emacs "26.1")) -;; Version: 9.6.8 +;; Version: 9.6.9 ;; This file is part of GNU Emacs. ;; commit 514b70d5a0c73f5c0698494b323dc31dbc854d3a Author: Jim Porter Date: Sun Sep 17 17:34:20 2023 -0700 ; Fix last change * test/lisp/eshell/eshell-tests.el (eshell-test/eshell-command/output-buffer/sync): Remove unused let-binding. diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 37117e865d3..25c8cfd389c 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -86,8 +86,7 @@ eshell-test/eshell-command/output-buffer/sync "Test that the `eshell-command' function writes to its output buffer." (skip-unless (executable-find "echo")) (ert-with-temp-directory eshell-directory-name - (let ((orig-processes (process-list)) - (eshell-history-file-name nil)) + (let ((eshell-history-file-name nil)) (eshell-command "*echo 'hi\nbye'") (with-current-buffer "*Eshell Command Output*" (should (equal (buffer-string) "hi\nbye"))) commit 2826c26537cd69a77b056a43738bba0c697b36e3 Author: Stefan Kangas Date: Mon Sep 18 02:01:51 2023 +0200 Add leim subdirectories to emacs package * lisp/finder.el (finder--builtins-alist): Add subdirectories 'leim/ja-dic' and 'leim/quail' as part of the 'emacs' package. (Bug#62751) diff --git a/lisp/finder.el b/lisp/finder.el index c1acee18d63..a4cda1255ca 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -148,6 +148,8 @@ finder--builtins-alist ("international" . emacs) ("language" . emacs) ("leim" . emacs) + ("ja-dic" . emacs) + ("quail" . emacs) ("mh-e" . mh-e) ("obsolete" . emacs) ("semantic" . semantic) commit 9aab258b80af29865a89ef3e7615251bc250358e Author: Stefan Kangas Date: Sat Sep 16 14:34:20 2023 +0200 Add missing builtin package declarations * lisp/finder.el (finder--builtins-alist): Add new package directories 'leim' and 'obsolete' as part of the 'emacs' package. Add new package directory 'use-package' as part of the 'use-package' package. * lisp/net/eudc-capf.el: * lisp/net/eudcb-ecomplete.el: * lisp/net/eudcb-macos-contacts.el: * lisp/net/eudcb-mailabbrev.el: Declare library as part of the 'eudc' package. * lisp/mail/ietf-drums-date.el: Declare library as part of the 'ietf-drums' package. * lisp/image/image-dired-dired.el: * lisp/image/image-dired-external.el: * lisp/image/image-dired-tags.el: * lisp/image/image-dired-util.el: Declare library as part of the 'image-dired' package. * lisp/emacs-lisp/oclosure.el: * lisp/keymap.el: * lisp/progmodes/c-ts-common.el: Declare library as part of the 'emacs' package. (Bug#62751) (cherry picked from commit 94b1de2774b5c1fa3c28285229900657638f5c3f) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index f5a150ac4ae..0b87115e2a9 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2021-2023 Free Software Foundation, Inc. ;; Author: Stefan Monnier +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/finder.el b/lisp/finder.el index 5aec0149b89..c1acee18d63 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -147,7 +147,9 @@ finder--builtins-alist ("gnus" . gnus) ("international" . emacs) ("language" . emacs) + ("leim" . emacs) ("mh-e" . mh-e) + ("obsolete" . emacs) ("semantic" . semantic) ("analyze" . semantic) ("bovine" . semantic) @@ -162,6 +164,7 @@ finder--builtins-alist ("org" . org) ("srecode" . srecode) ("term" . emacs) + ("use-package" . use-package) ("url" . url)) "Alist of built-in package directories. Each element should have the form (DIR . PACKAGE), where DIR is a diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index 6b932601df0..d522c06d10b 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -5,6 +5,7 @@ ;; Author: Mathias Dahl ;; Maintainer: Stefan Kangas ;; Keywords: multimedia +;; Package: image-dired ;; This file is part of GNU Emacs. diff --git a/lisp/image/image-dired-external.el b/lisp/image/image-dired-external.el index 9f35e17a7e6..07b8bf7d9a2 100644 --- a/lisp/image/image-dired-external.el +++ b/lisp/image/image-dired-external.el @@ -5,6 +5,7 @@ ;; Author: Mathias Dahl ;; Maintainer: Stefan Kangas ;; Keywords: multimedia +;; Package: image-dired ;; This file is part of GNU Emacs. diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el index b9c1a811850..79ac6fb58f2 100644 --- a/lisp/image/image-dired-tags.el +++ b/lisp/image/image-dired-tags.el @@ -5,6 +5,7 @@ ;; Author: Mathias Dahl ;; Maintainer: Stefan Kangas ;; Keywords: multimedia +;; Package: image-dired ;; This file is part of GNU Emacs. diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el index a80b3afc0f3..a006aa40305 100644 --- a/lisp/image/image-dired-util.el +++ b/lisp/image/image-dired-util.el @@ -4,6 +4,7 @@ ;; Author: Mathias Dahl ;; Maintainer: Stefan Kangas +;; Package: image-dired ;; This file is part of GNU Emacs. diff --git a/lisp/keymap.el b/lisp/keymap.el index 017b2d6ead0..093536eda93 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -2,6 +2,10 @@ ;; Copyright (C) 2021-2023 Free Software Foundation, Inc. +;; Maintainer: emacs-devel@gnu.org +;; Keywords: internal +;; Package: emacs + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el index b2cceb5cef2..68ba88e89ec 100644 --- a/lisp/mail/ietf-drums-date.el +++ b/lisp/mail/ietf-drums-date.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. ;; Author: Bob Rogers +;; Package: ietf-drums ;; Keywords: mail, util ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el index d454851ae67..6d51d572485 100644 --- a/lisp/net/eudc-capf.el +++ b/lisp/net/eudc-capf.el @@ -1,21 +1,22 @@ ;;; eudc-capf.el --- EUDC - completion-at-point bindings -*- lexical-binding:t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. -;; + ;; Author: Alexander Adolf -;; +;; Package: eudc + ;; 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 . diff --git a/lisp/net/eudcb-ecomplete.el b/lisp/net/eudcb-ecomplete.el index 20bdd9059f5..a4b7a183d25 100644 --- a/lisp/net/eudcb-ecomplete.el +++ b/lisp/net/eudcb-ecomplete.el @@ -1,29 +1,32 @@ ;;; eudcb-ecomplete.el --- EUDC - ecomplete backend -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. -;; + ;; Author: Alexander Adolf -;; +;; Package: eudc + ;; This file is part of GNU Emacs. -;; + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; + ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: + ;; This library provides an interface to the ecomplete package as ;; an EUDC data source. ;;; Usage: + ;; No setup is required, since there is an entry for this backend ;; in `eudc-server-hotlist' by default. ;; diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el index bb73237e6ec..e9ce22f4134 100644 --- a/lisp/net/eudcb-macos-contacts.el +++ b/lisp/net/eudcb-macos-contacts.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2020-2023 Free Software Foundation, Inc. ;; Author: Alexander Adolf +;; Package: eudc ;; This file is part of GNU Emacs. @@ -20,11 +21,13 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: + ;; This library provides an interface to the macOS Contacts app as ;; an EUDC data source. It uses AppleScript to interface with the ;; Contacts app on localhost, so no 3rd party tools are needed. ;;; Usage: + ;; To load the library, first `require' it: ;; ;; (require 'eudcb-macos-contacts) diff --git a/lisp/net/eudcb-mailabbrev.el b/lisp/net/eudcb-mailabbrev.el index e47f8687093..196e8ff2525 100644 --- a/lisp/net/eudcb-mailabbrev.el +++ b/lisp/net/eudcb-mailabbrev.el @@ -1,29 +1,32 @@ ;;; eudcb-mailabbrev.el --- EUDC - mailabbrev backend -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. -;; + ;; Author: Alexander Adolf -;; +;; Package: eudc + ;; This file is part of GNU Emacs. -;; + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; + ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: + ;; This library provides an interface to the mailabbrev package as ;; an EUDC data source. ;;; Usage: + ;; No setup is required, since there is an entry for this backend ;; in `eudc-server-hotlist' by default. ;; diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index e0a7c46508e..3b0814970ad 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2023 Free Software Foundation, Inc. ;; Maintainer : 付禹安 (Yuan Fu) +;; Package : emacs ;; Keywords : c c++ java javascript rust languages tree-sitter ;; This file is part of GNU Emacs. commit a0ed463babaa6301dfe2fecc27e2a6c92eb0d90c Author: F. Jason Park Date: Wed Sep 6 19:40:11 2023 -0700 Spoof channel users in erc-button--phantom-users-mode * lisp/erc/erc-backend.el (erc--cmem-from-nick-function): Update forward declaration. (erc-server-PRIVMSG): Use new name for `erc--user-from-nick-function', now `erc--cmem-from-nick-function'. * lisp/erc/erc-button.el (erc-button--phantom-users, erc-button--phantom-cmems): Rename former to latter. (erc-button--fallback-user-function, erc-button--fallback-cmem-function): Rename former to latter. (erc--phantom-channel-user, erc--phantom-server-user): New superficial `cl-struct' definitions "subclassing" `erc-channel-user' and `erc-server-user'. Note that these symbols lack an `erc-button' prefix. (erc-button--add-phantom-speaker): Look for channel member instead of server user, creating one if necessary. Return a made-up `erc-channel-user' along with a fake `erc-server-user'. (erc-button--get-phantom-user, erc-button--get-phantom-cmem): Rename former to latter. (erc-button--phantom-users-mode, erc-button--phantom-users-enable, erc-button--phantom-users-disable): Use updated "cmem" names for function-valued interface variables and their implementing functions. Remove obsolete comment. (erc-button-add-nickname-buttons): Attempt to query fallback function for channel member instead of server user. * lisp/erc/erc.el (erc--user-from-nick-function, erc--cmem-from-nick-function): Rename former to latter. (erc--examine-nick, erc--cmem-get-existing): Rename former to latter. (Bug#60933) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9e121ec1e92..fb10ee31c78 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -104,7 +104,7 @@ (defvar erc--called-as-input-p) (defvar erc--display-context) (defvar erc--target) -(defvar erc--user-from-nick-function) +(defvar erc--cmem-from-nick-function) (defvar erc-channel-list) (defvar erc-channel-users) (defvar erc-default-nicks) @@ -1944,7 +1944,7 @@ erc--server-determine-join-display-context ;; at this point. (erc-update-channel-member (if privp nick tgt) nick nick privp nil nil nil nil nil host login nil nil t) - (let ((cdata (funcall erc--user-from-nick-function + (let ((cdata (funcall erc--cmem-from-nick-function (erc-downcase nick) sndr parsed))) (setq fnick (funcall erc-format-nick-function (car cdata) (cdr cdata)))))) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 8c1188e64a2..596f896d9c5 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -380,32 +380,37 @@ erc-button--modify-nick-function all faces defined in `erc-button' are bound temporarily and can be updated at will.") -(defvar-local erc-button--phantom-users nil) +(defvar-local erc-button--phantom-cmems nil) -(defvar erc-button--fallback-user-function #'ignore - "Function to determine `erc-server-user' if not found in the usual places. +(defvar erc-button--fallback-cmem-function #'ignore + "Function to determine channel member if not found in the usual places. Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when `erc-button-add-nickname-buttons' cannot find a user object for DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.") +;; Historical or fictitious users. As long as these two structs +;; remain superficial "subclasses" with the same slots and defaults, +;; they can live here instead of in erc-common.el. +(cl-defstruct (erc--phantom-channel-user (:include erc-channel-user))) +(cl-defstruct (erc--phantom-server-user (:include erc-server-user))) + (defun erc-button--add-phantom-speaker (downcased nuh _parsed) - "Stash fictitious `erc-server-user' while processing \"PRIVMSG\". -Expect DOWNCASED to be the downcased nickname, NUH to be a triple -of (NICK LOGIN HOST), and parsed to be an `erc-response' object." (pcase-let* ((`(,nick ,login ,host) nuh) - (user (or (gethash downcased erc-button--phantom-users) - (make-erc-server-user + (cmem (gethash downcased erc-button--phantom-cmems)) + (user (or (car cmem) + (make-erc--phantom-server-user :nickname nick :host (and (not (string-empty-p host)) host) - :login (and (not (string-empty-p login)) login))))) - (list (puthash downcased user erc-button--phantom-users)))) + :login (and (not (string-empty-p login)) login)))) + (cuser (or (cdr cmem) + (make-erc--phantom-channel-user + :last-message-time (current-time))))) + (puthash downcased (cons user cuser) erc-button--phantom-cmems) + (cons user cuser))) -(defun erc-button--get-phantom-user (down _word _bounds) - (gethash down erc-button--phantom-users)) +(defun erc-button--get-phantom-cmem (down _word _bounds) + (gethash down erc-button--phantom-cmems)) -;; In the future, we'll most likely create temporary -;; `erc-channel-users' tables during BATCH chathistory playback, thus -;; obviating the need for this mode entirely. (define-minor-mode erc-button--phantom-users-mode "Minor mode to recognize unknown speakers. Expect to be used by module setup code for creating placeholder @@ -415,22 +420,22 @@ erc-button--phantom-users-mode of the channel. However, don't bother creating an actual `erc-channel-user' object because their status prefix is unknown. Instead, just spoof an `erc-server-user' and stash it during -\"PRIVMSG\" handling via `erc--user-from-nick-function' and +\"PRIVMSG\" handling via `erc--cmem-from-nick-function' and retrieve it during buttonizing via `erc-button--fallback-user-function'." :interactive nil (if erc-button--phantom-users-mode (progn - (add-function :after-until (local 'erc--user-from-nick-function) - #'erc-button--add-phantom-speaker '((depth . -50))) - (add-function :after-until (local 'erc-button--fallback-user-function) - #'erc-button--get-phantom-user '((depth . 50))) - (setq erc-button--phantom-users (make-hash-table :test #'equal))) - (remove-function (local 'erc--user-from-nick-function) + (add-function :after-until (local 'erc--cmem-from-nick-function) + #'erc-button--add-phantom-speaker '((depth . 30))) + (add-function :after-until (local 'erc-button--fallback-cmem-function) + #'erc-button--get-phantom-cmem '((depth . 50))) + (setq erc-button--phantom-cmems (make-hash-table :test #'equal))) + (remove-function (local 'erc--cmem-from-nick-function) #'erc-button--add-phantom-speaker) - (remove-function (local 'erc-button--fallback-user-function) - #'erc-button--get-phantom-user) - (kill-local-variable 'erc-nicks--phantom-users))) + (remove-function (local 'erc-button--fallback-cmem-function) + #'erc-button--get-phantom-cmem) + (kill-local-variable 'erc-button--phantom-cmems))) (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." @@ -451,11 +456,12 @@ erc-button-add-nickname-buttons (down (erc-downcase word))) (let* ((erc-button-mouse-face erc-button-mouse-face) (erc-button-nickname-face erc-button-nickname-face) - (cuser (and erc-channel-users (gethash down erc-channel-users))) + (cuser (and erc-channel-users + (or (gethash down erc-channel-users) + (funcall erc-button--fallback-cmem-function + down word bounds)))) (user (or (and cuser (car cuser)) - (and erc-server-users (gethash down erc-server-users)) - (funcall erc-button--fallback-user-function - down word bounds))) + (and erc-server-users (gethash down erc-server-users)))) (data (list word))) (when (or (not (functionp form)) (and-let* ((user) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 07ba32d1cca..ec4fae548c7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5262,14 +5262,15 @@ erc--get-speaker-bounds (next-single-property-change (point-min) 'erc-speaker)))) (cons beg (next-single-property-change beg 'erc-speaker))))) -(defvar erc--user-from-nick-function #'erc--examine-nick - "Function to possibly consider unknown user. -Must return either nil or a cons of an `erc-server-user' and a -possibly nil `erc-channel-user' for formatting a server user's -nick. Called in the appropriate buffer with the downcased nick, -the parsed NUH, and the original `erc-response' object.") - -(defun erc--examine-nick (downcased _nuh _parsed) +(defvar erc--cmem-from-nick-function #'erc--cmem-get-existing + "Function maybe returning a \"channel member\" cons from a nick. +Must return either nil or a cons of an `erc-server-user' and an +`erc-channel-user' (see `erc-channel-users') for use in +formatting a user's nick prior to insertion. Called in the +appropriate target buffer with the downcased nick, the parsed +NUH, and the current `erc-response' object.") + +(defun erc--cmem-get-existing (downcased _nuh _parsed) (and erc-channel-users (gethash downcased erc-channel-users))) (defun erc-format-privmessage (nick msg privp msgp) commit 71a1f0fdc9e6ca83f6135493eccde214fc1a081e Author: Stefan Kangas Date: Mon Sep 18 01:11:50 2023 +0200 Add more missing builtin package declarations * lisp/emacs-lisp/shorthands.el: Declare library as part of the 'emacs' package. * lisp/epa-ks.el: Declare library as part of the 'epa' package. (Bug#55388) diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index bb18ac33497..82200ab88e9 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el @@ -4,6 +4,7 @@ ;; Author: João Távora ;; Keywords: lisp +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index 015bf910ac6..3dbce0259b3 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -4,6 +4,7 @@ ;; Author: Philip K. ;; Keywords: PGP, GnuPG +;; Package: epa ;; This file is part of GNU Emacs. commit 69a154616e11149df80d22a9279818e1d3fda317 Author: F. Jason Park Date: Wed Sep 13 05:42:24 2023 -0700 Run erc--scrolltobottom-on-pre-insert unconditionally * lisp/erc/erc-goodies.el (erc--scrolltobottom-all): Pass `no-force' argument to `set-window-start'. (erc--scrolltobottom-on-pre-insert): Convert from generic to normal function and drop `erc-input' method completely. A non-nil `insertp' slot means a message is marked for insertion in the read-only portion of the buffer, above the prompt. But conditionally restoring window parameters based on that flag is insufficient because the window still needs adjusting whenever input is typed, regardless of whether it's erased or "inserted." (Bug#64855) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 6353b813805..6eb015fdd64 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -223,7 +223,7 @@ erc--scrolltobottom-all ((erc--scrolltobottom-window-info) (found (assq window erc--scrolltobottom-window-info)) ((not (erc--scrolltobottom-confirm (nth 2 found))))) - (setf (window-start window) (cadr found))))) + (set-window-start window (cadr found) 'no-force)))) ;; Necessary unless we're sure `erc--scrolltobottom-on-pre-insert' ;; always runs between calls to this function. (setq erc--scrolltobottom-window-info nil)) @@ -280,7 +280,7 @@ erc--scrolltobottom-setup (kill-local-variable 'erc--scrolltobottom-relaxed-commands) (kill-local-variable 'erc--scrolltobottom-window-info))) -(cl-defmethod erc--scrolltobottom-on-pre-insert (_input-or-string) +(defun erc--scrolltobottom-on-pre-insert (_) "Remember the `window-start' before inserting a message." (setq erc--scrolltobottom-window-info (mapcar (lambda (w) @@ -293,11 +293,6 @@ erc--scrolltobottom-on-pre-insert (if (= ?\n (char-before (point-max))) (1+ c) c)))) (get-buffer-window-list nil nil 'visible)))) -(cl-defmethod erc--scrolltobottom-on-pre-insert ((input erc-input)) - "Remember the `window-start' before inserting a message." - (when (erc-input-insertp input) - (cl-call-next-method))) - (defun erc--scrolltobottom-confirm (&optional scroll-to) "Like `erc-scroll-to-bottom', but use `window-point'. Position current line (with `recenter') SCROLL-TO lines below commit c1e86203b00182a478c168e3a0a0adab85ae6d47 Author: F. Jason Park Date: Wed Sep 13 02:50:28 2023 -0700 Simplify erc--fill-module-docstring * lisp/erc/erc-common.el (erc--fill-module-docstring): Don't run hooks for major mode when filling. Prefer `lisp-data-mode' to `emacs-lisp-mode'. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 85971797c2f..67c2cf8535b 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -270,18 +270,20 @@ erc--prepare-custom-module-type " above.")))))) (defun erc--fill-module-docstring (&rest strings) + "Concatenate STRINGS and fill as a doc string." + ;; Perhaps it's better to mimic `internal--format-docstring-line' + ;; and use basic filling instead of applying a major mode? (with-temp-buffer - (emacs-lisp-mode) - (insert "(defun foo ()\n" - (format "%S" (apply #'concat strings)) - "\n(ignore))") + (delay-mode-hooks + (if (fboundp 'lisp-data-mode) (lisp-data-mode) (emacs-lisp-mode))) + (insert (format "%S" (apply #'concat strings))) (goto-char (point-min)) - (forward-line 2) - (let ((emacs-lisp-docstring-fill-column 65) + (forward-line) + (let ((fill-column 65) (sentence-end-double-space t)) (fill-paragraph)) (goto-char (point-min)) - (nth 3 (read (current-buffer))))) + (read (current-buffer)))) (defmacro erc--find-feature (name alias) `(pcase (erc--find-group ',name ,(and alias (list 'quote alias))) commit ef4a3c2a6d8ef854bed066ce25b31ff73e1d7664 Author: F. Jason Park Date: Sun Sep 10 22:55:16 2023 -0700 ; Fix example in display-buffer section of ERC manual * doc/misc/erc.texi: Fix `display-buffer-alist' example and mention that it's only meant for users of Emacs 29 and above. * test/lisp/erc/erc-tests.el (erc-setup-buffer--custom-action): Add simplistic test case for example in manual. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 6d7785a9b54..3297d8b17f0 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1803,10 +1803,11 @@ display-buffer the symbols @samp{erc-tls} or @samp{url}, the full lineup of which are listed below. -In this second example, the user writes three predicates that somewhat -resemble the ``@code{display-buffer}-like'' function above. These too -look for @var{action} alist keys sharing the names of buffer-display -options (and, in one case, a module's minor mode). +In this second example, for Emacs 29 and above, the user writes three +predicates that somewhat resemble the ``@code{display-buffer}-like'' +function above. These too look for @var{action} alist keys sharing +the names of ERC's buffer-display options (and, in one case, a +module's minor mode). @lisp (defun my-erc-disp-entry-p (_ action) @@ -1821,7 +1822,7 @@ display-buffer (defun my-erc-disp-chan-p (_ action) (or (assq 'erc-autojoin-mode action) - (and (memq (cdr (assq 'erc-buffer-display alist)) 'JOIN) + (and (eq (cdr (assq 'erc-buffer-display action)) 'JOIN) (member (erc-default-target) '("#emacs" "#fsf"))))) @end lisp diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 3b278959dc1..05d45b2d027 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -560,6 +560,36 @@ erc-setup-buffer--custom-action (pop calls))) (should-not calls))) + ;; Mimic simplistic version of example in "(erc) display-buffer". + (when (>= emacs-major-version 29) + (let ((proc erc-server-process)) + (with-temp-buffer + (should-not (eq (window-buffer) (current-buffer))) + (erc-mode) + (setq erc-server-process proc) + + (cl-letf (((symbol-function 'erc--test-fun-p) + (lambda (buf action) + (should (eql 1 (alist-get 'erc-buffer-display action))) + (push (cons 'erc--test-fun-p buf) calls))) + ((symbol-function 'action-fn) + (lambda (buf action) + (should (eql 1 (alist-get 'erc-buffer-display action))) + (should (eql 42 (alist-get 'foo action))) + (push (cons 'action-fn buf) calls) + (selected-window)))) + + (let ((erc--display-context '((erc-buffer-display . 1))) + (display-buffer-alist + `(((and (major-mode . erc-mode) erc--test-fun-p) + action-fn (foo . 42)))) + (erc-buffer-display 'display-buffer)) + + (erc-setup-buffer (current-buffer)) + (should (equal 'action-fn (car (pop calls)))) + (should (equal 'erc--test-fun-p (car (pop calls)))) + (should-not calls)))))) + (should (eq owin (selected-window))) (should (eq obuf (window-buffer))))) commit 7d2870dc856790de343a876611837b38ad6adcff Author: Jim Porter Date: Sun Sep 17 15:42:22 2023 -0700 Fix running background commands via 'eshell-command' This regressed (I believe) due to 2ec41c174f9. * lisp/eshell/esh-cmd.el (eshell-resume-eval): Check for non-nil 'retval' instead of for a process list (nil is also a technically a process list!). * test/lisp/eshell/eshell-tests.el (eshell-test/eshell-command/background-pipeline): Remove unnecessary 'copy-tree'. (eshell-test/eshell-command/output-buffer/sync) (eshell-test/eshell-command/output-buffer/async): New tests. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 23b83521f68..a4542dd917d 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1009,21 +1009,20 @@ eshell-resume-command (defun eshell-resume-eval () "Destructively evaluate a form which may need to be deferred." - (eshell-condition-case err - (progn - (setq eshell-last-async-procs nil) - (when eshell-current-command - (let* (retval - (procs (catch 'eshell-defer - (ignore - (setq retval - (eshell-do-eval - eshell-current-command)))))) - (if (eshell-process-list-p procs) - (ignore (setq eshell-last-async-procs procs)) - (cadr retval))))) - (error - (error (error-message-string err))))) + (setq eshell-last-async-procs nil) + (when eshell-current-command + (eshell-condition-case err + (let* (retval + (procs (catch 'eshell-defer + (ignore + (setq retval + (eshell-do-eval + eshell-current-command)))))) + (if retval + (cadr retval) + (ignore (setq eshell-last-async-procs procs)))) + (error + (error (error-message-string err)))))) (defmacro eshell-manipulate (form tag &rest body) "Manipulate a command FORM with BODY, using TAG as a debug identifier." diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 777c927c78e..37117e865d3 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -75,13 +75,37 @@ eshell-test/eshell-command/background-pipeline (skip-unless (and (executable-find "echo") (executable-find "cat"))) (ert-with-temp-directory eshell-directory-name - (let ((orig-processes (copy-tree (process-list))) + (let ((orig-processes (process-list)) (eshell-history-file-name nil)) (with-temp-buffer (eshell-command "*echo hi | *cat &" t) (eshell-wait-for (lambda () (equal (process-list) orig-processes))) (should (equal (buffer-string) "hi\n")))))) +(ert-deftest eshell-test/eshell-command/output-buffer/sync () + "Test that the `eshell-command' function writes to its output buffer." + (skip-unless (executable-find "echo")) + (ert-with-temp-directory eshell-directory-name + (let ((orig-processes (process-list)) + (eshell-history-file-name nil)) + (eshell-command "*echo 'hi\nbye'") + (with-current-buffer "*Eshell Command Output*" + (should (equal (buffer-string) "hi\nbye"))) + (kill-buffer "*Eshell Command Output*")))) + +(ert-deftest eshell-test/eshell-command/output-buffer/async () + "Test that the `eshell-command' function writes to its async output buffer." + (skip-unless (executable-find "echo")) + (ert-with-temp-directory eshell-directory-name + (let ((orig-processes (process-list)) + (eshell-history-file-name nil)) + (eshell-command "*echo hi &") + (eshell-wait-for (lambda () (equal (process-list) orig-processes))) + (with-current-buffer "*Eshell Async Command Output*" + (goto-char (point-min)) + (forward-line) + (should (looking-at "hi\n")))))) + (ert-deftest eshell-test/command-running-p () "Modeline should show no command running" (with-temp-eshell commit 6dfe252fff035fed7ad09a812d344a7fe309d2b3 Author: Stefan Kangas Date: Sun Sep 17 23:37:32 2023 +0200 Delete commented out code from cperl-mode.el * lisp/progmodes/cperl-mode.el: Delete some commented out code. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 37ab900a476..68cfe766d0a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -333,17 +333,7 @@ cperl-vc-sccs-header (defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\ $ ' =~ /(\\d+(\\.\\d+)+)/);") "Special version of `vc-rcs-header' that is used in CPerl mode buffers." :type '(repeat string) - :group 'cperl) - -;; (defcustom cperl-clobber-mode-lists -;; (not -;; (and -;; (boundp 'interpreter-mode-alist) -;; (assoc "miniperl" interpreter-mode-alist) -;; (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist))) -;; "Whether to install us into `interpreter-' and `extension' mode lists." -;; :type 'boolean -;; :group 'cperl) + :group 'cperl) (defcustom cperl-info-on-command-no-prompt nil "Not-nil (and non-null) means not to prompt on \\[cperl-info-on-command]. @@ -912,14 +902,6 @@ cperl-make-indent (delete-horizontal-space)) (indent-to column minimum)) -;; Probably it is too late to set these guys already, but it can help later: - -;;(and cperl-clobber-mode-lists -;;(setq auto-mode-alist -;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) -;;(and (boundp 'interpreter-mode-alist) -;; (setq interpreter-mode-alist (append interpreter-mode-alist -;; '(("miniperl" . perl-mode)))))) (eval-when-compile (mapc #'require '(imenu easymenu etags timer man info))) commit f3a50f6dd84aa4644a167c7b7a2dcde5144e2e5f Author: Stefan Kangas Date: Sun Sep 17 22:56:00 2023 +0200 Rename describe-map-tree to help--describe-map-tree This function should have been made internal in the first place. * lisp/help.el (help--describe-map-tree): Rename from 'describe-map-tree'. Keep old name as an obsolete alias, and update all callers. diff --git a/lisp/help.el b/lisp/help.el index a012086a687..3a641ccc1be 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1468,7 +1468,7 @@ substitute-command-keys ;; in case it is a local variable. (with-current-buffer orig-buf ;; This is for computing the SHADOWS arg for - ;; describe-map-tree. + ;; help--describe-map-tree. (setq active-maps (current-active-maps)) (when (boundp name) (setq this-keymap (and (keymapp (symbol-value name)) @@ -1489,9 +1489,10 @@ substitute-command-keys ;; If this one's not active, get nil. (let ((earlier-maps (cdr (memq this-keymap (reverse active-maps))))) - (describe-map-tree this-keymap t (nreverse earlier-maps) - nil nil (not include-menus) - nil nil t)))))))) + (help--describe-map-tree this-keymap t + (nreverse earlier-maps) + nil nil (not include-menus) + nil nil t)))))))) ;; 2. Handle quotes. ((and (eq (text-quoting-style) 'curve) (or (and (= (following-char) ?\`) @@ -1521,9 +1522,9 @@ substitute-quotes (t string))) (defvar help--keymaps-seen nil) -(defun describe-map-tree (startmap &optional partial shadow prefix title - no-menu transl always-title mention-shadow - buffer) +(defun help--describe-map-tree (startmap &optional partial shadow prefix title + no-menu transl always-title mention-shadow + buffer) "Insert a description of the key bindings in STARTMAP. This is followed by the key bindings of all maps reachable through STARTMAP. @@ -1677,7 +1678,7 @@ describe-map prefix keys PREFIX (a string or vector). TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW and BUFFER are as -in `describe-map-tree'." +in `help--describe-map-tree'." ;; Converted from describe_map in keymap.c. (let* ((map (keymap-canonicalize map)) (tail map) @@ -2452,6 +2453,7 @@ help-command-error-confusable-suggestions #'help-command-error-confusable-suggestions)) (define-obsolete-function-alias 'help-for-help-internal #'help-for-help "28.1") +(define-obsolete-function-alias 'describe-map-tree #'help--describe-map-tree "30.1") (provide 'help) diff --git a/src/keymap.c b/src/keymap.c index 1f863885003..d710bae02e0 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2885,7 +2885,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { Lisp_Object msg = build_unibyte_string ("Key translations"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, Vkey_translation_map, Qnil, Qnil, prefix, msg, nomenu, Qt, Qnil, Qnil, buffer); } @@ -2899,7 +2899,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, start1, Qt, shadow, prefix, msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); @@ -2912,7 +2912,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, start1, Qt, shadow, prefix, msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); @@ -2935,7 +2935,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { Lisp_Object msg = build_unibyte_string ("\f\n`keymap' Property Bindings"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, start1, Qt, shadow, prefix, msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); @@ -2946,7 +2946,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { /* The title for a minor mode keymap is constructed at run time. - We let describe-map-tree do the actual insertion + We let `help--describe-map-tree' do the actual insertion because it takes care of other features when doing so. */ char *title, *p; @@ -2968,7 +2968,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b Lisp_Object msg = build_unibyte_string (title); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, maps[i], Qt, shadow, prefix, msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (maps[i], shadow); @@ -2986,7 +2986,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b build_unibyte_string ("\f\n`%s' Major Mode Bindings"), XBUFFER (buffer)->major_mode_); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, start1, Qt, shadow, prefix, msg, nomenu, Qnil, Qnil, Qnil, buffer); } @@ -2994,7 +2994,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { Lisp_Object msg = build_unibyte_string ("\f\n`local-map' Property Bindings"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, start1, Qt, shadow, prefix, msg, nomenu, Qnil, Qnil, Qnil, buffer); } @@ -3005,7 +3005,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b Lisp_Object msg = build_unibyte_string ("\f\nGlobal Bindings"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, current_global_map, Qt, shadow, prefix, msg, nomenu, Qnil, Qt, Qnil, buffer); @@ -3014,7 +3014,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { Lisp_Object msg = build_unibyte_string ("\f\nFunction key map translations"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix, msg, nomenu, Qt, Qnil, Qnil, buffer); } @@ -3024,7 +3024,7 @@ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_b { Lisp_Object msg = build_unibyte_string ("\f\nInput decoding map translations"); CALLN (Ffuncall, - Qdescribe_map_tree, + Qhelp__describe_map_tree, KVAR (current_kboard, Vinput_decode_map), Qnil, Qnil, prefix, msg, nomenu, Qt, Qnil, Qnil, buffer); } @@ -3341,7 +3341,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, syms_of_keymap (void) { DEFSYM (Qkeymap, "keymap"); - DEFSYM (Qdescribe_map_tree, "describe-map-tree"); + DEFSYM (Qhelp__describe_map_tree, "help--describe-map-tree"); DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize"); diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 6c440f9e238..b0b487ab169 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -378,7 +378,7 @@ help-tests-describe-map-tree/no-menu-t (foo menu-item "Foo" foo :enable mark-active :help "Help text")))))) - (describe-map-tree map nil nil nil nil t nil nil nil) + (help--describe-map-tree map nil nil nil nil t nil nil nil) (should (string-match " Key Binding -+ @@ -393,7 +393,7 @@ help-tests-describe-map-tree/no-menu-nil (foo menu-item "Foo" foo :enable mark-active :help "Help text")))))) - (describe-map-tree map nil nil nil nil nil nil nil nil) + (help--describe-map-tree map nil nil nil nil nil nil nil nil) (should (string-match " Key Binding -+ @@ -408,7 +408,7 @@ help-tests-describe-map-tree/mention-shadow-t (map '(keymap . ((1 . foo) (2 . bar)))) (shadow-maps '((keymap . ((1 . baz)))))) - (describe-map-tree map t shadow-maps nil nil t nil nil t) + (help--describe-map-tree map t shadow-maps nil nil t nil nil t) (should (string-match " Key Binding -+ @@ -423,7 +423,7 @@ help-tests-describe-map-tree/mention-shadow-nil (map '(keymap . ((1 . foo) (2 . bar)))) (shadow-maps '((keymap . ((1 . baz)))))) - (describe-map-tree map t shadow-maps nil nil t nil nil nil) + (help--describe-map-tree map t shadow-maps nil nil t nil nil nil) (should (string-match " Key Binding -+ @@ -435,7 +435,7 @@ help-tests-describe-map-tree/partial-t (let ((standard-output (current-buffer)) (map '(keymap . ((1 . foo) (2 . undefined))))) - (describe-map-tree map t nil nil nil nil nil nil nil) + (help--describe-map-tree map t nil nil nil nil nil nil nil) (should (string-match " Key Binding -+ @@ -447,7 +447,7 @@ help-tests-describe-map-tree/partial-nil (let ((standard-output (current-buffer)) (map '(keymap . ((1 . foo) (2 . undefined))))) - (describe-map-tree map nil nil nil nil nil nil nil nil) + (help--describe-map-tree map nil nil nil nil nil nil nil nil) (should (string-match " Key Binding -+ commit 94705f830050d212f95d9fd6142ec93be17f4024 Author: Stefan Kangas Date: Sun Sep 17 20:39:11 2023 +0200 ; Fix last change in shell-command-to-string * lisp/simple.el (shell-command-to-string): Fix typo and improve wording. Problem reported by Eli Zaretskii . diff --git a/lisp/simple.el b/lisp/simple.el index 12d760a198f..8ab4660566d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5066,9 +5066,10 @@ shell-command-to-string Use this function only when a shell interpreter is needed. In other cases, consider alternatives such as `call-process' or -`process-lines', which do not invoke the shell. Prefer built-in -functions like `mv' to the external command \"mv\". For more -information, see Info node ‘(elisp)Security Considerations’." +`process-lines', which do not invoke the shell. Consider using +built-in functions like `rename-file' instead of the external +command \"mv\". For more information, see Info node +‘(elisp)Security Considerations’." (with-output-to-string (with-current-buffer standard-output (shell-command command t)))) commit ae983e92838d47f2a42662270b6b23e37eb330a2 Author: Jim Porter Date: Sun Sep 17 11:22:19 2023 -0700 ; Fix a recent change in Eshell * lisp/eshell/esh-cmd.el (eshell-manipulate): Fix 'eshell-stringify' calls. (eshell-do-eval): Simplify 'if' condition. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index dc210ff74f9..23b83521f68 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1033,10 +1033,10 @@ eshell-manipulate (progn ,@body) (let ((,tag-symbol ,tag)) (eshell-always-debug-command 'form - "%s\n\n%s" ,tag-symbol ,(eshell-stringify form)) + "%s\n\n%s" ,tag-symbol (eshell-stringify ,form)) ,@body (eshell-always-debug-command 'form - "done %s\n\n%s " ,tag-symbol ,(eshell-stringify form)))))) + "done %s\n\n%s" ,tag-symbol (eshell-stringify ,form)))))) (defun eshell-do-eval (form &optional synchronous-p) "Evaluate FORM, simplifying it as we go. @@ -1110,12 +1110,10 @@ eshell-do-eval `(progn ,@(cddr args))) ; Multiple ELSE forms (t (caddr args))))) ; Zero or one ELSE forms - (if (consp new-form) - (progn - (setcar form (car new-form)) - (setcdr form (cdr new-form))) - (setcar form 'progn) - (setcdr form new-form)))) + (unless (consp new-form) + (setq new-form (cons 'progn new-form))) + (setcar form (car new-form)) + (setcdr form (cdr new-form)))) (eshell-do-eval form synchronous-p)) ((eq (car form) 'setcar) (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) commit c3a70845736af2af242abcbf518037ed82ed9215 Author: Eli Zaretskii Date: Sun Sep 17 19:35:30 2023 +0300 ; * lisp/progmodes/flymake.el (flymake-mode): Fix 'cond'. (cherry picked from commit 16453ed611b9d3be315a552c482848d1c9b1ce0e) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 47dc32f9245..4ebd6ccfd3c 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1187,9 +1187,9 @@ flymake-mode (when flymake--state (maphash (lambda (_backend state) (flymake--clear-foreign-diags state)) - flymake--state))) + flymake--state)))) ;; turning Flymake on or off has consequences for listings - (flymake--update-diagnostics-listings (current-buffer)))) + (flymake--update-diagnostics-listings (current-buffer))) (defun flymake--schedule-timer-maybe () "(Re)schedule an idle timer for checking the buffer. commit 16453ed611b9d3be315a552c482848d1c9b1ce0e Author: Eli Zaretskii Date: Sun Sep 17 19:35:30 2023 +0300 ; * lisp/progmodes/flymake.el (flymake-mode): Fix 'cond'. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 036af806e60..b044a661911 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1295,9 +1295,9 @@ flymake-mode (when flymake--state (maphash (lambda (_backend state) (flymake--clear-foreign-diags state)) - flymake--state))) + flymake--state)))) ;; turning Flymake on or off has consequences for listings - (flymake--update-diagnostics-listings (current-buffer)))) + (flymake--update-diagnostics-listings (current-buffer))) (defun flymake--schedule-timer-maybe () "(Re)schedule an idle timer for checking the buffer. commit e65ed927953d1c7cc16d6d61f434748ad4356443 Author: Eli Zaretskii Date: Sun Sep 17 19:33:11 2023 +0300 ; * lisp/simple.el (suggest-key-bindings): Fix :type. diff --git a/lisp/simple.el b/lisp/simple.el index d9f4ee19704..ef11a5eb4f6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2504,7 +2504,7 @@ suggest-key-bindings :group 'keyboard :type '(choice (const :tag "off" nil) (natnum :tag "time" 2) - (other :tag "on"))) + (other :tag "on" t))) (defcustom extended-command-suggest-shorter t "If non-nil, show a shorter \\[execute-extended-command] invocation \ commit f8ea47ebf45c5ea0cd788667f7bdb805f42e08e0 Author: Mattias Engdegård Date: Sun Sep 17 12:49:40 2023 +0200 Expanded defcustom type byte-compilation warnings (bug#65852) Warn about more kinds of mistakes in :type arguments of `defcustom` and `define-widget`. These include: - misplaced keyword args, as in (const red :tag "A reddish hue") - missing subordinate types, as in (repeat :tag "List of names") or (choice list string) - duplicated values, as in (choice (const yes) (const yes)) - misplaced `other` member, as in (choice (const red) (other nil) (const blue)) - various type name mistakes, as in (vector bool functionp) * lisp/emacs-lisp/bytecomp.el (byte-compile--defcustom-type-quoted) (byte-compile-nogroup-warn): Remove. (byte-compile-normal-call): Remove call to the above. (bytecomp--cus-warn, bytecomp--check-cus-type) (bytecomp--custom-declare): New. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7feaf118b86..1474acc1638 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1618,57 +1618,6 @@ byte-compile-format-warn (dolist (elt '(format message format-message error)) (put elt 'byte-compile-format-like t)) -(defun byte-compile--defcustom-type-quoted (type) - "Whether defcustom TYPE contains an accidentally quoted value." - ;; Detect mistakes such as (const 'abc). - ;; We don't actually follow the syntax for defcustom types, but this - ;; should be good enough. - (and (consp type) - (proper-list-p type) - (if (memq (car type) '(const other)) - (assq 'quote type) - (let ((elts (cdr type))) - (while (and elts (not (byte-compile--defcustom-type-quoted - (car elts)))) - (setq elts (cdr elts))) - elts)))) - -;; Warn if a custom definition fails to specify :group, or :type. -(defun byte-compile-nogroup-warn (form) - (let ((keyword-args (cdr (cdr (cdr (cdr form))))) - (name (cadr form))) - (when (eq (car-safe name) 'quote) - (when (eq (car form) 'custom-declare-variable) - (let ((type (plist-get keyword-args :type))) - (cond - ((not type) - (byte-compile-warn-x (cadr name) - "defcustom for `%s' fails to specify type" - (cadr name))) - ((byte-compile--defcustom-type-quoted type) - (byte-compile-warn-x - (cadr name) - "defcustom for `%s' may have accidentally quoted value in type `%s'" - (cadr name) type))))) - (if (and (memq (car form) '(custom-declare-face custom-declare-variable)) - byte-compile-current-group) - ;; The group will be provided implicitly. - nil - (or (and (eq (car form) 'custom-declare-group) - (equal name ''emacs)) - (plist-get keyword-args :group) - (byte-compile-warn-x (cadr name) - "%s for `%s' fails to specify containing group" - (cdr (assq (car form) - '((custom-declare-group . defgroup) - (custom-declare-face . defface) - (custom-declare-variable . defcustom)))) - (cadr name))) - ;; Update the current group, if needed. - (if (and byte-compile-current-file ;Only when compiling a whole file. - (eq (car form) 'custom-declare-group)) - (setq byte-compile-current-group (cadr name))))))) - ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (name arglist macrop) @@ -3695,10 +3644,6 @@ byte-compile-form (defun byte-compile-normal-call (form) (when (and (symbolp (car form)) (byte-compile-warning-enabled-p 'callargs (car form))) - (if (memq (car form) - '(custom-declare-group custom-declare-variable - custom-declare-face)) - (byte-compile-nogroup-warn form)) (byte-compile-callargs-warn form)) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) @@ -5269,6 +5214,187 @@ byte-compile-make-local-variable (pcase form (`(,_ ',var) (byte-compile--declare-var var))) (byte-compile-normal-call form)) +;; Warn about mistakes in `defcustom', `defface', `defgroup', `define-widget' + +(defvar bytecomp--cus-function) +(defvar bytecomp--cus-name) + +(defun bytecomp--cus-warn (form format &rest args) + "Emit a warning about a `defcustom' type. +FORM is used to provide location, `bytecomp--cus-function' and +`bytecomp--cus-name' for context." + (let* ((actual-fun (or (cdr (assq bytecomp--cus-function + '((custom-declare-group . defgroup) + (custom-declare-face . defface) + (custom-declare-variable . defcustom)))) + bytecomp--cus-function)) + (prefix (format "in %s%s: " + actual-fun + (if bytecomp--cus-name + (format " for `%s'" bytecomp--cus-name) + "")))) + (apply #'byte-compile-warn-x form (concat prefix format) args))) + +(defun bytecomp--check-cus-type (type) + "Warn about common mistakes in the `defcustom' type TYPE." + (let ((invalid-types + '( + ;; Lisp type predicates, often confused with customisation types: + functionp numberp integerp fixnump natnump floatp booleanp + characterp listp stringp consp vectorp symbolp keywordp + hash-table-p facep + ;; other mistakes occasionally seen (oh yes): + or and nil t + interger intger lits bool boolen constant filename + kbd any list-of auto + ;; from botched backquoting + \, \,@ \` + ))) + (cond + ((consp type) + (let* ((head (car type)) + (tail (cdr type))) + (while (and (keywordp (car tail)) (cdr tail)) + (setq tail (cddr tail))) + (cond + ((plist-member (cdr type) :convert-widget) nil) + ((let ((tl tail)) + (and (not (keywordp (car tail))) + (progn + (while (and tl (not (keywordp (car tl)))) + (setq tl (cdr tl))) + (and tl + (progn + (bytecomp--cus-warn + tl "misplaced %s keyword in `%s' type" (car tl) head) + t)))))) + ((memq head '(choice radio)) + (unless tail + (bytecomp--cus-warn type "`%s' without any types inside" head)) + (let ((clauses tail) + (constants nil)) + (while clauses + (let* ((ty (car clauses)) + (ty-head (car-safe ty))) + (when (and (eq ty-head 'other) (cdr clauses)) + (bytecomp--cus-warn ty "`other' not last in `%s'" head)) + (when (memq ty-head '(const other)) + (let ((ty-tail (cdr ty)) + (val nil)) + (while (and (keywordp (car ty-tail)) (cdr ty-tail)) + (when (eq (car ty-tail) :value) + (setq val (cadr ty-tail))) + (setq ty-tail (cddr ty-tail))) + (when ty-tail + (setq val (car ty-tail))) + (when (member val constants) + (bytecomp--cus-warn + ty "duplicated value in `%s': `%S'" head val)) + (push val constants))) + (bytecomp--check-cus-type ty)) + (setq clauses (cdr clauses))))) + ((eq head 'cons) + (unless (= (length tail) 2) + (bytecomp--cus-warn + type "`cons' requires 2 type specs, found %d" (length tail))) + (dolist (ty tail) + (bytecomp--check-cus-type ty))) + ((memq head '(list group vector set repeat)) + (unless tail + (bytecomp--cus-warn type "`%s' without type specs" head)) + (dolist (ty tail) + (bytecomp--check-cus-type ty))) + ((memq head '(alist plist)) + (let ((key-tag (memq :key-type (cdr type))) + (value-tag (memq :value-type (cdr type)))) + (when key-tag + (bytecomp--check-cus-type (cadr key-tag))) + (when value-tag + (bytecomp--check-cus-type (cadr value-tag))))) + ((memq head '(const other)) + (let* ((value-tag (memq :value (cdr type))) + (n (length tail)) + (val (car tail))) + (cond + ((or (> n 1) (and value-tag tail)) + (bytecomp--cus-warn type "`%s' with too many values" head)) + (value-tag + (setq val (cadr value-tag))) + ;; ;; This is a useful check but it results in perhaps + ;; ;; a bit too many complaints. + ;; ((null tail) + ;; (bytecomp--cus-warn + ;; type "`%s' without value is implicitly nil" head)) + ) + (when (memq (car-safe val) '(quote function)) + (bytecomp--cus-warn type "`%s' with quoted value: %S" head val)))) + ((eq head 'quote) + (bytecomp--cus-warn type "type should not be quoted: %s" (cadr type))) + ((memq head invalid-types) + (bytecomp--cus-warn type "`%s' is not a valid type" head)) + ((or (not (symbolp head)) (keywordp head)) + (bytecomp--cus-warn type "irregular type `%S'" head)) + ))) + ((or (not (symbolp type)) (keywordp type)) + (bytecomp--cus-warn type "irregular type `%S'" type)) + ((memq type '( list cons group vector choice radio const other + function-item variable-item set repeat restricted-sexp)) + (bytecomp--cus-warn type "`%s' without arguments" type)) + ((memq type invalid-types) + (bytecomp--cus-warn type "`%s' is not a valid type" type)) + ))) + +;; Unified handler for multiple functions with similar arguments: +;; (NAME SOMETHING DOC KEYWORD-ARGS...) +(byte-defop-compiler-1 define-widget bytecomp--custom-declare) +(byte-defop-compiler-1 custom-declare-group bytecomp--custom-declare) +(byte-defop-compiler-1 custom-declare-face bytecomp--custom-declare) +(byte-defop-compiler-1 custom-declare-variable bytecomp--custom-declare) +(defun bytecomp--custom-declare (form) + (when (>= (length form) 4) + (let* ((name-arg (nth 1 form)) + (name (and (eq (car-safe name-arg) 'quote) + (symbolp (nth 1 name-arg)) + (nth 1 name-arg))) + (keyword-args (nthcdr 4 form)) + (fun (car form)) + (bytecomp--cus-function fun) + (bytecomp--cus-name name)) + + ;; Check :type + (when (memq fun '(custom-declare-variable define-widget)) + (let ((type-tag (memq :type keyword-args))) + (if (null type-tag) + ;; :type only mandatory for `defcustom' + (when (eq fun 'custom-declare-variable) + (bytecomp--cus-warn form "missing :type keyword parameter")) + (let ((dup-type (memq :type (cdr type-tag)))) + (when dup-type + (bytecomp--cus-warn + dup-type "duplicated :type keyword argument"))) + (let ((type-arg (cadr type-tag))) + (when (or (null type-arg) + (eq (car-safe type-arg) 'quote)) + (bytecomp--check-cus-type (cadr type-arg))))))) + + ;; Check :group + (when (cond + ((memq fun '(custom-declare-variable custom-declare-face)) + (not byte-compile-current-group)) + ((eq fun 'custom-declare-group) + (not (eq name 'emacs)))) + (unless (plist-get keyword-args :group) + (bytecomp--cus-warn form "fails to specify containing group"))) + + ;; Update current group + (when (and name + byte-compile-current-file ; only when compiling a whole file + (eq fun 'custom-declare-group)) + (setq byte-compile-current-group name)))) + + (byte-compile-normal-call form)) + + (put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop) (put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop) (defun byte-compile-define-symbol-prop (form) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 03aed5263b6..a335a7fa1f8 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1100,7 +1100,7 @@ "warn-defcustom-nogroup.el" "fails to specify containing group") (bytecomp--define-warning-file-test "warn-defcustom-notype.el" - "fails to specify type") + "missing :type keyword parameter") (bytecomp--define-warning-file-test "warn-defvar-lacks-prefix.el" "var.*foo.*lacks a prefix") @@ -1874,12 +1874,50 @@ bytecomp-tests-byte-compile--wide-docstring-p/func-arg-list (TEST-IN-COMMENTS t) (TEST-IN-STRINGS t) (TEST-IN-CODE t) \ (FIXTURE-FN \\='#\\='electric-pair-mode))" fill-column))) -(ert-deftest bytecomp-test-defcustom-type-quoted () - (should-not (byte-compile--defcustom-type-quoted 'integer)) - (should-not (byte-compile--defcustom-type-quoted - '(choice (const :tag "foo" bar)))) - (should (byte-compile--defcustom-type-quoted - '(choice (const :tag "foo" 'bar))))) +(ert-deftest bytecomp-test-defcustom-type () + (cl-flet ((dc (type) `(defcustom mytest nil "doc" :type ',type))) + (bytecomp--with-warning-test + (rx "type should not be quoted") (dc ''integer)) + (bytecomp--with-warning-test + (rx "type should not be quoted") (dc '(choice '(repeat boolean)))) + (bytecomp--with-warning-test + (rx "misplaced :tag keyword") (dc '(choice (const b :tag "a")))) + (bytecomp--with-warning-test + (rx "`choice' without any types inside") (dc '(choice :tag "a"))) + (bytecomp--with-warning-test + (rx "`other' not last in `choice'") + (dc '(choice (const a) (other b) (const c)))) + (bytecomp--with-warning-test + (rx "duplicated value in `choice': `a'") + (dc '(choice (const a) (const b) (const a)))) + (bytecomp--with-warning-test + (rx "`cons' requires 2 type specs, found 1") + (dc '(cons :tag "a" integer))) + (bytecomp--with-warning-test + (rx "`repeat' without type specs") + (dc '(repeat :tag "a"))) + (bytecomp--with-warning-test + (rx "`const' with too many values") + (dc '(const :tag "a" x y))) + (bytecomp--with-warning-test + (rx "`const' with quoted value") + (dc '(const :tag "a" 'x))) + (bytecomp--with-warning-test + (rx "`bool' is not a valid type") + (dc '(bool :tag "a"))) + (bytecomp--with-warning-test + (rx "irregular type `:tag'") + (dc '(:tag "a"))) + (bytecomp--with-warning-test + (rx "irregular type `\"string\"'") + (dc '(list "string"))) + (bytecomp--with-warning-test + (rx "`list' without arguments") + (dc 'list)) + (bytecomp--with-warning-test + (rx "`integerp' is not a valid type") + (dc 'integerp)) + )) (ert-deftest bytecomp-function-attributes () ;; Check that `byte-compile' keeps the declarations, interactive spec and commit 94bef169e2e8af68514c649eca4b789e8a0f4dae Author: Stefan Kangas Date: Sun Sep 17 17:03:59 2023 +0200 Document shell-command-to-string security considerations * lisp/simple.el (shell-command-to-string): Document security considerations in docstring. diff --git a/lisp/simple.el b/lisp/simple.el index a128ff41051..12d760a198f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5060,7 +5060,15 @@ shell-command-on-region exit-status)) (defun shell-command-to-string (command) - "Execute shell command COMMAND and return its output as a string." + "Execute shell command COMMAND and return its output as a string. +Use `shell-quote-argument' to quote dangerous characters in +COMMAND before passing it as an argument to this function. + +Use this function only when a shell interpreter is needed. In +other cases, consider alternatives such as `call-process' or +`process-lines', which do not invoke the shell. Prefer built-in +functions like `mv' to the external command \"mv\". For more +information, see Info node ‘(elisp)Security Considerations’." (with-output-to-string (with-current-buffer standard-output (shell-command command t)))) commit e0070fc574a8621b2fbb1aaca678b974a3dc5fd5 Author: Stefan Kangas Date: Sun Sep 17 16:57:20 2023 +0200 Improve org-babel-execute:eshell docstring * lisp/org/ob-eshell.el (org-babel-execute:eshell): Improve docstring. diff --git a/lisp/org/ob-eshell.el b/lisp/org/ob-eshell.el index 95f5777ae7d..b3fbe3ad52d 100644 --- a/lisp/org/ob-eshell.el +++ b/lisp/org/ob-eshell.el @@ -47,11 +47,12 @@ org-babel-execute:eshell "Execute a block of Eshell code BODY with PARAMS. This function is called by `org-babel-execute-src-block'. -The BODY can be any code which allowed executed in Eshell. -Eshell allow to execute normal shell command and Elisp code. -More details please reference Eshell Info. +The BODY argument is code which can be executed in Eshell. +Eshell allows executing normal shell command and Elisp code. +For more details, see Info node `(eshell) Top'. -The PARAMS are variables assignments." +The PARAMS argument is passed to +`org-babel-expand-body:generic' (which see)." (let* ((session (org-babel-eshell-initiate-session (cdr (assq :session params)))) (full-body (org-babel-expand-body:generic commit 1e270e580d3bb9ca1b3766a296611f76ec13f6f1 Author: Stefan Kangas Date: Sun Sep 17 16:49:21 2023 +0200 ; Grammar fixes ("allow to" et al) Ref: https://lists.gnu.org/r/emacs-devel/2016-01/msg01598.html https://lists.gnu.org/r/emacs-devel/2016-01/msg01465.html diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index 43e4a37adf4..ceb1f0cf320 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -20,7 +20,7 @@ # # Written by Jim Meyering -# This is a prologue that allows to run a perl script as an executable +# This is a prologue that allows running a perl script as an executable # on systems that are compliant to a POSIX version before POSIX:2017. # On such systems, the usual invocation of an executable through execlp() # or execvp() fails with ENOEXEC if it is a script that does not start diff --git a/build-aux/update-copyright b/build-aux/update-copyright index 0343eaa72c1..cdc3f3b5988 100755 --- a/build-aux/update-copyright +++ b/build-aux/update-copyright @@ -123,7 +123,7 @@ # 5. Set UPDATE_COPYRIGHT_HOLDER if the copyright holder is other # than "Free Software Foundation, Inc.". -# This is a prologue that allows to run a perl script as an executable +# This is a prologue that allows running a perl script as an executable # on systems that are compliant to a POSIX version before POSIX:2017. # On such systems, the usual invocation of an executable through execlp() # or execvp() fails with ENOEXEC if it is a script that does not start diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 47e0b5e37ae..4d5c9ecc7b2 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -308,7 +308,7 @@ Yanking Yank the last kill into the buffer, at point (@code{yank}). @item M-y Either replace the text just yanked with an earlier batch of killed -text (@code{yank-pop}), or allow to select from the list of +text (@code{yank-pop}), or allow selecting from the list of previously-killed batches of text. @xref{Earlier Kills}. @item C-M-w Cause the following command, if it is a kill command, to append to the diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index a95335f3df2..5f9a5d89bf3 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1804,7 +1804,7 @@ Project File Commands @vindex vc-directory-exclusion-list The command @kbd{C-x p f} (@code{project-find-file}) is a convenient way of visiting files (@pxref{Visiting}) that belong to the current -project. Unlike @kbd{C-x C-f}, this command doesn't require to type +project. Unlike @kbd{C-x C-f}, this command doesn't require typing the full file name of the file to visit, you can type only the file's base name (i.e., omit the leading directories). In addition, the completion candidates considered by the command include only the files diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 5a824649d42..0dab03eb7ba 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -801,9 +801,9 @@ Native Compilation Lisp function definitions into a true compiled code, known as @dfn{native code}. This feature uses the @file{libgccjit} library, which is part of the GCC distribution, and requires that Emacs be -built with support for using that library. It also requires to have -GCC and Binutils (the assembler and linker) available on your system -for you to be able to native-compile Lisp code. +built with support for using that library. It also requires GCC and +Binutils (the assembler and linker) to be available on your system for +you to be able to native-compile Lisp code. @vindex native-compile@r{, a Lisp feature} To determine whether the current Emacs process can produce and load diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 22a3eeb9595..4dbb4afb20d 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -9028,7 +9028,7 @@ Bidirectional Display consistent with the requirements of the Unicode Standard v9.0. Note, however, that the way Emacs displays continuation lines when text direction is opposite to the base paragraph direction deviates from -the UBA, which requires to perform line wrapping before reordering +the UBA, which requires performing line wrapping before reordering text for display. @defvar bidi-display-reordering diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 1c4e85b14be..5d6e1809286 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -606,7 +606,7 @@ Frame Layout Outer borders are never shown on text terminal frames and on frames generated by GTK+ routines. On MS-Windows, the outer border is emulated with the help of a one pixel wide external border. Non-toolkit builds -on X allow to change the color of the outer border by setting the +on X allow changing the color of the outer border by setting the @code{border-color} frame parameter (@pxref{Layout Parameters}). @item Title Bar @@ -1000,12 +1000,12 @@ Frame Position frame's native rectangle) and the bottom edge by @var{-y} pixels up from the bottom edge of the screen (or the parent frame's native rectangle). -Note that negative values do not permit to align the right or bottom +Note that negative values do not permit aligning the right or bottom edge of @var{frame} exactly at the right or bottom edge of its display -or parent frame. Neither do they allow to specify a position that does +or parent frame. Neither do they allow specifying a position that does not lie within the edges of the display or parent frame. The frame parameters @code{left} and @code{top} (@pxref{Position Parameters}) -allow to do that, but may still fail to provide good results for the +allow doing that, but may still fail to provide good results for the initial or a new frame. This function has no effect on text terminal frames. @@ -3441,7 +3441,7 @@ Child Frames In order to give a child frame a draggable header or mode line, the window parameters @code{mode-line-format} and @code{header-line-format} -are handy (@pxref{Window Parameters}). These allow to remove an +are handy (@pxref{Window Parameters}). These allow removing an unwanted mode line (when @code{drag-with-header-line} is chosen) and to remove mouse-sensitive areas which might interfere with frame dragging. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 0951e60433a..1fba683223e 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1567,7 +1567,7 @@ Module Values Emacs Lisp objects communicated via the @acronym{API}; it is the functional equivalent of the @code{Lisp_Object} type used in Emacs C primitives (@pxref{Writing Emacs Primitives}). This section describes -the parts of the module @acronym{API} that allow to create +the parts of the module @acronym{API} that allow creating @code{emacs_value} objects corresponding to basic Lisp data types, and how to access from C data in @code{emacs_value} objects that correspond to Lisp objects. diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 7e5590ed8ec..c290632a48b 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -133,7 +133,7 @@ Text Representations position in the current buffer it returns the offset from the beginning of the current buffer's file of the byte that corresponds to the given character @var{position} in the buffer. The conversion -requires to know how the text is encoded in the buffer's file; this is +requires knowing how the text is encoded in the buffer's file; this is what the @var{coding-system} argument is for, defaulting to the value of @code{buffer-file-coding-system}. The optional argument @var{quality} specifies how accurate the result should be; it should @@ -1181,7 +1181,7 @@ Encoding and I/O specified by this variable, these operations select an alternative encoding by calling the function @code{select-safe-coding-system} (@pxref{User-Chosen Coding Systems}). If selecting a different encoding -requires to ask the user to specify a coding system, +requires asking the user to specify a coding system, @code{buffer-file-coding-system} is updated to the newly selected coding system. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index cfab2c22d6b..df5e2139237 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -134,7 +134,7 @@ Subprocess Creation stream to a different destination. @cindex program arguments - All three of the subprocess-creating functions allow to specify + All three of the subprocess-creating functions allow specifying command-line arguments for the process to run. For @code{call-process} and @code{call-process-region}, these come in the form of a @code{&rest} argument, @var{args}. For @code{make-process}, both the @@ -520,7 +520,7 @@ Synchronous Processes returns a string describing the signal interrupting a remote process. When a process returns an exit code greater than 128, it is -interpreted as a signal. @code{process-file} requires to return a +interpreted as a signal. @code{process-file} requires returning a string describing this signal. Since there are processes violating this rule, returning exit codes diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 404726e1f92..dea35a04d4f 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1891,7 +1891,7 @@ Default Value @code{default-value} will then return the value from that binding, not the global value, and @code{set-default} will be prevented from setting the global value (it will change the let-bound value instead). -The following two functions allow to reference the global value even +The following two functions allow referencing the global value even if it's shadowed by a let-binding. @cindex top-level default value diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 659a064a173..22c1b307252 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2847,8 +2847,8 @@ Buffer Display Action Functions coordinate would equal the left edge coordinate of the frame's new root window. -Four special values for @code{direction} entries allow to implicitly -specify the selected frame's main window as the reference window: +Four special values for @code{direction} entries allow implicitly +specifying the selected frame's main window as the reference window: @code{leftmost}, @code{top}, @code{rightmost} and @code{bottom}. This means that instead of, for example, @w{@code{(direction . left) (window . main)}} one can just specify @w{@code{(direction @@ -4596,7 +4596,7 @@ Side Windows main window is either a ``normal'' live window or specifies the area containing all the normal windows. - In their most simple form of use, side windows allow to display + In their most simple form of use, side windows allow displaying specific buffers always in the same area of a frame. Hence they can be regarded as a generalization of the concept provided by @code{display-buffer-at-bottom} (@pxref{Buffer Display Action @@ -6188,7 +6188,7 @@ Mouse Window Auto-selection Mouse auto-selection can be used to emulate a focus follows mouse policy for child frames (@pxref{Child Frames}) which usually are not tracked by -the window manager. This requires to set the value of +the window manager. This requires setting the value of @code{focus-follows-mouse} (@pxref{Input Focus}) to a non-@code{nil} value. If the value of @code{focus-follows-mouse} is @code{auto-raise}, entering a child frame with the mouse will raise it automatically above @@ -6341,7 +6341,7 @@ Window Configurations @end defun The functions @code{window-state-get} and @code{window-state-put} also -allow to exchange the contents of two live windows. The following +allow exchanging the contents of two live windows. The following function does precisely that: @deffn Command window-swap-states &optional window-1 window-2 size diff --git a/doc/misc/org.org b/doc/misc/org.org index a4ce53cc6cb..9721807a185 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -9431,7 +9431,7 @@ the estimated effort of an entry (see [[*Effort Estimates]]). #+vindex: org-agenda-effort-filter-preset #+vindex: org-agenda-regexp-filter-preset Agenda built-in or custom commands are statically defined. Agenda -filters and limits allow to flexibly narrow down the list of agenda +filters and limits allow flexibly narrowing down the list of agenda entries. /Filters/ only change the visibility of items, are very fast and are diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56d5fcd4bf0..64d47515978 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2366,7 +2366,7 @@ Remote shell setup @end group @end lisp -This works only for connection methods which allow to override the +This works only for connection methods which allow overriding the remote login shell, like @option{sshx} or @option{plink}. See @ref{Inline methods} and @ref{External methods} for connection methods which support this. diff --git a/etc/NEWS b/etc/NEWS index fe6b607545f..f9ebe312612 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -456,8 +456,8 @@ sandboxes provided by Flatpak. The host name for Kubernetes connections can be of kind [CONTAINER.]POD, in order to specify a dedicated container. If there is just the pod name, the first container in the pod is taken. The new user options -'tramp-kubernetes-context' and 'tramp-kubernetes-namespace' allow to -access pods with different context or namespace but the default one. +'tramp-kubernetes-context' and 'tramp-kubernetes-namespace' allow +accessing pods with different context or namespace but the default one. +++ *** Rename 'tramp-use-ssh-controlmaster-options' to 'tramp-use-connection-share'. @@ -649,9 +649,10 @@ This keyword enables the user to install packages using 'package-vc'. *** New commands for reading mailing lists. The new Rmail commands 'rmail-mailing-list-post', 'rmail-mailing-list-unsubscribe', 'rmail-mailing-list-help', and -'rmail-mailing-list-archive' allow to, respectively, post to, -unsubscribe from, request help about, and browse the archives, of the -mailing list from which the current email message was delivered. +'rmail-mailing-list-archive' allow, respectively, posting to, +unsubscribing from, requesting help about, and browsing the archives +of, the mailing list from which the current email message was +delivered. ** Dictionary @@ -746,7 +747,7 @@ of the accessibility of remote files can now time out if ** Notifications +++ -*** Allow to use Icon Naming Specification for ':app-icon'. +*** Allow using Icon Naming Specification for ':app-icon'. You can use a symbol as the value for ':app-icon' to provide icon name without specifying a file, like this: diff --git a/etc/NEWS.20 b/etc/NEWS.20 index 8143cfcf3cd..ade83eb3dd0 100644 --- a/etc/NEWS.20 +++ b/etc/NEWS.20 @@ -1250,7 +1250,7 @@ for large documents), you can reuse these buffers by setting *** References to external documents. -The LaTeX package 'xr' allows to cross-reference labels in external +The LaTeX package 'xr' allows cross-referencing labels in external documents. RefTeX can provide information about the external documents as well. To use this feature, set up the \externaldocument macros required by the 'xr' package and rescan the document with @@ -3260,7 +3260,7 @@ can connect to an Emacs server started by a non-root user. it to return immediately without waiting for you to "finish" the buffer in Emacs. -*** The new option --alternate-editor allows to specify an editor to +*** The new option --alternate-editor allows specifying an editor to use if Emacs is not running. The environment variable ALTERNATE_EDITOR can be used for the same effect; the command line option takes precedence. diff --git a/etc/NEWS.21 b/etc/NEWS.21 index e68d7fe8fae..89cac46e248 100644 --- a/etc/NEWS.21 +++ b/etc/NEWS.21 @@ -1424,7 +1424,7 @@ digest message. *** The new user option 'rmail-automatic-folder-directives' specifies in which folder to put messages automatically. -*** The new function 'rmail-redecode-body' allows to fix a message +*** The new function 'rmail-redecode-body' allows fixing a message with non-ASCII characters if Emacs happens to decode it incorrectly due to missing or malformed "charset=" header. @@ -1437,7 +1437,7 @@ use the -f option when sending mail. ** The Rmail command 'o' ('rmail-output-to-rmail-file') now writes the current message in the internal 'emacs-mule' encoding, rather than in the encoding taken from the variable 'buffer-file-coding-system'. -This allows to save messages whose characters cannot be safely encoded +This allows saving messages whose characters cannot be safely encoded by the buffer's coding system, and makes sure the message will be displayed correctly when you later visit the target Rmail file. @@ -1465,7 +1465,7 @@ other than 'emacs-mule', you can customize the variable sorted *Index* buffer which looks like the final index. Entries can be edited from that buffer. -*** Label and citation key selection now allow to select several +*** Label and citation key selection now allow selecting several items and reference them together (use 'm' to mark items, 'a' or 'A' to use all marked entries). @@ -1804,7 +1804,7 @@ to phrases and to highlight entire lines containing a match. *** The new package zone.el plays games with Emacs' display when Emacs is idle. -*** The new package tildify.el allows to add hard spaces or other text +*** The new package tildify.el allows adding hard spaces or other text fragments in accordance with the current major mode. *** The new package xml.el provides a simple but generic XML @@ -1826,7 +1826,7 @@ provides an alternative interface to VC-dired for CVS. It comes with 'log-view-mode' to view RCS and SCCS logs and 'log-edit-mode' used to enter check-in log messages. -*** The new package called 'woman' allows to browse Unix man pages +*** The new package called 'woman' allows browsing Unix man pages without invoking external programs. The command `M-x woman' formats manual pages entirely in Emacs Lisp @@ -2011,8 +2011,8 @@ recent file list can be displayed: - sorted by file paths, file names, ascending or descending. - showing paths relative to the current default-directory -The 'recentf-filter-changer' menu filter function allows to -dynamically change the menu appearance. +The 'recentf-filter-changer' menu filter function allows +dynamically changing the menu appearance. *** 'elide-head' provides a mechanism for eliding boilerplate header text. @@ -2139,7 +2139,7 @@ new command M-x strokes-list-strokes. ** Hexl contains a new command 'hexl-insert-hex-string' which inserts a string of hexadecimal numbers read from the mini-buffer. -** Hexl mode allows to insert non-ASCII characters. +** Hexl mode allows inserting non-ASCII characters. The non-ASCII characters are encoded using the same encoding as the file you are visiting in Hexl mode. @@ -2369,7 +2369,7 @@ allows the animated display of strings. ** The new function 'interactive-form' can be used to obtain the interactive form of a function. -** The keyword :set-after in defcustom allows to specify dependencies +** The keyword :set-after in defcustom allows specifying dependencies between custom options. Example: (defcustom default-input-method nil @@ -3629,7 +3629,7 @@ Each face can specify the following display attributes: 13. Whether or not a box should be drawn around characters, its color, the width of the box lines, and 3D appearance. -Faces are frame-local by nature because Emacs allows to define the +Faces are frame-local by nature because Emacs allows defining the same named face (face names are symbols) differently for different frames. Each frame has an alist of face definitions for all named faces. The value of a named face in such an alist is a Lisp vector diff --git a/etc/NEWS.22 b/etc/NEWS.22 index 804dab00859..7021fce52ed 100644 --- a/etc/NEWS.22 +++ b/etc/NEWS.22 @@ -2408,7 +2408,7 @@ called with a prefix argument. Related new options are The new command 'reftex-create-bibtex-file' creates a BibTeX database with all entries referenced in the current document. The keys "e" and -"E" allow to produce a BibTeX database file from entries marked in a +"E" allow producing a BibTeX database file from entries marked in a citation selection buffer. The command 'reftex-citation' uses the word in the buffer before the diff --git a/etc/NEWS.23 b/etc/NEWS.23 index 22408197f7d..7ac91e6165f 100644 --- a/etc/NEWS.23 +++ b/etc/NEWS.23 @@ -1200,7 +1200,7 @@ of the region to comment, rather than the leftmost column. *** The new commands 'pp-macroexpand-expression' and 'pp-macroexpand-last-sexp' pretty-print macro expansions. -*** The new command 'set-file-modes' allows to set file's mode bits. +*** The new command 'set-file-modes' allows setting file's mode bits. The mode bits can be specified in symbolic notation, like with GNU Coreutils, in addition to an octal number. 'chmod' is a new convenience alias for this function. @@ -1540,7 +1540,7 @@ authentication respectively. *** New macro 'with-help-window' should set up help windows better than 'with-output-to-temp-buffer' with 'print-help-return-message'. -*** New option 'help-window-select' permits to customize whether help +*** New option 'help-window-select' permits customizing whether help window shall be automatically selected when invoking help. *** New variable 'help-window-point-marker' permits one to specify a new @@ -1670,7 +1670,7 @@ Previously, this information was hidden. ** TeX modes *** New option 'latex-indent-within-escaped-parens' -permits to customize indentation of LaTeX environments delimited +permits customizing indentation of LaTeX environments delimited by escaped parens. ** T-mouse Mode @@ -1726,7 +1726,7 @@ and Bzr. VC will now pass a multiple-file commit to these systems as a single changeset. *** 'vc-dir' is a new command that displays file names and their VC -status. It allows to apply various VC operations to a file, a +status. It allows applying various VC operations to a file, a directory or a set of files/directories. *** VC switches are no longer appended, rather the first non-nil value is used. diff --git a/etc/NEWS.24 b/etc/NEWS.24 index 1e1206d058f..160674f5918 100644 --- a/etc/NEWS.24 +++ b/etc/NEWS.24 @@ -872,7 +872,7 @@ name and arguments. ** Tramp -*** New connection method "adb", which allows to access Android +*** New connection method "adb", which allows accessing Android devices by the Android Debug Bridge. The variable 'tramp-adb-program' can be used to adapt the path of the "adb" program, if needed. @@ -2703,12 +2703,12 @@ specified by 'display-buffer-fallback-action'. display actions, taking precedence over 'display-buffer-base-action'. *** New option 'window-combination-limit'. -The new option 'window-combination-limit' allows to return the space +The new option 'window-combination-limit' allows returning the space obtained for resizing or creating a window more reliably to the window from which such space was obtained. *** New option 'window-combination-resize'. -The new option 'window-combination-resize' allows to split a window that +The new option 'window-combination-resize' allows splitting a window that otherwise cannot be split because it's too small by stealing space from other windows in the same combination. Subsequent resizing or deletion of the window will resize all windows in the same combination as well. @@ -2721,7 +2721,7 @@ frame, or quitting a window showing a buffer in a frame of its own. These maximize and minimize the size of a window within its frame. *** New commands 'switch-to-prev-buffer' and 'switch-to-next-buffer'. -These functions allow to navigate through the live buffers that have +These functions allow navigating through the live buffers that have been shown in a specific window. ** Minibuffer changes @@ -3496,7 +3496,7 @@ and 'window-body-height' are provided. For each window you can specify a parameter to override the default behavior of a number of functions like 'split-window', 'delete-window' and 'delete-other-windows'. The variable 'ignore-window-parameters' -allows to ignore processing such parameters. +allows ignoring processing such parameters. *** New semantics of third argument of 'split-window'. The third argument of 'split-window' has been renamed to SIDE and can be @@ -3554,7 +3554,7 @@ are user-customizable variables. See the docstring of 'display-buffer' for details. *** New functions 'window-state-get' and 'window-state-put'. -These functions allow to save and restore the state of an arbitrary +These functions allow saving and restoring the state of an arbitrary frame or window as an Elisp object. ** Completion diff --git a/etc/NEWS.26 b/etc/NEWS.26 index 29eee5eb4a2..fb13733f45c 100644 --- a/etc/NEWS.26 +++ b/etc/NEWS.26 @@ -38,7 +38,7 @@ in its NEWS.) ** Installing Emacs now installs the emacs-module.h file. The emacs-module.h file is now installed in the system-wide include -directory as part of the Emacs installation. This allows to build +directory as part of the Emacs installation. This allows building Emacs modules outside of the Emacs source tree. diff --git a/etc/NEWS.29 b/etc/NEWS.29 index e74cbee4a53..f6add757c08 100644 --- a/etc/NEWS.29 +++ b/etc/NEWS.29 @@ -2004,7 +2004,7 @@ The intention is that this command can be used to access a wide variety of version control system-specific functionality from VC without complexifying either the VC command set or the backend API. -*** 'C-x v v' in a diffs buffer allows to commit only some of the changes. +*** 'C-x v v' in a diffs buffer allows committing only some of the changes. This command is intended to allow you to commit only some of the changes you have in your working tree. Begin by creating a buffer with the changes against the last commit, e.g. with 'C-x v D' @@ -3501,7 +3501,7 @@ The variables 'connection-local-profile-alist' and make it more convenient to inspect and modify them. *** New function 'connection-local-update-profile-variables'. -This function allows to modify the settings of an existing +This function allows modifying the settings of an existing connection-local profile. *** New macro 'with-connection-local-application-variables'. @@ -4018,7 +4018,7 @@ measured will be counted for the purpose of calculating the text dimensions. ** 'window-text-pixel-size' understands a new meaning of FROM. -Specifying a cons as the FROM argument allows to start measuring text +Specifying a cons as the FROM argument allows measuring text starting from a specified amount of pixels above or below a position. ** 'window-body-width' and 'window-body-height' can use remapped faces. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 11659c66e68..dfc34a4eaca 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -836,7 +836,7 @@ On many systems, it is possible to set LD_LIBRARY_PATH in your environment to specify additional directories where shared libraries can be found. -Other systems allow to set LD_RUN_PATH in a similar way, but before +Other systems allow setting LD_RUN_PATH in a similar way, but before Emacs is linked. With LD_RUN_PATH set, the linker will include a specified run-time search path in the executable. @@ -2540,7 +2540,7 @@ keyboard; printing that file on a PostScript printer will show what keys can serve as Meta. The 'xkeycaps' also shows a visual representation of the current -keyboard settings. It also allows to modify them. +keyboard settings. It also allows modifying them. *** GNU/Linux: slow startup on Linux-based GNU systems. @@ -2794,7 +2794,7 @@ one, you could use the following workarounds: directory to that new home directory. . Move all the *.eln files from ~/.emacs.d/eln-cache to a directory out of the C:\Users tree, and customize Emacs to use that - directory for *.eln files. This requires to call the function + directory for *.eln files. This requires calling the function startup-redirect-eln-cache in your init file, to force Emacs to write *.eln files compiled at run time to that directory. . Delete all *.eln files in your ~/.emacs.d/eln-cache directory, and diff --git a/etc/TODO b/etc/TODO index 0f198ffbddd..2292f100ac4 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1229,7 +1229,7 @@ Necessary for indirect buffers to work? *** Locating schemas -**** Should 'rng-validate-mode' allow to specify a schema? +**** Should 'rng-validate-mode' allow specifying a schema? Give the user an opportunity to specify a schema if there is currently none? Or should it at least give a hint to the user how to specify a non-vacuous schema? diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el index f469c1ec941..fd38084e645 100644 --- a/lisp/leim/quail/latin-pre.el +++ b/lisp/leim/quail/latin-pre.el @@ -789,9 +789,9 @@ ("'Z" ?Ź) (".z" ?ż) (".Z" ?Ż) - ;; Explicit input of prefix characters. Normally, to input a prefix - ;; character itself, one needs to press . Definitions below - ;; allow to input those characters by entering them twice. + ;; Explicit input of prefix characters. Normally, to input a prefix + ;; character itself, one needs to press . Definitions below + ;; allow inputting those characters by entering them twice. ("//" ?/) ("\\\\" ?\\) ("~~" ?~) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index eaf1298278f..e4edb6cfcca 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4431,7 +4431,7 @@ tramp-config-check "A function to be called with one argument, VEC. It should return a string which is used to check, whether the configuration of the remote host has been changed (which would -require to flush the cache data). This string is kept as +require flushing the cache data). This string is kept as connection property \"config-check-data\". This variable is intended as connection-local variable.") diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 9ad191c8f78..cbc02a985c1 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -1803,7 +1803,7 @@ org-insert-link docstring. Otherwise, if `org-link-make-description-function' is non-nil, this function will be called with the link target, and the result will be the default link description. When called -non-interactively, don't allow to edit the default description." +non-interactively, don't allow editing the default description." (interactive "P") (let* ((wcf (current-window-configuration)) (origbuf (current-buffer)) @@ -2042,7 +2042,7 @@ org-update-radio-target-regexp (interactive) (let ((old-regexp org-target-link-regexp) ;; Some languages, e.g., Chinese, do not use spaces to - ;; separate words. Also allow to surround radio targets with + ;; separate words. Also allow surrounding radio targets with ;; line-breakable characters. (before-re "\\(?:^\\|[^[:alnum:]]\\|\\c|\\)\\(") (after-re "\\)\\(?:$\\|[^[:alnum:]]\\|\\c|\\)") diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 0debd1a6818..0dd149762c4 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -2968,7 +2968,7 @@ org-element-verse-block-interpreter ;; object types they can contain will be specified in ;; `org-element-object-restrictions'. ;; -;; Creating a new type of object requires to alter +;; Creating a new type of object requires altering ;; `org-element--object-regexp' and `org-element--object-lex', add the ;; new type in `org-element-all-objects', and possibly add ;; restrictions in `org-element-object-restrictions'. @@ -3523,7 +3523,7 @@ org-element-link-parser ;; ;; Also treat any newline character and associated ;; indentation as a single space character. This is not - ;; compatible with RFC 3986, which requires to ignore + ;; compatible with RFC 3986, which requires ignoring ;; them altogether. However, doing so would require ;; users to encode spaces on the fly when writing links ;; (e.g., insert [[shell:ls%20*.org]] instead of diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 221497f53b7..aa819aa7d2f 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -417,7 +417,7 @@ org-table-relative-ref-may-cross-hline portability of tables." :group 'org-table-calculation :type '(choice - (const :tag "Allow to cross" t) + (const :tag "Allow crossing hline" t) (const :tag "Stick to hline" nil) (const :tag "Error on attempt to cross" error))) @@ -3900,7 +3900,7 @@ org-table--list-shrunk-columns ;; Aligning table from the first row will not shrink again the ;; second row, which was not visible initially. ;; - ;; However, fixing it requires to check every row, which may be + ;; However, fixing it requires checking every row, which may be ;; slow on large tables. Moreover, the hindrance of this ;; pathological case is very limited. (beginning-of-line) diff --git a/lisp/org/org.el b/lisp/org/org.el index 9a0bcf7dd66..0e06c6e6bbc 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -13228,7 +13228,7 @@ org-read-property-name nil nil nil nil default-prop))) (defun org-set-property-and-value (use-last) - "Allow to set [PROPERTY]: [value] direction from prompt. + "Allow setting [PROPERTY]: [value] direction from prompt. When use-default, don't even ask, just use the last \"[PROPERTY]: [value]\" string from the history." (interactive "P") @@ -17655,8 +17655,8 @@ org-delete-indentation (defun org-open-line (n) "Insert a new row in tables, call `open-line' elsewhere. If `org-special-ctrl-o' is nil, just call `open-line' everywhere. -As a special case, when a document starts with a table, allow to -call `open-line' on the very first character." +As a special case, when a document starts with a table, allow +calling `open-line' on the very first character." (interactive "*p") (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p)) (org-table-insert-row) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 9695ee3d849..036af806e60 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -114,7 +114,7 @@ (require 'thingatpt) ; end-of-thing (require 'warnings) ; warning-numeric-level, display-warning (require 'compile) ; for some faces -;; We need the next require to avoid compiler warnings and run-time +;; We need the next `require' to avoid compiler warnings and run-time ;; errors about mouse-wheel-up/down-event in builds --without-x, where ;; mwheel is not preloaded. (require 'mwheel) diff --git a/lisp/simple.el b/lisp/simple.el index c6bdfc763b7..d9f4ee19704 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4899,7 +4899,7 @@ shell-command-on-region Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, erase that buffer and insert the output there; a non-nil value of -`shell-command-dont-erase-buffer' prevent to erase the buffer. +`shell-command-dont-erase-buffer' prevents erasing the buffer. If the value is nil, use the buffer specified by `shell-command-buffer-name'. Any other non-nil value means to insert the output in the current buffer after START. @@ -5146,7 +5146,7 @@ process-file-side-effects (defcustom process-file-return-signal-string nil "Whether to return a string describing the signal interrupting a process. When a process returns an exit code greater than 128, it is -interpreted as a signal. `process-file' requires to return a +interpreted as a signal. `process-file' requires returning a string describing this signal. Since there are processes violating this rule, returning exit codes greater than 128 which are not bound to a signal, diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 92be5a52bf2..004b844a3e7 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -146,7 +146,7 @@ enriched-mode-hook :type 'hook) (defcustom enriched-allow-eval-in-display-props nil - "If non-nil allow to evaluate arbitrary forms in display properties. + "If non-nil, allow evaluating arbitrary forms in display properties. Enriched mode recognizes display properties of text stored using an extension command to the text/enriched format, \"x-display\". diff --git a/lisp/window.el b/lisp/window.el index 5184b5457ba..2f9b46ebb0a 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8275,8 +8275,8 @@ display-buffer-in-direction window produced this way is on the side of the reference window specified by the `direction' entry. -Four special values for `direction' entries allow to implicitly -specify the selected frame's main window as reference window: +Four special values for `direction' entries allow implicitly +specifying the selected frame's main window as reference window: `leftmost', `top', `rightmost' and `bottom'. Hence, instead of `(direction . left) (window . main)' one can simply write `(direction . leftmost)'. diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index fce15fcbd8c..c57549c96e7 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -208,7 +208,7 @@ #define MAX_UTF8_PATH (MAXPATHLEN * 4) /* Unlike MS and mingw.org, MinGW64 doesn't define gai_strerror as an inline function in a system header file, and instead seems to - require to link against ws2_32.a. But we don't want to link with + require linking against ws2_32.a. But we don't want to link with -lws2_32, as that would make Emacs dependent on the respective DLL. So MinGW64 is amply punished here by the following: */ #undef HAVE_GAI_STRERROR diff --git a/src/xdisp.c b/src/xdisp.c index 077245a7791..2944f3964e8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19170,7 +19170,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, && !f->cursor_type_changed && NILP (Vshow_trailing_whitespace) /* When display-line-numbers is in relative mode, moving point - requires to redraw the entire window. */ + requires redrawing the entire window. */ && !EQ (Vdisplay_line_numbers, Qrelative) && !EQ (Vdisplay_line_numbers, Qvisual) /* When the current line number should be displayed in a commit 46c30c6df75fb89c74ce2cd762e1909a0215169a Author: Stefan Kangas Date: Sun Sep 17 15:33:02 2023 +0200 Make obsolete flymake proc less prominent in manual * doc/misc/flymake.texi: Don't mention obsolete legacy support on the first page. It is still documented in a separate chapter. diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index e68692afb10..e0cb79aa546 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -65,10 +65,6 @@ Top to support new backends via an Elisp interface. @xref{Extending Flymake}. -Historically, Flymake used to accept diagnostics from a single -backend. Although obsolete, it is still functional. To learn how to -use and customize it, @pxref{The legacy Proc backend}. - @ifnottex @insertcopying @end ifnottex commit b74d9e8bad9cfbd19ee4d7c56bff9349ca8fb07a Author: Mauro Aranda Date: Sun Sep 17 10:00:20 2023 -0300 Fix shell-indirect-setup-hook :type (Bug#66051) * lisp/shell.el (shell-indirect-setup-hook): It's a hook, not a boolean. diff --git a/lisp/shell.el b/lisp/shell.el index 5cf108bfa3b..f844e0496b0 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -327,9 +327,8 @@ shell-indirect-setup-hook buffer as the current buffer after its setup is done. This can be used to further customize fontification and other behavior of the indirect buffer." - :type 'boolean + :type 'hook :group 'shell - :safe 'booleanp :version "29.1") (defcustom shell-highlight-undef-enable nil commit 0d493116aeae3ba21982419d30e6fc12c9117c35 Author: Michael Albinus Date: Sun Sep 17 12:13:14 2023 +0200 Make "toolbox" and "flatpak" multi-hop completion capable in Tramp * lisp/net/tramp-container.el (tramp-skeleton-completion-function): Bind `tramp-verbose' to 0. (tramp-toolbox--completion-function) (tramp-flatpak--completion-function): Use METHOD as argument. Use `tramp-skeleton-completion-function'. (tramp-completion-multi-hop-methods): Add "toolbox" and "flatpak". diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index bef3b04b371..7383ea583cb 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -166,8 +166,10 @@ tramp-skeleton-completion-function (or (and (member ,method tramp-completion-multi-hop-methods) tramp--last-hop-directory) tramp-compat-temporary-file-directory)) - (program (tramp-get-method-parameter - (make-tramp-file-name :method ,method) 'tramp-login-program)) + (program (let ((tramp-verbose 0)) + (tramp-get-method-parameter + (make-tramp-file-name :method ,method) + 'tramp-login-program))) (vec (when (tramp-tramp-file-p default-directory) (tramp-dissect-file-name default-directory))) non-essential) @@ -312,49 +314,48 @@ tramp-kubernetes--context-namespace " ")) ;;;###tramp-autoload -(defun tramp-toolbox--completion-function (&rest _args) +(defun tramp-toolbox--completion-function (method) "List Toolbox containers available for connection. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." - (when-let ((default-directory tramp-compat-temporary-file-directory) - (raw-list (shell-command-to-string - (concat tramp-toolbox-program " list -c"))) - ;; Ignore header line. - (lines (cdr (split-string raw-list "\n" 'omit))) - (names (mapcar - (lambda (line) - (when (string-match - (rx bol (1+ (not space)) - (1+ space) (group (1+ (not space))) space) - line) - (match-string 1 line))) - lines))) - (mapcar (lambda (name) (list nil name)) (delq nil names)))) + (tramp-skeleton-completion-function method + (when-let ((raw-list (shell-command-to-string (concat program " list -c"))) + ;; Ignore header line. + (lines (cdr (split-string raw-list "\n" 'omit))) + (names (mapcar + (lambda (line) + (when (string-match + (rx bol (1+ (not space)) + (1+ space) (group (1+ (not space))) space) + line) + (match-string 1 line))) + lines))) + (mapcar (lambda (name) (list nil name)) (delq nil names))))) ;;;###tramp-autoload -(defun tramp-flatpak--completion-function (&rest _args) +(defun tramp-flatpak--completion-function (method) "List Flatpak sandboxes available for connection. It returns application IDs or, in case there is no application ID, instance IDs. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." - (when-let ((default-directory tramp-compat-temporary-file-directory) - (raw-list - (shell-command-to-string - (concat tramp-flatpak-program - " ps --columns=instance,application"))) - (lines (split-string raw-list "\n" 'omit)) - (names (mapcar - (lambda (line) - (when (string-match - (rx bol (* space) (group (+ (not space))) - (? (+ space) (group (+ (not space)))) eol) - line) - (or (match-string 2 line) (match-string 1 line)))) - lines))) - (mapcar (lambda (name) (list nil name)) (delq nil names)))) + (tramp-skeleton-completion-function method + (when-let ((raw-list + (shell-command-to-string + ;; Ignore header line. + (concat program " ps --columns=instance,application | cat -"))) + (lines (split-string raw-list "\n" 'omit)) + (names (mapcar + (lambda (line) + (when (string-match + (rx bol (* space) (group (+ (not space))) + (? (+ space) (group (+ (not space)))) eol) + line) + (or (match-string 2 line) (match-string 1 line)))) + lines))) + (mapcar (lambda (name) (list nil name)) (delq nil names))))) ;;;###tramp-autoload (defvar tramp-default-remote-shell) ;; Silence byte compiler. @@ -440,15 +441,17 @@ tramp-default-remote-shell (tramp-set-completion-function tramp-toolbox-method - '((tramp-toolbox--completion-function ""))) + `((tramp-toolbox--completion-function ,tramp-toolbox-method))) (tramp-set-completion-function tramp-flatpak-method - '((tramp-flatpak--completion-function ""))) + `((tramp-flatpak--completion-function ,tramp-flatpak-method))) (add-to-list 'tramp-completion-multi-hop-methods tramp-docker-method) (add-to-list 'tramp-completion-multi-hop-methods tramp-podman-method) (add-to-list 'tramp-completion-multi-hop-methods tramp-kubernetes-method) + (add-to-list 'tramp-completion-multi-hop-methods tramp-toolbox-method) + (add-to-list 'tramp-completion-multi-hop-methods tramp-flatpak-method) ;; Default connection-local variables for Tramp. commit f549d4330f34a0fa6867f3d83832476ce5c4873f Author: Thomas Hilke Date: Fri Sep 15 10:30:25 2023 +0200 Remove column quoting from sqlite-mode * lisp/sqlite-mode.el (sqlite-mode--column-names): Unquote column name. (Bug#65998) Copyright-paperwork-exempt: yes diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el index 71c9e57fc12..38e9f84b842 100644 --- a/lisp/sqlite-mode.el +++ b/lisp/sqlite-mode.el @@ -136,22 +136,7 @@ sqlite-mode-list-columns (defun sqlite-mode--column-names (table) "Return a list of the column names for TABLE." - (let ((sql - (caar - (sqlite-select - sqlite--db - "select sql from sqlite_master where tbl_name = ? AND type = 'table'" - (list table))))) - (with-temp-buffer - (insert sql) - (mapcar #'string-trim - (split-string - ;; Extract the args to CREATE TABLE. Point is - ;; currently at its end. - (buffer-substring - (1- (point)) ; right before ) - (1+ (progn (backward-sexp) (point)))) ; right after ( - ","))))) + (mapcar (lambda (row) (nth 1 row)) (sqlite-select sqlite--db (format "pragma table_info(%s)" table)))) (defun sqlite-mode-list-data () "List the data from the table under point." commit e686fb9de39657ac97b33c1fe74c3328d0fb90fd Author: Christophe Troestler Date: Mon Sep 11 15:32:57 2023 +0200 Add prettify-symbols configuration to 'rust-ts-mode' * lisp/progmodes/rust-ts-mode.el (rust-ts-mode-prettify-symbols-alist): New variable. (rust-ts-mode--prettify-symbols-compose-p): New function. (rust-ts-mode): Use it. diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 999c1d7ae96..88344934e49 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -48,6 +48,12 @@ rust-ts-mode-indent-offset :safe 'integerp :group 'rust) +(defvar rust-ts-mode-prettify-symbols-alist + '(("&&" . ?∧) ("||" . ?∨) + ("<=" . ?≤) (">=" . ?≥) ("!=" . ?≠) + ("INFINITY" . ?∞) ("->" . ?→) ("=>" . ?⇒)) + "Value for `prettify-symbols-alist' in `rust-ts-mode'.") + (defvar rust-ts-mode--syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?+ "." table) @@ -386,6 +392,19 @@ rust-ts-mode--syntax-propertize (?< '(4 . ?>)) (?> '(5 . ?<)))))))) +(defun rust-ts-mode--prettify-symbols-compose-p (start end match) + "Return true iff the symbol MATCH should be composed. +See `prettify-symbols-compose-predicate'." + (and (fboundp 'prettify-symbols-default-compose-p) + (prettify-symbols-default-compose-p start end match) + ;; Make sure || is not a closure with 0 arguments and && is not + ;; a double reference. + (pcase match + ((or "||" "&&") + (string= (treesit-node-field-name (treesit-node-at (point))) + "operator")) + (_ t)))) + ;;;###autoload (define-derived-mode rust-ts-mode prog-mode "Rust" "Major mode for editing Rust, powered by tree-sitter." @@ -411,6 +430,11 @@ rust-ts-mode number type) ( bracket delimiter error function operator property variable))) + ;; Prettify configuration + (setq prettify-symbols-alist rust-ts-mode-prettify-symbols-alist) + (setq prettify-symbols-compose-predicate + #'rust-ts-mode--prettify-symbols-compose-p) + ;; Imenu. (setq-local treesit-simple-imenu-settings `(("Module" "\\`mod_item\\'" nil nil) commit 38757723e14960260a5a1843715a83e4de26522f Author: Eli Zaretskii Date: Sun Sep 17 11:40:06 2023 +0300 Support Unicode version 15.1 * admin/unidata/BidiBrackets.txt: * admin/unidata/BidiMirroring.txt: * admin/unidata/Blocks.txt: * admin/unidata/IdnaMappingTable.txt: * admin/unidata/NormalizationTest.txt: * admin/unidata/PropertyValueAliases.txt: * admin/unidata/ScriptExtensions.txt: * admin/unidata/Scripts.txt: * admin/unidata/SpecialCasing.txt: * admin/unidata/UnicodeData.txt: * admin/unidata/confusables.txt: * admin/unidata/copyright.html: * test/manual/BidiCharacterTest.txt: * admin/unidata/emoji-data.txt: * admin/unidata/emoji-sequences.txt: * admin/unidata/emoji-test.txt: * admin/unidata/emoji-variation-sequences.txt: * admin/unidata/emoji-zwj-sequences.txt: Update from Unicode data files. * admin/notes/unicode: Update instructions. * lisp/international/characters.el: Update 'char-width-table' data. * etc/NEWS: Announce support for Unicode 15.1. diff --git a/admin/notes/unicode b/admin/notes/unicode index f51393e8d4e..3748989e2fe 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -39,9 +39,9 @@ repository). Next, review the assignment of default values of the Bidi Class property to blocks in the file extracted/DerivedBidiClass.txt from the -UCD (search for "unassigned" in that file). Any changes should be -reflected in the unidata-gen.el file, where it sets up the default -values around line 210. +UCD (search for "unassigned" and "@missing" in that file). Any +changes should be reflected in the unidata-gen.el file, where it sets +up the default values around line 210. Then Emacs should be rebuilt for them to take effect. Rebuilding Emacs updates several derived files elsewhere in the Emacs source @@ -61,9 +61,10 @@ Next, review the changes in UnicodeData.txt vs the previous version used by Emacs. Any changes, be it introduction of new scripts or addition of codepoints to existing scripts, might need corresponding changes in the data used for filling the category-table, case-table, -and char-width-table. The additional scripts should cause automatic -updates in charscript.el, but it is a good idea to look at the results -and see if any changes in admin/unidata/blocks.awk are required. +and char-width-table in characters.el. The additional scripts should +cause automatic updates in charscript.el, but it is a good idea to +look at the results and see if any changes in admin/unidata/blocks.awk +are required. The setting of char-width-table around line 1200 of characters.el should be checked against the latest version of the Unicode file diff --git a/admin/unidata/BidiBrackets.txt b/admin/unidata/BidiBrackets.txt index e138e7f5bea..8cebea41544 100644 --- a/admin/unidata/BidiBrackets.txt +++ b/admin/unidata/BidiBrackets.txt @@ -1,6 +1,6 @@ -# BidiBrackets-15.0.0.txt -# Date: 2022-05-03, 18:42:00 GMT [AG, LI, KW] -# © 2022 Unicode®, Inc. +# BidiBrackets-15.1.0.txt +# Date: 2023-01-18 +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # @@ -12,11 +12,11 @@ # This file is a normative contributory data file in the Unicode # Character Database. # -# Bidi_Paired_Bracket is a normative property of type Miscellaneous, +# Bidi_Paired_Bracket is a normative property # which establishes a mapping between characters that are treated as # bracket pairs by the Unicode Bidirectional Algorithm. # -# Bidi_Paired_Bracket_Type is a normative property of type Enumeration, +# Bidi_Paired_Bracket_Type is a normative property # which classifies characters into opening and closing paired brackets # for the purposes of the Unicode Bidirectional Algorithm. # diff --git a/admin/unidata/BidiMirroring.txt b/admin/unidata/BidiMirroring.txt index 5861d6e7f4b..7e58cc4d715 100644 --- a/admin/unidata/BidiMirroring.txt +++ b/admin/unidata/BidiMirroring.txt @@ -1,6 +1,6 @@ -# BidiMirroring-15.0.0.txt -# Date: 2022-05-03, 18:47:00 GMT [KW, RP] -# © 2022 Unicode®, Inc. +# BidiMirroring-15.1.0.txt +# Date: 2023-01-05 +# © 2023 Unicode®, Inc. # For terms of use, see https://www.unicode.org/terms_of_use.html # # Unicode Character Database @@ -15,7 +15,7 @@ # value, for which there is another Unicode character that typically has a glyph # that is the mirror image of the original character's glyph. # -# The repertoire covered by the file is Unicode 15.0.0. +# The repertoire covered by the file is Unicode 15.1.0. # # The file contains a list of lines with mappings from one code point # to another one for character-based mirroring. diff --git a/admin/unidata/Blocks.txt b/admin/unidata/Blocks.txt index 12684594c9f..8fa3eaad04a 100644 --- a/admin/unidata/Blocks.txt +++ b/admin/unidata/Blocks.txt @@ -1,6 +1,6 @@ -# Blocks-15.0.0.txt -# Date: 2022-01-28, 20:58:00 GMT [KW] -# © 2022 Unicode®, Inc. +# Blocks-15.1.0.txt +# Date: 2023-07-28, 15:47:20 GMT +# © 2023 Unicode®, Inc. # For terms of use, see https://www.unicode.org/terms_of_use.html # # Unicode Character Database @@ -352,6 +352,7 @@ FFF0..FFFF; Specials 2B740..2B81F; CJK Unified Ideographs Extension D 2B820..2CEAF; CJK Unified Ideographs Extension E 2CEB0..2EBEF; CJK Unified Ideographs Extension F +2EBF0..2EE5F; CJK Unified Ideographs Extension I 2F800..2FA1F; CJK Compatibility Ideographs Supplement 30000..3134F; CJK Unified Ideographs Extension G 31350..323AF; CJK Unified Ideographs Extension H diff --git a/admin/unidata/IdnaMappingTable.txt b/admin/unidata/IdnaMappingTable.txt index e4c06117929..3bf6b2668a4 100644 --- a/admin/unidata/IdnaMappingTable.txt +++ b/admin/unidata/IdnaMappingTable.txt @@ -1,11 +1,11 @@ # IdnaMappingTable.txt -# Date: 2022-05-02, 19:29:26 GMT -# © 2022 Unicode®, Inc. +# Date: 2023-08-10, 22:32:27 GMT +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # # Unicode IDNA Compatible Preprocessing for UTS #46 -# Version: 15.0.0 +# Version: 15.1.0 # # For documentation and usage, see https://www.unicode.org/reports/tr46 # @@ -2036,7 +2036,7 @@ 1E9A ; mapped ; 0061 02BE # 1.1 LATIN SMALL LETTER A WITH RIGHT HALF RING 1E9B ; mapped ; 1E61 # 2.0 LATIN SMALL LETTER LONG S WITH DOT ABOVE 1E9C..1E9D ; valid # 5.1 LATIN SMALL LETTER LONG S WITH DIAGONAL STROKE..LATIN SMALL LETTER LONG S WITH HIGH STROKE -1E9E ; mapped ; 0073 0073 # 5.1 LATIN CAPITAL LETTER SHARP S +1E9E ; mapped ; 00DF # 5.1 LATIN CAPITAL LETTER SHARP S 1E9F ; valid # 5.1 LATIN SMALL LETTER DELTA 1EA0 ; mapped ; 1EA1 # 1.1 LATIN CAPITAL LETTER A WITH DOT BELOW 1EA1 ; valid # 1.1 LATIN SMALL LETTER A WITH DOT BELOW @@ -2565,11 +2565,7 @@ 222E ; valid ; ; NV8 # 1.1 CONTOUR INTEGRAL 222F ; mapped ; 222E 222E # 1.1 SURFACE INTEGRAL 2230 ; mapped ; 222E 222E 222E #1.1 VOLUME INTEGRAL -2231..225F ; valid ; ; NV8 # 1.1 CLOCKWISE INTEGRAL..QUESTIONED EQUAL TO -2260 ; disallowed_STD3_valid # 1.1 NOT EQUAL TO -2261..226D ; valid ; ; NV8 # 1.1 IDENTICAL TO..NOT EQUIVALENT TO -226E..226F ; disallowed_STD3_valid # 1.1 NOT LESS-THAN..NOT GREATER-THAN -2270..22F1 ; valid ; ; NV8 # 1.1 NEITHER LESS-THAN NOR EQUAL TO..DOWN RIGHT DIAGONAL ELLIPSIS +2231..22F1 ; valid ; ; NV8 # 1.1 CLOCKWISE INTEGRAL..DOWN RIGHT DIAGONAL ELLIPSIS 22F2..22FF ; valid ; ; NV8 # 3.2 ELEMENT OF WITH LONG HORIZONTAL STROKE..Z NOTATION BAG MEMBERSHIP 2300 ; valid ; ; NV8 # 1.1 DIAMETER SIGN 2301 ; valid ; ; NV8 # 3.0 ELECTRIC ARROW @@ -3273,7 +3269,7 @@ 2FD5 ; mapped ; 9FA0 # 3.0 KANGXI RADICAL FLUTE 2FD6..2FEF ; disallowed # NA .. 2FF0..2FFB ; disallowed # 3.0 IDEOGRAPHIC DESCRIPTION CHARACTER LEFT TO RIGHT..IDEOGRAPHIC DESCRIPTION CHARACTER OVERLAID -2FFC..2FFF ; disallowed # NA .. +2FFC..2FFF ; disallowed # 15.1 IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM RIGHT..IDEOGRAPHIC DESCRIPTION CHARACTER ROTATION 3000 ; disallowed_STD3_mapped ; 0020 # 1.1 IDEOGRAPHIC SPACE 3001 ; valid ; ; NV8 # 1.1 IDEOGRAPHIC COMMA 3002 ; mapped ; 002E # 1.1 IDEOGRAPHIC FULL STOP @@ -3425,7 +3421,8 @@ 31BB..31BF ; valid # 13.0 BOPOMOFO FINAL LETTER G..BOPOMOFO LETTER AH 31C0..31CF ; valid ; ; NV8 # 4.1 CJK STROKE T..CJK STROKE N 31D0..31E3 ; valid ; ; NV8 # 5.1 CJK STROKE H..CJK STROKE Q -31E4..31EF ; disallowed # NA .. +31E4..31EE ; disallowed # NA .. +31EF ; disallowed # 15.1 IDEOGRAPHIC DESCRIPTION CHARACTER SUBTRACTION 31F0..31FF ; valid # 3.2 KATAKANA LETTER SMALL KU..KATAKANA LETTER SMALL RO 3200 ; disallowed_STD3_mapped ; 0028 1100 0029 #1.1 PARENTHESIZED HANGUL KIYEOK 3201 ; disallowed_STD3_mapped ; 0028 1102 0029 #1.1 PARENTHESIZED HANGUL NIEUN @@ -8450,7 +8447,9 @@ FFFE..FFFF ; disallowed # 1.1 .. 2CEB0..2EBE0 ; valid # 10.0 CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED IDEOGRAPH-2EBE0 -2EBE1..2F7FF ; disallowed # NA .. +2EBE1..2EBEF ; disallowed # NA .. +2EBF0..2EE5D ; valid # 15.1 CJK UNIFIED IDEOGRAPH-2EBF0..CJK UNIFIED IDEOGRAPH-2EE5D +2EE5E..2F7FF ; disallowed # NA .. 2F800 ; mapped ; 4E3D # 3.1 CJK COMPATIBILITY IDEOGRAPH-2F800 2F801 ; mapped ; 4E38 # 3.1 CJK COMPATIBILITY IDEOGRAPH-2F801 2F802 ; mapped ; 4E41 # 3.1 CJK COMPATIBILITY IDEOGRAPH-2F802 diff --git a/admin/unidata/NormalizationTest.txt b/admin/unidata/NormalizationTest.txt index e75b4801c9b..2e88574243d 100644 --- a/admin/unidata/NormalizationTest.txt +++ b/admin/unidata/NormalizationTest.txt @@ -1,6 +1,6 @@ -# NormalizationTest-15.0.0.txt -# Date: 2022-04-02, 01:29:09 GMT -# © 2022 Unicode®, Inc. +# NormalizationTest-15.1.0.txt +# Date: 2023-01-05, 20:34:44 GMT +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # diff --git a/admin/unidata/PropertyValueAliases.txt b/admin/unidata/PropertyValueAliases.txt index 9346fcf03ee..6d308108818 100644 --- a/admin/unidata/PropertyValueAliases.txt +++ b/admin/unidata/PropertyValueAliases.txt @@ -1,6 +1,6 @@ -# PropertyValueAliases-15.0.0.txt -# Date: 2022-08-05, 23:42:17 GMT -# © 2022 Unicode®, Inc. +# PropertyValueAliases-15.1.0.txt +# Date: 2023-08-07, 15:21:34 GMT +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # @@ -91,6 +91,7 @@ age; 12.1 ; V12_1 age; 13.0 ; V13_0 age; 14.0 ; V14_0 age; 15.0 ; V15_0 +age; 15.1 ; V15_1 age; NA ; Unassigned # Alphabetic (Alpha) @@ -208,6 +209,7 @@ blk; CJK_Ext_E ; CJK_Unified_Ideographs_Extension_E blk; CJK_Ext_F ; CJK_Unified_Ideographs_Extension_F blk; CJK_Ext_G ; CJK_Unified_Ideographs_Extension_G blk; CJK_Ext_H ; CJK_Unified_Ideographs_Extension_H +blk; CJK_Ext_I ; CJK_Unified_Ideographs_Extension_I blk; CJK_Radicals_Sup ; CJK_Radicals_Supplement blk; CJK_Strokes ; CJK_Strokes blk; CJK_Symbols ; CJK_Symbols_And_Punctuation @@ -817,6 +819,21 @@ IDSB; Y ; Yes ; T IDST; N ; No ; F ; False IDST; Y ; Yes ; T ; True +# IDS_Unary_Operator (IDSU) + +IDSU; N ; No ; F ; False +IDSU; Y ; Yes ; T ; True + +# ID_Compat_Math_Continue (ID_Compat_Math_Continue) + +ID_Compat_Math_Continue; N ; No ; F ; False +ID_Compat_Math_Continue; Y ; Yes ; T ; True + +# ID_Compat_Math_Start (ID_Compat_Math_Start) + +ID_Compat_Math_Start; N ; No ; F ; False +ID_Compat_Math_Start; Y ; Yes ; T ; True + # ID_Continue (IDC) IDC; N ; No ; F ; False @@ -836,6 +853,13 @@ IDS; Y ; Yes ; T Ideo; N ; No ; F ; False Ideo; Y ; Yes ; T ; True +# Indic_Conjunct_Break (InCB) + +InCB; Consonant ; Consonant +InCB; Extend ; Extend +InCB; Linker ; Linker +InCB; None ; None + # Indic_Positional_Category (InPC) InPC; Bottom ; Bottom @@ -1074,7 +1098,10 @@ jt ; U ; Non_Joining # Line_Break (lb) lb ; AI ; Ambiguous +lb ; AK ; Aksara lb ; AL ; Alphabetic +lb ; AP ; Aksara_Prebase +lb ; AS ; Aksara_Start lb ; B2 ; Break_Both lb ; BA ; Break_After lb ; BB ; Break_Before @@ -1112,6 +1139,8 @@ lb ; SA ; Complex_Context lb ; SG ; Surrogate lb ; SP ; Space lb ; SY ; Break_Symbols +lb ; VF ; Virama_Final +lb ; VI ; Virama lb ; WJ ; Word_Joiner lb ; XX ; Unknown lb ; ZW ; ZWSpace @@ -1156,6 +1185,9 @@ NFKC_QC; M ; Maybe NFKC_QC; N ; No NFKC_QC; Y ; Yes +# NFKC_Simple_Casefold (NFKC_SCF) + + # NFKD_Quick_Check (NFKD_QC) NFKD_QC; N ; No diff --git a/admin/unidata/ScriptExtensions.txt b/admin/unidata/ScriptExtensions.txt index 2f5a1727e33..23141fb8241 100644 --- a/admin/unidata/ScriptExtensions.txt +++ b/admin/unidata/ScriptExtensions.txt @@ -1,6 +1,6 @@ -# ScriptExtensions-15.0.0.txt -# Date: 2022-02-02, 00:57:11 GMT -# © 2022 Unicode®, Inc. +# ScriptExtensions-15.1.0.txt +# Date: 2023-02-01, 23:02:24 GMT +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # @@ -136,20 +136,20 @@ # ================================================ -# Script_Extensions=Arab Rohg +# Script_Extensions=Arab Nkoo -06D4 ; Arab Rohg # Po ARABIC FULL STOP +FD3E ; Arab Nkoo # Pe ORNATE LEFT PARENTHESIS +FD3F ; Arab Nkoo # Ps ORNATE RIGHT PARENTHESIS -# Total code points: 1 +# Total code points: 2 # ================================================ -# Script_Extensions=Arab Nkoo +# Script_Extensions=Arab Rohg -FD3E ; Arab Nkoo # Pe ORNATE LEFT PARENTHESIS -FD3F ; Arab Nkoo # Ps ORNATE RIGHT PARENTHESIS +06D4 ; Arab Rohg # Po ARABIC FULL STOP -# Total code points: 2 +# Total code points: 1 # ================================================ @@ -553,17 +553,17 @@ FF64..FF65 ; Bopo Hang Hani Hira Kana Yiii # Po [2] HALFWIDTH IDEOGRAPHIC C # ================================================ -# Script_Extensions=Beng Deva Gran Knda Nand Orya Telu Tirh +# Script_Extensions=Adlm Arab Mand Mani Ougr Phlp Rohg Sogd Syrc -1CF2 ; Beng Deva Gran Knda Nand Orya Telu Tirh # Lo VEDIC SIGN ARDHAVISARGA +0640 ; Adlm Arab Mand Mani Ougr Phlp Rohg Sogd Syrc # Lm ARABIC TATWEEL # Total code points: 1 # ================================================ -# Script_Extensions=Adlm Arab Mand Mani Ougr Phlp Rohg Sogd Syrc +# Script_Extensions=Beng Deva Gran Knda Mlym Nand Orya Sinh Telu Tirh -0640 ; Adlm Arab Mand Mani Ougr Phlp Rohg Sogd Syrc # Lm ARABIC TATWEEL +1CF2 ; Beng Deva Gran Knda Mlym Nand Orya Sinh Telu Tirh # Lo VEDIC SIGN ARDHAVISARGA # Total code points: 1 @@ -572,10 +572,9 @@ FF64..FF65 ; Bopo Hang Hani Hira Kana Yiii # Po [2] HALFWIDTH IDEOGRAPHIC C # Script_Extensions=Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Sind Takr Tirh A836..A837 ; Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Sind Takr Tirh # So [2] NORTH INDIC QUARTER MARK..NORTH INDIC PLACEHOLDER MARK -A838 ; Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Sind Takr Tirh # Sc NORTH INDIC RUPEE MARK A839 ; Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Sind Takr Tirh # So NORTH INDIC QUANTITY MARK -# Total code points: 4 +# Total code points: 3 # ================================================ @@ -587,6 +586,14 @@ A839 ; Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Sind Takr Tirh # So # ================================================ +# Script_Extensions=Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Shrd Sind Takr Tirh + +A838 ; Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Shrd Sind Takr Tirh # Sc NORTH INDIC RUPEE MARK + +# Total code points: 1 + +# ================================================ + # Script_Extensions=Beng Deva Gran Gujr Guru Knda Latn Mlym Orya Shrd Taml Telu Tirh 0951 ; Beng Deva Gran Gujr Guru Knda Latn Mlym Orya Shrd Taml Telu Tirh # Mn DEVANAGARI STRESS SIGN UDATTA @@ -595,17 +602,17 @@ A839 ; Deva Dogr Gujr Guru Khoj Kthi Mahj Modi Sind Takr Tirh # So # ================================================ -# Script_Extensions=Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Modi Nand Sind Takr Tirh +# Script_Extensions=Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Modi Nand Shrd Sind Takr Tirh -A833..A835 ; Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Modi Nand Sind Takr Tirh # No [3] NORTH INDIC FRACTION ONE SIXTEENTH..NORTH INDIC FRACTION THREE SIXTEENTHS +A833..A835 ; Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Modi Nand Shrd Sind Takr Tirh # No [3] NORTH INDIC FRACTION ONE SIXTEENTH..NORTH INDIC FRACTION THREE SIXTEENTHS # Total code points: 3 # ================================================ -# Script_Extensions=Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Mlym Modi Nand Sind Takr Tirh +# Script_Extensions=Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Mlym Modi Nand Shrd Sind Takr Tirh -A830..A832 ; Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Mlym Modi Nand Sind Takr Tirh # No [3] NORTH INDIC FRACTION ONE QUARTER..NORTH INDIC FRACTION THREE QUARTERS +A830..A832 ; Deva Dogr Gujr Guru Khoj Knda Kthi Mahj Mlym Modi Nand Shrd Sind Takr Tirh # No [3] NORTH INDIC FRACTION ONE QUARTER..NORTH INDIC FRACTION THREE QUARTERS # Total code points: 3 diff --git a/admin/unidata/Scripts.txt b/admin/unidata/Scripts.txt index 2b138bffb88..0b3f717cb20 100644 --- a/admin/unidata/Scripts.txt +++ b/admin/unidata/Scripts.txt @@ -1,6 +1,6 @@ -# Scripts-15.0.0.txt -# Date: 2022-04-26, 23:15:02 GMT -# © 2022 Unicode®, Inc. +# Scripts-15.1.0.txt +# Date: 2023-07-28, 16:01:07 GMT +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # @@ -357,7 +357,7 @@ 2E5B ; Common # Ps BOTTOM HALF LEFT PARENTHESIS 2E5C ; Common # Pe BOTTOM HALF RIGHT PARENTHESIS 2E5D ; Common # Pd OBLIQUE HYPHEN -2FF0..2FFB ; Common # So [12] IDEOGRAPHIC DESCRIPTION CHARACTER LEFT TO RIGHT..IDEOGRAPHIC DESCRIPTION CHARACTER OVERLAID +2FF0..2FFF ; Common # So [16] IDEOGRAPHIC DESCRIPTION CHARACTER LEFT TO RIGHT..IDEOGRAPHIC DESCRIPTION CHARACTER ROTATION 3000 ; Common # Zs IDEOGRAPHIC SPACE 3001..3003 ; Common # Po [3] IDEOGRAPHIC COMMA..DITTO MARK 3004 ; Common # So JAPANESE INDUSTRIAL STANDARD SYMBOL @@ -399,6 +399,7 @@ 3192..3195 ; Common # No [4] IDEOGRAPHIC ANNOTATION ONE MARK..IDEOGRAPHIC ANNOTATION FOUR MARK 3196..319F ; Common # So [10] IDEOGRAPHIC ANNOTATION TOP MARK..IDEOGRAPHIC ANNOTATION MAN MARK 31C0..31E3 ; Common # So [36] CJK STROKE T..CJK STROKE Q +31EF ; Common # So IDEOGRAPHIC DESCRIPTION CHARACTER SUBTRACTION 3220..3229 ; Common # No [10] PARENTHESIZED IDEOGRAPH ONE..PARENTHESIZED IDEOGRAPH TEN 322A..3247 ; Common # So [30] PARENTHESIZED IDEOGRAPH MOON..CIRCLED IDEOGRAPH KOTO 3248..324F ; Common # No [8] CIRCLED NUMBER TEN ON BLACK SQUARE..CIRCLED NUMBER EIGHTY ON BLACK SQUARE @@ -629,7 +630,7 @@ FFFC..FFFD ; Common # So [2] OBJECT REPLACEMENT CHARACTER..REPLACEMENT CHAR E0001 ; Common # Cf LANGUAGE TAG E0020..E007F ; Common # Cf [96] TAG SPACE..CANCEL TAG -# Total code points: 8301 +# Total code points: 8306 # ================================================ @@ -1593,11 +1594,12 @@ FA70..FAD9 ; Han # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COMPATIBILI 2B740..2B81D ; Han # Lo [222] CJK UNIFIED IDEOGRAPH-2B740..CJK UNIFIED IDEOGRAPH-2B81D 2B820..2CEA1 ; Han # Lo [5762] CJK UNIFIED IDEOGRAPH-2B820..CJK UNIFIED IDEOGRAPH-2CEA1 2CEB0..2EBE0 ; Han # Lo [7473] CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED IDEOGRAPH-2EBE0 +2EBF0..2EE5D ; Han # Lo [622] CJK UNIFIED IDEOGRAPH-2EBF0..CJK UNIFIED IDEOGRAPH-2EE5D 2F800..2FA1D ; Han # Lo [542] CJK COMPATIBILITY IDEOGRAPH-2F800..CJK COMPATIBILITY IDEOGRAPH-2FA1D 30000..3134A ; Han # Lo [4939] CJK UNIFIED IDEOGRAPH-30000..CJK UNIFIED IDEOGRAPH-3134A 31350..323AF ; Han # Lo [4192] CJK UNIFIED IDEOGRAPH-31350..CJK UNIFIED IDEOGRAPH-323AF -# Total code points: 98408 +# Total code points: 99030 # ================================================ diff --git a/admin/unidata/SpecialCasing.txt b/admin/unidata/SpecialCasing.txt index 08d04fa9421..de08450a6b9 100644 --- a/admin/unidata/SpecialCasing.txt +++ b/admin/unidata/SpecialCasing.txt @@ -1,6 +1,6 @@ -# SpecialCasing-15.0.0.txt -# Date: 2022-02-02, 23:35:52 GMT -# © 2022 Unicode®, Inc. +# SpecialCasing-15.1.0.txt +# Date: 2023-01-05, 20:35:03 GMT +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # diff --git a/admin/unidata/UnicodeData.txt b/admin/unidata/UnicodeData.txt index ea963a7162c..bdcc41850d7 100644 --- a/admin/unidata/UnicodeData.txt +++ b/admin/unidata/UnicodeData.txt @@ -11231,6 +11231,10 @@ 2FF9;IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM UPPER RIGHT;So;0;ON;;;;;N;;;;; 2FFA;IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM LOWER LEFT;So;0;ON;;;;;N;;;;; 2FFB;IDEOGRAPHIC DESCRIPTION CHARACTER OVERLAID;So;0;ON;;;;;N;;;;; +2FFC;IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM RIGHT;So;0;ON;;;;;N;;;;; +2FFD;IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM LOWER RIGHT;So;0;ON;;;;;N;;;;; +2FFE;IDEOGRAPHIC DESCRIPTION CHARACTER HORIZONTAL REFLECTION;So;0;ON;;;;;N;;;;; +2FFF;IDEOGRAPHIC DESCRIPTION CHARACTER ROTATION;So;0;ON;;;;;N;;;;; 3000;IDEOGRAPHIC SPACE;Zs;0;WS; 0020;;;;N;;;;; 3001;IDEOGRAPHIC COMMA;Po;0;ON;;;;;N;;;;; 3002;IDEOGRAPHIC FULL STOP;Po;0;ON;;;;;N;IDEOGRAPHIC PERIOD;;;; @@ -11705,6 +11709,7 @@ 31E1;CJK STROKE HZZZG;So;0;ON;;;;;N;;;;; 31E2;CJK STROKE PG;So;0;ON;;;;;N;;;;; 31E3;CJK STROKE Q;So;0;ON;;;;;N;;;;; +31EF;IDEOGRAPHIC DESCRIPTION CHARACTER SUBTRACTION;So;0;ON;;;;;N;;;;; 31F0;KATAKANA LETTER SMALL KU;Lo;0;L;;;;;N;;;;; 31F1;KATAKANA LETTER SMALL SI;Lo;0;L;;;;;N;;;;; 31F2;KATAKANA LETTER SMALL SU;Lo;0;L;;;;;N;;;;; @@ -34035,6 +34040,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 2CEA1;;Lo;0;L;;;;;N;;;;; 2CEB0;;Lo;0;L;;;;;N;;;;; 2EBE0;;Lo;0;L;;;;;N;;;;; +2EBF0;;Lo;0;L;;;;;N;;;;; +2EE5D;;Lo;0;L;;;;;N;;;;; 2F800;CJK COMPATIBILITY IDEOGRAPH-2F800;Lo;0;L;4E3D;;;;N;;;;; 2F801;CJK COMPATIBILITY IDEOGRAPH-2F801;Lo;0;L;4E38;;;;N;;;;; 2F802;CJK COMPATIBILITY IDEOGRAPH-2F802;Lo;0;L;4E41;;;;N;;;;; diff --git a/admin/unidata/confusables.txt b/admin/unidata/confusables.txt index 24b61d519af..5e056ed5a35 100644 --- a/admin/unidata/confusables.txt +++ b/admin/unidata/confusables.txt @@ -1,11 +1,11 @@ # confusables.txt -# Date: 2022-08-26, 16:49:08 GMT -# © 2022 Unicode®, Inc. +# Date: 2023-08-11, 17:46:40 GMT +# © 2023 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see https://www.unicode.org/terms_of_use.html # # Unicode Security Mechanisms for UTS #39 -# Version: 15.0.0 +# Version: 15.1.0 # # For documentation and usage, see https://www.unicode.org/reports/tr39 # @@ -349,8 +349,8 @@ A4FA ; 002E 002E ; MA # ( ꓺ → .. ) LISU LETTER TONE MYA CYA → FULL STOP, F A6F4 ; A6F3 A6F3 ; MA #* ( ꛴ → ꛳꛳ ) BAMUM COLON → BAMUM FULL STOP, BAMUM FULL STOP # -30FB ; 00B7 ; MA #* ( ・ → · ) KATAKANA MIDDLE DOT → MIDDLE DOT # →•→ -FF65 ; 00B7 ; MA #* ( ･ → · ) HALFWIDTH KATAKANA MIDDLE DOT → MIDDLE DOT # →•→ +30FB ; 00B7 ; MA # ( ・ → · ) KATAKANA MIDDLE DOT → MIDDLE DOT # →•→ +FF65 ; 00B7 ; MA # ( ･ → · ) HALFWIDTH KATAKANA MIDDLE DOT → MIDDLE DOT # →•→ 16EB ; 00B7 ; MA #* ( ᛫ → · ) RUNIC SINGLE PUNCTUATION → MIDDLE DOT # 0387 ; 00B7 ; MA # ( · → · ) GREEK ANO TELEIA → MIDDLE DOT # 2E31 ; 00B7 ; MA #* ( ⸱ → · ) WORD SEPARATOR MIDDLE DOT → MIDDLE DOT # diff --git a/admin/unidata/copyright.html b/admin/unidata/copyright.html index 567c54e72ac..fe6dd16903e 100644 --- a/admin/unidata/copyright.html +++ b/admin/unidata/copyright.html @@ -13,7 +13,7 @@ Unicode Terms of Use +href="http://www.unicode.org/webscripts/standard_styles.css">