commit 2f36fc1b4f78aa27f4f484fbd09fcabacee36504 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Mon May 6 12:09:21 2024 +0800 Optimize stipples on Android * java/org/gnu/emacs/EmacsGC.java (EmacsGC) : Change type to EmacsTileObject. (markDirty): Create an EmacsTileObject rather than a BitmapDrawable. * java/org/gnu/emacs/EmacsTileObject.java: New file, significantly leaner than BitmapDrawable. diff --git a/java/org/gnu/emacs/EmacsGC.java b/java/org/gnu/emacs/EmacsGC.java index f956b230f8c..d400c23e067 100644 --- a/java/org/gnu/emacs/EmacsGC.java +++ b/java/org/gnu/emacs/EmacsGC.java @@ -29,8 +29,6 @@ import android.graphics.PorterDuffColorFilter; import android.graphics.Shader.TileMode; -import android.graphics.drawable.BitmapDrawable; - import android.os.Build; /* X like graphics context structures. Keep the enums in synch with @@ -58,7 +56,7 @@ public final class EmacsGC extends EmacsHandleObject public Paint gcPaint; /* Drawable object for rendering the stiple bitmap. */ - public BitmapDrawable tileObject; + public EmacsTileObject tileObject; /* ID incremented every time the clipping rectangles of any GC changes. */ @@ -132,11 +130,9 @@ public final class EmacsGC extends EmacsHandleObject /* Allocate a new tile object if none is already present or it cannot be reconfigured. */ - if ((tileObject == null) - || (Build.VERSION.SDK_INT < Build.VERSION_CODES.S)) + if (tileObject == null) { - tileObject = new BitmapDrawable (EmacsService.resources, - stippleBitmap); + tileObject = new EmacsTileObject (stippleBitmap); tileObject.setTileModeXY (TileMode.REPEAT, TileMode.REPEAT); } else @@ -144,11 +140,8 @@ public final class EmacsGC extends EmacsHandleObject bitmap. */ tileObject.setBitmap (stippleBitmap); } - else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S - && tileObject != null) - tileObject.setBitmap (null); else if (tileObject != null) - tileObject = null; + tileObject.setBitmap (null); } /* Prepare the tile object to draw a stippled image onto a section of diff --git a/java/org/gnu/emacs/EmacsTileObject.java b/java/org/gnu/emacs/EmacsTileObject.java new file mode 100644 index 00000000000..34a35e83bfb --- /dev/null +++ b/java/org/gnu/emacs/EmacsTileObject.java @@ -0,0 +1,101 @@ +/* Communication module for Android terminals. -*- c-file-style: "GNU" -*- + +Copyright (C) 2023-2024 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +package org.gnu.emacs; + +import android.graphics.Bitmap; +import android.graphics.BitmapShader; +import android.graphics.Canvas; +import android.graphics.ColorFilter; +import android.graphics.Paint; +import android.graphics.Rect; +import android.graphics.Shader.TileMode; + +/* This is a crude facsimilie of the BitmapDrawable class implementing + just enough of its functionality to support displaying stipples in + EmacsGC. */ + +public final class EmacsTileObject +{ + /* Color filter object set by EmacsGC. */ + private ColorFilter colorFilter; + + /* Bitmap object set by EmacsGC. */ + private Bitmap bitmap; + + /* Tiling modes on either axis. */ + private TileMode xTile, yTile; + + /* Destination rectangle. */ + private Rect boundsRect; + + /* Paint providing graphics properties for drawBitmap. */ + private Paint paint; + + + + public + EmacsTileObject (Bitmap stippleBitmap) + { + bitmap = stippleBitmap; + paint = new Paint (); + } + + public void + setBitmap (Bitmap newBitmap) + { + bitmap = newBitmap; + } + + public void + setBounds (Rect bounds) + { + boundsRect = bounds; + } + + public void + setTileModeXY (TileMode newXTile, TileMode newYTile) + { + xTile = newXTile; + yTile = newYTile; + } + + public void + setColorFilter (ColorFilter filterObject) + { + paint.setColorFilter (filterObject); + } + + public Bitmap + getBitmap () + { + return bitmap; + } + + /* Replicate `bitmap' over CANVAS so that boundsRect is covered with + copies thereof on the X axis, if xTile is REPEAT, and also on the Y + axis, if yTile is a like value. */ + + public void + draw (Canvas canvas) + { + paint.setShader (new BitmapShader (bitmap, xTile, yTile)); + canvas.drawRect (boundsRect, paint); + } +}; commit f920959ac98afa8f8eb142abe94bec276fa7a2b7 Author: Andrea Corallo Date: Sun May 5 23:39:01 2024 +0200 Remove unnecessary cons in function-type property * lisp/emacs-lisp/comp-common.el (comp-function-type-spec): Remove unnecessary car. * lisp/emacs-lisp/comp.el (comp--intern-func-in-ctxt): Likewise. * lisp/emacs-lisp/byte-run.el (byte-run--set-function-type): Update lambda list. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 84cc83f2270..f9e86d88806 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -218,7 +218,7 @@ So far, FUNCTION can only be a symbol, not a lambda expression." val))))) (defalias 'byte-run--set-function-type - #'(lambda (f _args &rest val) + #'(lambda (f _args val) (list 'function-put (list 'quote f) ''function-type (list 'quote val)))) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index ef40882a98a..355988838c7 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -517,7 +517,7 @@ itself." (when (and f (null type-spec)) (if-let ((delc-type (function-get function 'function-type))) ;; Declared Lisp function - (setf type-spec (car delc-type)) + (setf type-spec delc-type) (when (subr-native-elisp-p f) ;; Native compiled inferred (setf kind 'inferred diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b1e4b77ae40..e69de84362e 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -825,7 +825,7 @@ clashes." (comp-func-lap func) lap (comp-func-frame-size func) (comp--byte-frame-size byte-func) (comp-func-speed func) (comp--spill-speed name) - (comp-func-declared-type func) (car (comp--spill-decl-spec name 'function-type)) + (comp-func-declared-type func) (comp--spill-decl-spec name 'function-type) (comp-func-pure func) (comp--spill-decl-spec name 'pure)) ;; Store the c-name to have it retrievable from commit 77f87d4b489fcb332fc3d8d3d4a8080e7e1818fd Author: Andrea Corallo Date: Sun May 5 23:16:20 2024 +0200 Fix intra compilation unit function type declaration * lisp/emacs-lisp/comp.el (comp-func): Add 'slot'. (comp--intern-func-in-ctxt): Update. (comp--get-function-cstr): Update. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index d7cd6b79c86..b1e4b77ae40 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -194,8 +194,10 @@ Useful to hook into pass checkers.") (when (symbolp function) (let ((f (symbol-function function))) (or (gethash f comp-primitive-func-cstr-h) - (when-let ((res (function-get function 'function-type))) - (comp-type-spec-to-cstr (car res))))))) + (when-let ((type (or (when-let ((f (comp--symbol-func-to-fun function))) + (comp-func-declared-type f)) + (function-get function 'function-type)))) + (comp-type-spec-to-cstr type)))))) ;; Keep it in sync with the `cl-deftype-satisfies' property set in ;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the @@ -523,6 +525,8 @@ CFG is mutated by a pass.") :documentation "Optimization level (see `native-comp-speed').") (pure nil :type boolean :documentation "t if pure nil otherwise.") + (declared-type nil :type list + :documentation "Declared function type.") (type nil :type (or null comp-mvar) :documentation "Mvar holding the derived return type.")) @@ -821,6 +825,7 @@ clashes." (comp-func-lap func) lap (comp-func-frame-size func) (comp--byte-frame-size byte-func) (comp-func-speed func) (comp--spill-speed name) + (comp-func-declared-type func) (car (comp--spill-decl-spec name 'function-type)) (comp-func-pure func) (comp--spill-decl-spec name 'pure)) ;; Store the c-name to have it retrievable from commit 44036b32ba398cf284320285b60be35874b6eea5 Author: Stefan Monnier Date: Sun May 5 17:23:29 2024 -0400 eglot.el: Require `track-changes` unconditionally * lisp/emacs-lisp/track-changes.el: Bump version. * lisp/progmodes/eglot.el: Require `track-changes` unconditionally. (Package-Requires:): Add `track-changes`. (eglot--track-changes-signal, eglot--signal-textDocument/didChange) (eglot--managed-mode): Remove non-track-changes alternative code. (eglot--before-change, eglot--after-change): Delete functions. diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 6562cc7eb86..2824a70586d 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2024 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Version: 1.1 +;; Version: 1.2 ;; Package-Requires: ((emacs "24")) ;; This file is part of GNU Emacs. @@ -74,6 +74,12 @@ ;; id (lambda (beg end before) ;; ..DO THE THING..)))))))) +;;; News: + +;; Since v1.1: +;; +;; - New function `track-changes-inconsistent-state-p'. + ;;; Code: ;; Random ideas: diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 47d45a100f2..57a019e126d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -7,7 +7,7 @@ ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.24") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1") (compat "27.1")) +;; Package-Requires: ((emacs "26.3") (compat "27.1") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.2.1") (jsonrpc "1.0.24") (project "0.9.8") (seq "2.23") (track-changes "1.2") (xref "1.6.2")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -103,14 +103,12 @@ (require 'pcase) (require 'compile) ; for some faces (require 'warnings) -(eval-when-compile - (require 'subr-x)) (require 'filenotify) (require 'ert) (require 'text-property-search nil t) (require 'diff-mode) (require 'diff) -(require 'track-changes nil t) +(require 'track-changes) (require 'compat) ;; These dependencies are also GNU ELPA core packages. Because of @@ -135,6 +133,10 @@ ;; the loaded file is not the one that should have been loaded. (mapc reload '(project flymake xref jsonrpc external-completion)))) +;; Keep the eval-when-compile requires at the end, in case it's already been +;; required unconditionally by some earlier `require'. +(eval-when-compile (require 'subr-x)) + ;; forward-declare, but don't require (Emacs 28 doesn't seem to care) (defvar markdown-fontify-code-blocks-natively) (defvar company-backends) @@ -1983,13 +1985,10 @@ Use `eglot-managed-p' to determine if current buffer is managed.") ("utf-8" (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos) (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos))) - (if (fboundp 'track-changes-register) - (unless eglot--track-changes - (setq eglot--track-changes - (track-changes-register - #'eglot--track-changes-signal :disjoint t))) - (add-hook 'after-change-functions #'eglot--after-change nil t) - (add-hook 'before-change-functions #'eglot--before-change nil t)) + (unless eglot--track-changes + (setq eglot--track-changes + (track-changes-register + #'eglot--track-changes-signal :disjoint t))) (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t) ;; Prepend "didClose" to the hook after the "nonoff", so it will run first (add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil t) @@ -2026,8 +2025,6 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (when eglot--track-changes (track-changes-unregister eglot--track-changes) (setq eglot--track-changes nil)) - (remove-hook 'after-change-functions #'eglot--after-change t) - (remove-hook 'before-change-functions #'eglot--before-change t) (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t) (remove-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose t) (remove-hook 'before-revert-hook #'eglot--signal-textDocument/didClose t) @@ -2607,7 +2604,7 @@ buffer." `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1))))) (defvar-local eglot--recent-changes nil - "Recent buffer changes as collected by `eglot--before-change'.") + "Recent buffer changes as collected by `eglot--track-changes-fetch'.") (cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what) "Tell if SERVER is ready for WHAT in current buffer." @@ -2615,56 +2612,9 @@ buffer." (defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.") -(defun eglot--before-change (beg end) - "Hook onto `before-change-functions' with BEG and END." - (when (listp eglot--recent-changes) - ;; Records BEG and END, crucially convert them into LSP - ;; (line/char) positions before that information is lost (because - ;; the after-change thingy doesn't know if newlines were - ;; deleted/added). Also record markers of BEG and END - ;; (github#259) - (push `(,(eglot--pos-to-lsp-position beg) - ,(eglot--pos-to-lsp-position end) - (,beg . ,(copy-marker beg nil)) - (,end . ,(copy-marker end t))) - eglot--recent-changes))) - (defvar eglot--document-changed-hook '(eglot--signal-textDocument/didChange) "Internal hook for doing things when the document changes.") -(defun eglot--after-change (beg end pre-change-length) - "Hook onto `after-change-functions'. -Records BEG, END and PRE-CHANGE-LENGTH locally." - (cl-incf eglot--versioned-identifier) - (pcase (car-safe eglot--recent-changes) - (`(,lsp-beg ,lsp-end - (,b-beg . ,b-beg-marker) - (,b-end . ,b-end-marker)) - ;; github#259 and github#367: with `capitalize-word' & friends, - ;; `before-change-functions' records the whole word's `b-beg' and - ;; `b-end'. Similarly, when `fill-paragraph' coalesces two - ;; lines, `b-beg' and `b-end' mark end of first line and end of - ;; second line, resp. In both situations, `beg' and `end' - ;; received here seemingly contradict that: they will differ by 1 - ;; and encompass the capitalized character or, in the coalescing - ;; case, the replacement of the newline with a space. We keep - ;; both markers and positions to detect and correct this. In - ;; this specific case, we ignore `beg', `len' and - ;; `pre-change-len' and send richer information about the region - ;; from the markers. I've also experimented with doing this - ;; unconditionally but it seems to break when newlines are added. - (if (and (= b-end b-end-marker) (= b-beg b-beg-marker) - (or (/= beg b-beg) (/= end b-end))) - (setcar eglot--recent-changes - `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker) - ,(buffer-substring-no-properties b-beg-marker - b-end-marker))) - (setcar eglot--recent-changes - `(,lsp-beg ,lsp-end ,pre-change-length - ,(buffer-substring-no-properties beg end))))) - (_ (setf eglot--recent-changes :emacs-messup))) - (eglot--track-changes-signal nil)) - (defun eglot--track-changes-fetch (id) (if (eq eglot--recent-changes :pending) (setq eglot--recent-changes nil)) (track-changes-fetch @@ -2704,15 +2654,14 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." (lambda (buf) (eglot--when-live-buffer buf (when eglot--managed-mode - (if (and (fboundp 'track-changes-inconsistent-state-p) - (track-changes-inconsistent-state-p)) + (if (track-changes-inconsistent-state-p) ;; Not a good time (e.g. in the middle of Quail thingy, ;; bug#70541): reschedule for the next idle period. - (eglot--add-one-shot-hook - 'post-command-hook - (lambda () - (eglot--when-live-buffer buf - (eglot--track-changes-signal id)))) + (eglot--add-one-shot-hook + 'post-command-hook + (lambda () + (eglot--when-live-buffer buf + (eglot--track-changes-signal id)))) (run-hooks 'eglot--document-changed-hook) (setq eglot--change-idle-timer nil))))) (current-buffer)))) @@ -2819,8 +2768,7 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didChange () "Send textDocument/didChange to server." - (when eglot--track-changes - (eglot--track-changes-fetch eglot--track-changes)) + (eglot--track-changes-fetch eglot--track-changes) (when eglot--recent-changes (let* ((server (eglot--current-server-or-lose)) (sync-capability (eglot-server-capable :textDocumentSync)) @@ -2838,12 +2786,6 @@ When called interactively, use the currently active server" (buffer-substring-no-properties (point-min) (point-max))))) (cl-loop for (beg end len text) in (reverse eglot--recent-changes) - ;; github#259: `capitalize-word' and commands based - ;; on `casify_region' will cause multiple duplicate - ;; empty entries in `eglot--before-change' calls - ;; without an `eglot--after-change' reciprocal. - ;; Weed them out here. - when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) (setq eglot--recent-changes nil) commit 1529ad0315f8d4a96ca07969c1c91c1c50bb6075 Author: Jim Porter Date: Sun May 5 13:09:08 2024 -0700 Fix Eshell handling of remote files like "/ssh:remote:~/file.txt" * lisp/eshell/em-glob.el (eshell-glob-convert): Use 'concat' instead of 'file-name-concat' to avoid extraneous slashes. (eshell-extended-glob): Bail out if we didn't find a glob after all. * test/lisp/eshell/em-glob-tests.el (tramp): Require. (em-glob-test/convert/remote-start-directory): Use the mock remote connection. (em-glob-test/remote-user-directory): New test. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 7fc6958a00f..89a40151d00 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -317,7 +317,7 @@ The result is a list of three elements: result) ;; We haven't seen a glob yet, so instead append to the start ;; directory. - (setq start-dir (file-name-concat start-dir (car globs)))) + (setq start-dir (concat start-dir (car globs)))) (setq last-saw-recursion nil)) (setq globs (cdr globs))) (list start-dir @@ -341,16 +341,24 @@ Mainly they are not supported because file matching is done with Emacs regular expressions, and these cannot support the above constructs." (let ((globs (eshell-glob-convert glob)) eshell-glob-matches message-shown) - (unwind-protect - (apply #'eshell-glob-entries globs) - (if message-shown - (message nil))) - (or (and eshell-glob-matches (sort eshell-glob-matches #'string<)) - (if eshell-error-if-no-glob - (error "No matches found: %s" glob) - (if eshell-glob-splice-results - (list glob) - glob))))) + (if (null (cadr globs)) + ;; If, after examining GLOB, there are no actual globs, just + ;; bail out. This can happen for remote file names using "~", + ;; like "/ssh:remote:~/file.txt". During parsing, we can't + ;; always be sure if the "~" is a home directory reference or + ;; part of a glob (e.g. if the argument was assembled from + ;; variables). + glob + (unwind-protect + (apply #'eshell-glob-entries globs) + (if message-shown + (message nil))) + (or (and eshell-glob-matches (sort eshell-glob-matches #'string<)) + (if eshell-error-if-no-glob + (error "No matches found: %s" glob) + (if eshell-glob-splice-results + (list glob) + glob)))))) ;; FIXME does this really need to abuse eshell-glob-matches, message-shown? (defun eshell-glob-entries (path globs only-dirs) diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index fc460a59eed..40cdfd1a676 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'tramp) (require 'ert) (require 'em-glob) @@ -138,9 +139,12 @@ value of `eshell-glob-splice-results'." (ert-deftest em-glob-test/convert/remote-start-directory () "Test converting a glob starting in a remote directory." - (should (equal (eshell-glob-convert "/ssh:nowhere.invalid:some/where/*.el") - '("/ssh:nowhere.invalid:/some/where/" - (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + (skip-unless (eshell-tests-remote-accessible-p)) + (let* ((default-directory ert-remote-temporary-file-directory) + (remote (file-remote-p default-directory))) + (should (equal (eshell-glob-convert (format "%s/some/where/*.el" remote)) + `(,(format "%s/some/where/" remote) + (("\\`.*\\.el\\'" . "\\`\\.")) nil))))) ;; Glob matching @@ -288,4 +292,13 @@ value of `eshell-glob-splice-results'." (let ((eshell-error-if-no-glob t)) (should-error (eshell-extended-glob "*.txt"))))) +(ert-deftest em-glob-test/remote-user-directory () + "Test that remote directories using \"~\" pass through unchanged." + (skip-unless (eshell-tests-remote-accessible-p)) + (let* ((default-directory ert-remote-temporary-file-directory) + (remote (file-remote-p default-directory)) + (eshell-error-if-no-glob t)) + (should (equal (eshell-extended-glob (format "%s~/file.txt" remote)) + (format "%s~/file.txt" remote))))) + ;; em-glob-tests.el ends here commit 451863adf942bf4e3c1b9346c0f37e546e16b1fd Author: Gabriel do Nascimento Ribeiro Date: Sun May 5 21:37:23 2024 +0300 Fix tab-line-tabs-buffer-groups (bug#59438) * lisp/tab-line.el (tab-line-tabs-buffer-groups): Handle case when variable 'tab-line-tabs-buffer-groups-sort-function' is nil. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 9ce5ef12f4d..6898ba53e02 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -387,7 +387,7 @@ Used only for `tab-line-tabs-mode-buffers' and `tab-line-tabs-buffer-groups'.") (defcustom tab-line-tabs-buffer-group-function #'tab-line-tabs-buffer-group-by-mode "Function to add a buffer to the appropriate group of tabs. -Takes a buffer as arg and should return a group name as a string. +Takes a buffer as argument and should return a group name as a string. If the return value is nil, the buffer has no group, so \"No group\" is displayed instead of a group name and the buffer is not grouped together with other buffers. @@ -475,13 +475,14 @@ If non-nil, `tab-line-tabs-buffer-group-function' is used to generate the group name." (if (window-parameter nil 'tab-line-groups) (let* ((buffers (funcall tab-line-tabs-buffer-list-function)) - (groups - (seq-sort tab-line-tabs-buffer-groups-sort-function - (delq nil (mapcar #'car (seq-group-by - (lambda (buffer) - (tab-line-tabs-buffer-group-name - buffer)) - buffers))))) + (groups (delq nil + (mapcar #'car + (seq-group-by #'tab-line-tabs-buffer-group-name + buffers)))) + (sorted-groups (if (functionp tab-line-tabs-buffer-groups-sort-function) + (seq-sort tab-line-tabs-buffer-groups-sort-function + groups) + groups)) (selected-group (window-parameter nil 'tab-line-group)) (tabs (mapcar (lambda (group) @@ -492,9 +493,8 @@ generate the group name." (set-window-parameter nil 'tab-line-groups nil) (set-window-parameter nil 'tab-line-group group) (set-window-parameter nil 'tab-line-hscroll nil))))) - groups))) + sorted-groups))) tabs) - (let* ((window-parameter (window-parameter nil 'tab-line-group)) (group-name (tab-line-tabs-buffer-group-name (current-buffer))) (group (prog1 (or window-parameter group-name "No group") @@ -507,10 +507,9 @@ generate the group name." (set-window-parameter nil 'tab-line-groups t) (set-window-parameter nil 'tab-line-group group) (set-window-parameter nil 'tab-line-hscroll nil))))) - (buffers - (seq-filter (lambda (b) - (equal (tab-line-tabs-buffer-group-name b) group)) - (funcall tab-line-tabs-buffer-list-function))) + (buffers (seq-filter (lambda (b) + (equal (tab-line-tabs-buffer-group-name b) group)) + (funcall tab-line-tabs-buffer-list-function))) (sorted-buffers (if (functionp tab-line-tabs-buffer-group-sort-function) (seq-sort tab-line-tabs-buffer-group-sort-function buffers) commit 12132ec1efb1c4ea5f73d7018896964ce2e0311e Author: Juri Linkov Date: Sun May 5 21:32:22 2024 +0300 * lisp/tab-line.el: Use defcustom for group sort variables (bug#59438). (tab-line-tabs-buffer-group-sort-function) (tab-line-tabs-buffer-groups-sort-function): Turn defvar into defcustom. Suggested by Gabriel do Nascimento Ribeiro . (tab-line-tabs-buffer-group-name): Fall back to 'tab-line-tabs-buffer-group-by-mode' when 'tab-line-tabs-buffer-group-function' is nil (its previous default value). diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 896e1c802f7..9ce5ef12f4d 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -408,15 +408,34 @@ as a group name." :group 'tab-line :version "30.1") -(defvar tab-line-tabs-buffer-group-sort-function +(defcustom tab-line-tabs-buffer-group-sort-function #'tab-line-tabs-buffer-group-sort-by-name - "Function to sort buffers in a group.") + "Function to sort buffers in a group." + :type '(choice (const :tag "Don't sort" nil) + (const :tag "Sort by name alphabetically" + tab-line-tabs-buffer-group-sort-by-name) + (function :tag "Custom function")) + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set-default sym val) + (force-mode-line-update)) + :group 'tab-line + :version "30.1") (defun tab-line-tabs-buffer-group-sort-by-name (a b) (string< (buffer-name a) (buffer-name b))) -(defvar tab-line-tabs-buffer-groups-sort-function #'string< - "Function to sort group names.") +(defcustom tab-line-tabs-buffer-groups-sort-function #'string< + "Function to sort group names." + :type '(choice (const :tag "Don't sort" nil) + (const :tag "Sort alphabetically" string<) + (function :tag "Custom function")) + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set-default sym val) + (force-mode-line-update)) + :group 'tab-line + :version "30.1") (defvar tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups "How to group various major modes together in the tab line. @@ -445,7 +464,8 @@ named the same as the mode.") (defun tab-line-tabs-buffer-group-name (&optional buffer) (if (functionp tab-line-tabs-buffer-group-function) - (funcall tab-line-tabs-buffer-group-function buffer))) + (funcall tab-line-tabs-buffer-group-function buffer) + (tab-line-tabs-buffer-group-by-mode buffer))) (defun tab-line-tabs-buffer-groups () "Return a list of tabs that should be displayed in the tab line. commit 6f16ef1c04c1ab3524eab6bb98376afc50a6078b Author: Michael Albinus Date: Sun May 5 19:54:07 2024 +0200 Fix lock-file format in Tramp * lisp/net/tramp.el (tramp-lock-file-info-regexp): BOOT_TIME can be negative. (Bug#70415) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 34a636ab97d..4c62d1d9f39 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4545,7 +4545,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (rx bos (group (+ nonl)) "@" (group (+ nonl)) "." (group (+ digit)) - (? ":" (+ digit)) eos) + (? ":" (? "-") (+ digit)) eos) "The format of a lock file.") (defun tramp-handle-file-locked-p (file) commit 8d3e4e823f21d5a70f7e6c51e161b2322f1bccc3 Author: Dmitry Gutov Date: Sun May 5 20:19:48 2024 +0300 project--vc-list-files: Use vc-git-command for better error reporting * lisp/progmodes/project.el (project--vc-list-files): Use 'vc-git-command' for better error reporting (https://lists.gnu.org/archive/html/emacs-devel/2024-05/msg00399.html). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index a3181340411..52fe4df9080 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -648,7 +648,7 @@ See `project-vc-extra-root-markers' for the marker value format.") (list (project-root project))))) (declare-function vc-git--program-version "vc-git") -(declare-function vc-git--run-command-string "vc-git") +(declare-function vc-git-command "vc-git") (declare-function vc-hg-command "vc-hg") (defun project--vc-list-files (dir backend extra-ignores) @@ -701,7 +701,8 @@ See `project-vc-extra-root-markers' for the marker value format.") file (concat default-directory file)))) (split-string - (apply #'vc-git--run-command-string nil "ls-files" args) + (with-output-to-string + (apply #'vc-git-command standard-output 0 nil "ls-files" args)) "\0" t)))) (when (project--vc-merge-submodules-p default-directory) ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. commit 696b1cb8de2cbd808d572edbd3beca4813af3514 Author: Dmitry Gutov Date: Sun May 5 19:42:05 2024 +0300 project-find-regexp: Fix test * test/lisp/progmodes/project-tests.el (project-find-regexp): Add binding for project-list-file, to fix the test when running in the terminal (reported on the mailing list). diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 84a5d55f136..21703cbdad6 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -170,6 +170,7 @@ When `project-ignores' includes a name matching project dir." (skip-unless (executable-find "grep")) (let* ((directory (ert-resource-directory)) (project-find-functions nil) + (project-list-file (expand-file-name "emacs-projects" temporary-file-directory)) (project (cons 'transient directory))) (add-hook 'project-find-functions (lambda (_dir) project)) (should (eq (project-current) project)) commit d5b6627faa9bbd0059600a91d1cd45c0b31e3cd8 Author: Eli Zaretskii Date: Sun May 5 19:30:57 2024 +0300 Fix lock files on some versions of Cygwin * src/filelock.c (current_lock_owner): Support negative boot-time on rare systems. (Bug#70415) diff --git a/src/filelock.c b/src/filelock.c index 01d35c46726..e5b352cb6ff 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -419,7 +419,9 @@ current_lock_owner (lock_info_type *owner, Lisp_Object lfname) boot += 2; FALLTHROUGH; case ':': - if (! c_isdigit (boot[0])) + if (!(c_isdigit (boot[0]) + /* A negative number. */ + || (boot[0] == '-' && c_isdigit (boot[1])))) return EINVAL; boot_time = strtoimax (boot, &lfinfo_end, 10); break; commit 61ad641893bc521e98cc06162634299d57b2bf8a Author: Stefan Monnier Date: Sun May 5 10:43:37 2024 -0400 (read-passwd-toggle-visibility): Fix some loose ends * lisp/auth-source.el (read-passwd-toggle-visibility): Make sure we operate on the minibuffer even if some other window was selected when the little icon was pressed. Don't hardcode the keymap representation. Use the `keymap` property rather than the `local-map` property so it can't be accidentally shadowed by something like a minor-mode map. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index e6dbead7476..2de78c5ae55 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2489,22 +2489,30 @@ point is moved into the passwords (see `authinfo-hide-elements'). "Toggle minibuffer contents visibility. Adapt also mode line." (interactive) - (setq read-passwd--hide-password (not read-passwd--hide-password)) - (with-current-buffer read-passwd--mode-line-buffer - (setq read-passwd--mode-line-icon - `(:propertize - ,(if icon-preference - (icon-string - (if read-passwd--hide-password - 'read-passwd--show-password-icon - 'read-passwd--hide-password-icon)) - "") - mouse-face mode-line-highlight - local-map - (keymap - (mode-line keymap (mouse-1 . read-passwd-toggle-visibility))))) - (force-mode-line-update)) - (read-passwd--hide-password)) + (let ((win (active-minibuffer-window))) + (unless win (error "No active minibuffer")) + ;; FIXME: In case of a recursive minibuffer, this may select the wrong + ;; mini-buffer. + (with-current-buffer (window-buffer win) + (setq read-passwd--hide-password (not read-passwd--hide-password)) + (with-current-buffer read-passwd--mode-line-buffer + (setq read-passwd--mode-line-icon + `(:propertize + ,(if icon-preference + (icon-string + (if read-passwd--hide-password + 'read-passwd--show-password-icon + 'read-passwd--hide-password-icon)) + "") + mouse-face mode-line-highlight + keymap + ,(eval-when-compile + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + #'read-passwd-toggle-visibility) + map)))) + (force-mode-line-update)) + (read-passwd--hide-password)))) (defvar read-passwd-map ;; BEWARE: `defconst' would purecopy it, breaking the sharing with commit 63f9f2259e9cf6b17c5092b09c3cf0e37c7e6fae Author: Mattias Engdegård Date: Sun May 5 16:20:58 2024 +0200 ; * etc/NEWS: Move 'Miscellaneous' subtopics last. diff --git a/etc/NEWS b/etc/NEWS index e69825669ae..456f9b8f8b8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -403,19 +403,6 @@ 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 - ---- -*** New face 'appt-notification' for 'appt-display-mode-line'. -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 after 'env -S'. - ** Emacs Server and Client --- @@ -460,6 +447,19 @@ TTY frames. Colors specified in face underlines will now also be displayed in TTY frames with the previously mentioned capabilities. +** Miscellaneous + +--- +*** New face 'appt-notification' for 'appt-display-mode-line'. +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 after 'env -S'. + * Editing Changes in Emacs 30.1 @@ -1621,36 +1621,6 @@ of the currently existing keyboards macros using the new mode duplicating them, deleting them, and editing their counters, formats, and keys. -** 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. - ---- -*** '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. - -+++ -*** New user option 'rcirc-log-time-format' -This allows for rcirc logs to use a custom timestamp format, than the -chat buffers use by default. - ---- -*** New user option 'Buffer-menu-group-by'. -It controls how buffers are divided into groups that are displayed with -headings using Outline minor mode. - -+++ -*** New command 'Buffer-menu-toggle-internal'. -This command toggles the display of internal buffers in Buffer Menu mode; -that is, buffers not visiting a file and whose names start with a space. -Previously, such buffers were never shown. This command is bound to 'I' -in Buffer Menu mode. - ** Customize +++ @@ -1710,6 +1680,36 @@ options of GNU 'ls'. If non-nil, moving point forward or backward between widgets by typing TAB or S-TAB skips over inactive widgets. The default value is nil. +** 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. + +--- +*** '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. + ++++ +*** New user option 'rcirc-log-time-format' +This allows for rcirc logs to use a custom timestamp format, than the +chat buffers use by default. + +--- +*** New user option 'Buffer-menu-group-by'. +It controls how buffers are divided into groups that are displayed with +headings using Outline minor mode. + ++++ +*** New command 'Buffer-menu-toggle-internal'. +This command toggles the display of internal buffers in Buffer Menu mode; +that is, buffers not visiting a file and whose names start with a space. +Previously, such buffers were never shown. This command is bound to 'I' +in Buffer Menu mode. + * New Modes and Packages in Emacs 30.1 commit d51de0c5d90117bc1dc4bc5bc700253d71cd4579 Author: Mattias Engdegård Date: Sat May 4 16:18:09 2024 +0200 Retract lexical cookie source load warning On balance it seems likely that the warning would annoy more people than it would help, so let them deal with any actual problems when the default is changed instead. See discussion at: https://lists.gnu.org/archive/html/emacs-devel/2024-05/msg00250.html * src/lread.c (string_suffix_p, warn_missing_cookie, Fload) (Feval_buffer): * lisp/international/mule.el (load-with-code-conversion): * lisp/startup.el (command-line--load-script): * etc/NEWS: Revert all changes, except for the generalised `lisp_file_lexical_cookie` which may prove useful in the future. diff --git a/etc/NEWS b/etc/NEWS index 0a1c217d897..e69825669ae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2436,15 +2436,6 @@ The warning name is 'docstrings-control-chars'. *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. ---- -** Warn about missing 'lexical-binding' directive when loading .el files. -Emacs now emits a run-time warning if an Elisp source file being loaded -lacks the '-*- lexical-binding: ... -*-' cookie on the first line. -See the lexical-binding compiler warning described above for how to make -the warning go away by adding a declaration to the file. You can also -suppress the warning by adding an entry for the warning type -'lexical-warning' to 'warning-suppress-types'. - --- ** New user option 'native-comp-async-warnings-errors-kind'. It allows control of what kinds of warnings and errors from asynchronous diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 8875c4f06af..a17221e6d21 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -367,7 +367,7 @@ Return t if file exists." (eval-buffer buffer nil ;; This is compatible with what `load' does. (if dump-mode file fullname) - nil t t)))) + nil t)))) (let (kill-buffer-hook kill-buffer-query-functions) (kill-buffer buffer))) (do-after-load-evaluation fullname) diff --git a/lisp/startup.el b/lisp/startup.el index f2532f5254e..357a4154e4c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2935,7 +2935,7 @@ nil default-directory" name) ;; buffer is empty. (when (looking-at "#!") (delete-line)) - (eval-buffer buffer nil file nil t t))))) + (eval-buffer buffer nil file nil t))))) (defun command-line--eval-script (file) (load-with-code-conversion diff --git a/src/lread.c b/src/lread.c index ba890cb673d..7806c3972ee 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1342,37 +1342,6 @@ close_file_unwind_android_fd (void *ptr) #endif -static bool -string_suffix_p (const char *string, ptrdiff_t string_len, - const char *suffix, ptrdiff_t suffix_len) -{ - return string_len >= suffix_len && memcmp (string + string_len - suffix_len, - suffix, suffix_len) == 0; -} - -static void -warn_missing_cookie (Lisp_Object file) -{ - /* Only warn for files whose name end in .el, to suppress loading of - data-as-code. ".emacs" is an exception, since it does tend to contain - actual hand-written code. */ - if (!STRINGP (file)) - return; - const char *name = SSDATA (file); - ptrdiff_t nb = SBYTES (file); - if (!(string_suffix_p (name, nb, ".el", 3) - || (string_suffix_p (name, nb, ".emacs", 6) - && (nb == 6 || SREF (file, nb - 7) == '/')))) - return; - - Lisp_Object msg = CALLN (Fformat, - build_string ("File %s lacks `lexical-binding'" - " directive on its first line"), - file); - Vdelayed_warnings_list = Fcons (list2 (Qlexical_binding, msg), - Vdelayed_warnings_list); -} - DEFUN ("load", Fload, Sload, 1, 5, 0, doc: /* Execute a file of Lisp code named FILE. First try FILE with `.elc' appended, then try with `.el', then try @@ -1822,10 +1791,7 @@ Return t if the file exists and loads successfully. */) } else { - lexical_cookie_t lc = lisp_file_lexical_cookie (Qget_file_char); - if (lc == Cookie_None && !compiled) - warn_missing_cookie (file); - if (lc == Cookie_Lex) + if (lisp_file_lexical_cookie (Qget_file_char) == Cookie_Lex) Fset (Qlexical_binding, Qt); if (! version || version >= 22) @@ -2658,7 +2624,7 @@ readevalloop (Lisp_Object readcharfun, unbind_to (count, Qnil); } -DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0,6, "", +DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "", doc: /* Execute the accessible portion of current buffer as Lisp code. You can use \\[narrow-to-region] to limit the part of buffer to be evaluated. When called from a Lisp program (i.e., not interactively), this @@ -2675,8 +2641,6 @@ UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this DO-ALLOW-PRINT, if non-nil, specifies that output functions in the evaluated code should work normally even if PRINTFLAG is nil, in which case the output is displayed in the echo area. -LOADING, if non-nil, indicates that this call is part of loading a -Lisp source file. This function ignores the current value of the `lexical-binding' variable. Instead it will heed any @@ -2686,7 +2650,7 @@ will be evaluated without lexical binding. This function preserves the position of point. */) (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, - Lisp_Object unibyte, Lisp_Object do_allow_print, Lisp_Object loading) + Lisp_Object unibyte, Lisp_Object do_allow_print) { specpdl_ref count = SPECPDL_INDEX (); Lisp_Object tem, buf; @@ -2710,10 +2674,8 @@ This function preserves the position of point. */) specbind (Qstandard_output, tem); record_unwind_protect_excursion (); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); - lexical_cookie_t lc = lisp_file_lexical_cookie (buf); - if (!NILP (loading) && lc == Cookie_None) - warn_missing_cookie (filename); - specbind (Qlexical_binding, lc == Cookie_Lex ? Qt : Qnil); + specbind (Qlexical_binding, + lisp_file_lexical_cookie (buf) == Cookie_Lex ? Qt : Qnil); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); commit 71491fe6f4a944457cb56f6323983ef431e0c422 Author: Alan Mackenzie Date: Sun May 5 11:34:14 2024 +0000 Run c-unmark-<>-around-region in after-change-functions always. This fixes bug#70435. * lisp/progmodes/cc-engine.el (c-unmark-<>-around-region): Run its contents in after-change-functions for a deletion, so that c-new-BEG and c-new-END get set. Add a new test (> end beg) in a check for unterminated string handling. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 8c505e9556a..0b50844732f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7146,7 +7146,7 @@ comment at the start of cc-engine.el for more info." ;; FIXME!!! This routine ignores the possibility of macros entirely. ;; 2010-01-29. - (when (> end beg) + (when (or old-len (> end beg)) ;; Extend the region (BEG END) to deal with any complicating literals. (let* ((lit-search-beg (if (memq (char-before beg) '(?/ ?*)) (1- beg) beg)) @@ -7220,7 +7220,8 @@ comment at the start of cc-engine.el for more info." (c-put-char-properties beg end 'syntax-table '(1)) ;; If an open string's opener has just been neutralized, ;; do the same to the terminating LF. - (when (and end-literal-end + (when (and (> end beg) + end-literal-end (eq (char-before end-literal-end) ?\n) (equal (c-get-char-property (1- end-literal-end) 'syntax-table)