commit c9964e180f743a95579ca832d08bfc450a2dc639 (HEAD, refs/remotes/origin/master) Author: john muhl Date: Sun Feb 23 20:03:39 2025 -0600 ; Fix 'typescript-ts-mode' indent test (bug#71998) * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: Set 'indent-tabs-mode' after changing the major mode. diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts index 23cebb4c396..0db35295222 100644 --- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -95,9 +95,9 @@ const foo = () => { Code: (lambda () - (setq indent-tabs-mode nil) (setq tsx-ts-mode-indent-offset 2) (tsx-ts-mode) + (setq indent-tabs-mode nil) (indent-region (point-min) (point-max))) Name: JSX indentation commit 3d46f3e3ed50753766f87f995f9514dff9a6abed Author: Yuan Fu Date: Sun Feb 23 22:04:32 2025 -0800 Fix typescript-ts-mode indentation tests (bug#71998) * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: (JSX indentation): Add quote and remove semi-colon, so the code is valid. diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts index 343eababf54..23cebb4c396 100644 --- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -111,8 +111,8 @@ return (

{ props.foo -? Hello, foo! -: Hello, World!; +? 'Hello, foo!' +: 'Hello, World!' }

@@ -129,8 +129,8 @@ const foo = (props) => {

{ props.foo - ? Hello, foo! - : Hello, World!; + ? 'Hello, foo!' + : 'Hello, World!' }

commit 02fbdbf4ff628fe4ee6112a57d63a14445726215 Author: Gerd Möllmann Date: Mon Feb 24 05:48:29 2025 +0100 Handle case of not knowing a frame when mouse moved * lisp/xt-mouse.el (xterm-mouse--handle-mouse-movement): Don't call display--update-for-mouse-movement if we don't have a frame. diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 250f4efebb4..94b3f08de96 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -133,9 +133,11 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (defun xterm-mouse--handle-mouse-movement () "Handle mouse motion that was just generated for XTerm mouse." - (display--update-for-mouse-movement (terminal-parameter nil 'xterm-mouse-frame) - (terminal-parameter nil 'xterm-mouse-x) - (terminal-parameter nil 'xterm-mouse-y))) + (when-let* ((frame (terminal-parameter nil 'xterm-mouse-frame))) + (display--update-for-mouse-movement + frame + (terminal-parameter nil 'xterm-mouse-x) + (terminal-parameter nil 'xterm-mouse-y)))) ;; These two variables have been converted to terminal parameters. ;; commit 45f5f718a07bb126bbd71952c5fbd1c5f126df7d Author: Stefan Kangas Date: Mon Feb 24 00:45:20 2025 +0100 Use cl-with-gensyms in ert-with-message-capture * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): Use cl-with-gensyms. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index ee86ef2dad8..524f02bb36d 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -329,9 +329,7 @@ This is useful for separating the issuance of messages by the code under test from the behavior of the *Messages* buffer." (declare (debug (symbolp body)) (indent 1)) - (let ((g-message-advice (gensym)) - (g-print-advice (gensym)) - (g-collector (gensym))) + (cl-with-gensyms (g-message-advice g-print-advice g-collector) `(let* ((,var "") (,g-collector (lambda (msg) (setq ,var (concat ,var msg)))) (,g-message-advice (ert--make-message-advice ,g-collector)) commit ae8522af41bb67bf417b94ed54146a43fe2150ec Author: Stefan Kangas Date: Sun Feb 23 21:25:55 2025 +0100 Prefer incf to cl-incf in gnus/*.el * lisp/gnus/gnus-agent.el (gnus-agent-load-local) (gnus-agent-expire-group-1, gnus-agent-update-files-total-fetched-for): * lisp/gnus/gnus-art.el (gnus-article-header-rank): * lisp/gnus/gnus-async.el (gnus-async-wait-for-article): * lisp/gnus/gnus-cache.el (gnus-cache-update-file-total-fetched-for): * lisp/gnus/gnus-registry.el (gnus-registry-import-eld): * lisp/gnus/gnus-salt.el (gnus-pick-line-number, gnus-tree-minimize) (gnus-generate-vertical-tree): * lisp/gnus/gnus-spec.el (gnus-correct-substring): * lisp/gnus/gnus-start.el (gnus-ask-server-for-new-groups, gnus-method-rank): * lisp/gnus/gnus-sum.el (gnus-data-update-list) (gnus-summary-number-of-articles-in-thread, gnus-build-sparse-threads) (gnus-summary-prepare-threads, gnus-invisible-cut-children) (gnus-summary-limit-children, gnus-expunge-thread) (gnus-summary-refer-references, gnus-summary-update-mark) (gnus-summary-hide-all-threads, gnus-summary-save-parts-1): * lisp/gnus/gnus-topic.el (gnus-topic-articles-in-topic) (gnus-topic-prepare-topic, gnus-topic-display-missing-topic) (gnus-topic-update-topic-line): * lisp/gnus/gnus-uu.el (gnus-uu-post-encoded): * lisp/gnus/gnus-win.el (gnus-configure-frame): * lisp/gnus/mail-source.el (mail-source-fetch-directory) (mail-source-fetch-maildir, mail-source-fetch-imap): * lisp/gnus/message.el (message-remove-header) (message-remove-first-header, message-make-caesar-translation-table): * lisp/gnus/mm-encode.el (mm-qp-or-base64): * lisp/gnus/mml.el (mml-compute-boundary, mml-compute-boundary-1): * lisp/gnus/nnatom.el (nnatom--read-links): * lisp/gnus/nnbabyl.el (nnbabyl-retrieve-headers): * lisp/gnus/nndoc.el (nndoc-oe-dbx-dissection, nndoc-dissect-buffer) (nndoc-dissect-mime-parts-sub): * lisp/gnus/nneething.el (nneething-retrieve-headers): * lisp/gnus/nnheader.el (nnheader-generate-fake-message-id) (nnheader-insert-head, nnheader-translate-file-chars): * lisp/gnus/nnimap.el (nnimap-find-wanted-parts-1) (nnimap-retrieve-group-data-early, nnimap-send-command): * lisp/gnus/nnmail.el (nnmail-process-babyl-mail-format) (nnmail-process-unix-mail-format, nnmail-process-mmdf-mail-format) (nnmail-get-new-mail-1): * lisp/gnus/nnmaildir.el (nnmaildir--scan): * lisp/gnus/nnrss.el (nnrss-check-group): * lisp/gnus/nnselect.el (nnselect-request-thread): * lisp/gnus/nnspool.el (nnspool-retrieve-headers): * lisp/gnus/nntp.el (nntp-retrieve-headers) (nntp-finish-retrieve-group-infos, nntp-retrieve-groups) (nntp-retrieve-articles, nntp-retrieve-headers-with-xover): * lisp/gnus/nnvirtual.el (nnvirtual-create-mapping): * lisp/gnus/nnweb.el (nnweb-google-parse-1, nnweb-google-create-mapping) (nnweb-gmane-create-mapping): * lisp/gnus/spam.el (spam-resolve-registrations-routine): Prefer incf to cl-incf. diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 73f636b5992..63c75a28463 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2166,7 +2166,7 @@ method's subscribed groups." 'gnus-agent-file-loading-local #'gnus-agent-read-and-cache-local)) (when gnus-agent-article-local-times - (cl-incf gnus-agent-article-local-times))) + (incf gnus-agent-article-local-times))) gnus-agent-article-local)) (defun gnus-agent-read-and-cache-local (file) @@ -3343,9 +3343,9 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) article-number))) (size (float (file-attribute-size (file-attributes file-name))))) - (cl-incf bytes-freed size) - (cl-incf size-files-deleted size) - (cl-incf files-deleted) + (incf bytes-freed size) + (incf size-files-deleted size) + (incf files-deleted) (delete-file file-name)) (push "expired cached article" actions)) (setf (nth 1 entry) nil) @@ -3358,13 +3358,13 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) marker (- marker position-offset))) - (cl-incf nov-entries-deleted) + (incf nov-entries-deleted) (let* ((from (line-beginning-position)) (to (progn (forward-line 1) (point))) (freed (- to from))) - (cl-incf bytes-freed freed) - (cl-incf position-offset freed) + (incf bytes-freed freed) + (incf position-offset freed) (delete-region from to))) ;; If considering all articles is set, I can only @@ -3421,9 +3421,9 @@ expiration tests failed." group article-number) (when (boundp 'gnus-agent-expire-stats) (let ((stats gnus-agent-expire-stats)) - (cl-incf (nth 2 stats) bytes-freed) - (cl-incf (nth 1 stats) files-deleted) - (cl-incf (nth 0 stats) nov-entries-deleted))) + (incf (nth 2 stats) bytes-freed) + (incf (nth 1 stats) files-deleted) + (incf (nth 0 stats) nov-entries-deleted))) (gnus-agent-update-files-total-fetched-for group (- size-files-deleted))))))) @@ -4076,25 +4076,25 @@ CLEAN is obsolete and ignored." (let ((sum 0.0) file) (while (setq file (pop delta)) - (cl-incf sum (float (or (file-attribute-size - (file-attributes - (nnheader-concat - path - (if (numberp file) - (number-to-string file) - file)))) - 0)))) + (incf sum (float (or (file-attribute-size + (file-attributes + (nnheader-concat + path + (if (numberp file) + (number-to-string file) + file)))) + 0)))) (setq delta sum)) (let ((sum (- (nth 2 entry))) (info (directory-files-and-attributes path nil "\\`-?[0-9]+\\'" t)) file) (while (setq file (pop info)) - (cl-incf sum (float (or (file-attribute-size (cdr file)) 0)))) + (incf sum (float (or (file-attribute-size (cdr file)) 0)))) (setq delta sum)))) (setq gnus-agent-need-update-total-fetched-for t) - (cl-incf (nth 2 entry) delta)))))) + (incf (nth 2 entry) delta)))))) (defun gnus-agent-update-view-total-fetched-for (group agent-over &optional method path) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5b16e82fc48..1235875b411 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1839,7 +1839,7 @@ Initialized from `text-mode-syntax-table'.") (if (looking-at (car list)) (setq list nil) (setq list (cdr list)) - (cl-incf i))) + (incf i))) i)) (defun article-hide-headers (&optional _arg _delete) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index 4410bed5c03..e2d59306d47 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -283,7 +283,7 @@ that was fetched." ;; should check time-since-last-output, which ;; needs to be done in nntp.el. (while (eq article gnus-async-current-prefetch-article) - (cl-incf tries) + (incf tries) (when (nntp-accept-process-output proc) (setq tries 0)) (when (and (not nntp-have-messaged) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 59c5d7bb891..ad86f1043b9 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -833,11 +833,11 @@ supported." (while (setq file (pop files)) (setq attrs (file-attributes file)) (unless (file-attribute-type attrs) - (cl-incf size (float (file-attribute-size attrs))))))) + (incf size (float (file-attribute-size attrs))))))) (setq gnus-cache-need-update-total-fetched-for t) - (cl-incf (nth 1 entry) (if subtract (- size) size)))))) + (incf (nth 1 entry) (if subtract (- size) size)))))) (defun gnus-cache-update-overview-total-fetched-for (group file) (when gnus-cache-total-fetched-hashtb diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 0d7282d73da..ba604af5d12 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1142,7 +1142,7 @@ non-nil." (expected (length old)) entry) (while (car-safe old) - (cl-incf count) + (incf count) ;; todo: use progress reporters. (when (and (< 0 expected) (= 0 (mod count 100))) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index f6f62de3b37..e1d9f8bf188 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -128,7 +128,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." (defvar gnus-pick-line-number 1) (defun gnus-pick-line-number () "Return the current line number." - (cl-incf gnus-pick-line-number)) + (incf gnus-pick-line-number)) (defun gnus-pick-start-reading (&optional catch-up) "Start reading the picked articles. @@ -533,7 +533,7 @@ Two predefined functions are available: (not (one-window-p))) (let ((windows 0) tot-win-height) - (walk-windows (lambda (_window) (cl-incf windows))) + (walk-windows (lambda (_window) (incf windows))) (setq tot-win-height (- (frame-height) (* window-min-height (1- windows)) @@ -765,7 +765,7 @@ it in the environment specified by BINDINGS." (progn (goto-char (point-min)) (end-of-line) - (cl-incf gnus-tmp-indent)) + (incf gnus-tmp-indent)) ;; Recurse downwards in all children of this article. (while thread (gnus-generate-vertical-tree diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 1fa4db48fb4..2d7f1bbbe23 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -283,15 +283,15 @@ Return a list of updated types." ;; Find the start position. (while (and (< seek length) (< wseek start)) - (cl-incf wseek (char-width (aref string seek))) - (cl-incf seek)) + (incf wseek (char-width (aref string seek))) + (incf seek)) (setq wstart seek) ;; Find the end position. (while (and (<= seek length) (or (not end) (<= wseek end))) - (cl-incf wseek (char-width (aref string seek))) - (cl-incf seek)) + (incf wseek (char-width (aref string seek))) + (incf seek)) (setq wend seek) (substring string wstart (1- wend)))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 221e97cd4e6..d167a7c4dd6 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1205,14 +1205,14 @@ for new groups, and subscribe the new groups as zombies." (let ((do-sub (gnus-matches-options-n g-name))) (cond ((eq do-sub 'subscribe) - (cl-incf groups) + (incf groups) (puthash g-name nil gnus-killed-hashtb) ;; group (gnus-call-subscribe-functions gnus-subscribe-options-newsgroup-method g-name)) ((eq do-sub 'ignore) nil) (t - (cl-incf groups) + (incf groups) (puthash g-name nil gnus-killed-hashtb) ;; group (if gnus-subscribe-hierarchical-interactive (push g-name new-newsgroups) @@ -1765,7 +1765,7 @@ backend check whether the group actually exists." (cl-dolist (smethod gnus-secondary-select-methods) (when (equal method smethod) (cl-return i)) - (cl-incf i)) + (incf i)) i))) ;; Just say that all foreign groups have the same rank. (t diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index ed9948525f4..d484d16ba95 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3214,7 +3214,7 @@ The following commands are available: "Add OFFSET to the POS of all data entries in DATA." (setq gnus-newsgroup-data-reverse nil) (while data - (cl-incf (gnus-data-pos (car data)) offset) + (incf (gnus-data-pos (car data)) offset) (setq data (cdr data)))) (defun gnus-summary-article-pseudo-p (article) @@ -3841,7 +3841,7 @@ the thread are to be displayed." 1) (t 0)))) (when (and level (zerop level) gnus-tmp-new-adopts) - (cl-incf number + (incf number (apply #'+ (mapcar #'gnus-summary-number-of-articles-in-thread gnus-tmp-new-adopts)))) @@ -4458,7 +4458,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq end (1+ (point))) (when (search-backward "<" nil t) (setq new-child (buffer-substring (point) end)) - (push (list (cl-incf generation) + (push (list (incf generation) child (setq child new-child) subject date) relations))) @@ -5503,7 +5503,7 @@ or a straight list of headers." (nthcdr 1 thread)) stack)) (push (if (nth 1 thread) 1 0) tree-stack) - (cl-incf gnus-tmp-level) + (incf gnus-tmp-level) (setq threads (if thread-end nil (cdar thread))) (if gnus-summary-display-while-building (if building-count @@ -8756,7 +8756,7 @@ If ALL, mark even excluded ticked and dormants as read." (let ((num 0)) (while threads (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) - (cl-incf num)) + (incf num)) (pop threads)) (< num 2))) @@ -8888,7 +8888,7 @@ fetch-old-headers verbiage, and so on." gnus-summary-expunge-below)) ;; We increase the expunge-tally here, but that has ;; nothing to do with the limits, really. - (cl-incf gnus-newsgroup-expunged-tally) + (incf gnus-newsgroup-expunged-tally) ;; We also mark as read here, if that's wanted. (when (and gnus-summary-mark-below (< score gnus-summary-mark-below)) @@ -8913,7 +8913,7 @@ fetch-old-headers verbiage, and so on." (defun gnus-expunge-thread (thread) "Mark all articles in THREAD as read." (let* ((number (mail-header-number (car thread)))) - (cl-incf gnus-newsgroup-expunged-tally) + (incf gnus-newsgroup-expunged-tally) ;; We also mark as read here, if that's wanted. (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) @@ -8983,7 +8983,7 @@ Return the number of articles fetched." (error "No References in the current article") ;; For each Message-ID in the References header... (while (string-match "<[^>]*>" ref) - (cl-incf n) + (incf n) ;; ... fetch that article. (gnus-summary-refer-article (prog1 (match-string 0 ref) @@ -11246,7 +11246,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (re-search-backward "[\n\r]" (line-beginning-position) 'move-to-limit) (when forward (when (looking-at "\r") - (cl-incf forward)) + (incf forward)) (when (<= (+ forward (point)) (point-max)) ;; Go to the right position on the line. (goto-char (+ forward (point))) @@ -11825,7 +11825,7 @@ will not be hidden." (let ((end nil) (count 0)) (while (not end) - (cl-incf count) + (incf count) (when (zerop (mod count 1000)) (message "Hiding all threads... %d" count)) (when (or (not predicate) @@ -12498,7 +12498,7 @@ If REVERSE, save parts that do not match TYPE." (cdr gnus-article-current) gnus-summary-save-parts-counter)))) dir))) - (cl-incf gnus-summary-save-parts-counter) + (incf gnus-summary-save-parts-counter) (unless (file-exists-p file) (mm-save-part-to-file handle file)))))) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index f46ad458057..149f3961c6c 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -135,7 +135,7 @@ should return non-nil if the topic is to be displayed." number) (while entries (when (numberp (setq number (car (pop entries)))) - (cl-incf total number))) + (incf total number))) total)) (defun gnus-group-topic (group) @@ -520,7 +520,7 @@ articles in the topic and its subtopics." 0 ;; Insert any sub-topics. (while topicl - (cl-incf unread + (incf unread (gnus-topic-prepare-topic (pop topicl) (1+ level) list-level predicate (not visiblep) lowest regexp))) @@ -574,7 +574,7 @@ articles in the topic and its subtopics." (car entry) (gnus-info-method info))))) (when (and (listp entry) (numberp (car entry))) - (cl-incf unread (car entry))) + (incf unread (car entry))) (when (listp entry) (setq tick t)))) (goto-char beg) @@ -752,10 +752,10 @@ articles in the topic and its subtopics." (cdr gnus-group-list-mode) nil t)) entry) (while children - (cl-incf unread (gnus-topic-unread (caar (pop children))))) + (incf unread (gnus-topic-unread (caar (pop children))))) (while (setq entry (pop entries)) (when (numberp (car entry)) - (cl-incf unread (car entry)))) + (incf unread (car entry)))) (gnus-topic-insert-topic-line topic t t (car (gnus-topic-find-topology topic)) nil unread all-groups))) @@ -799,10 +799,10 @@ articles in the topic and its subtopics." (if reads (setq unread (- (gnus-group-topic-unread) reads)) (while children - (cl-incf unread (gnus-topic-unread (caar (pop children))))) + (incf unread (gnus-topic-unread (caar (pop children))))) (while (setq entry (pop entries)) (when (numberp (car entry)) - (cl-incf unread (car entry))))) + (incf unread (car entry))))) (setq old-unread (gnus-group-topic-unread)) ;; Insert the topic line. (gnus-topic-insert-topic-line diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index bf745be0f6e..50739ef5efa 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -2058,7 +2058,7 @@ If no file has been included, the user will be asked for a file." (setq length (count-lines (point-min) (point-max))) (setq parts (/ length gnus-uu-post-length)) (unless (< (% length gnus-uu-post-length) 4) - (cl-incf parts))) + (incf parts))) (when gnus-uu-post-separate-description (forward-line -1)) @@ -2117,7 +2117,7 @@ If no file has been included, the user will be asked for a file." (insert-buffer-substring uubuf beg end) (insert beg-line "\n") (setq beg end) - (cl-incf i) + (incf i) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 8acda65ba0e..b008475f191 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -311,7 +311,7 @@ See the Gnus manual for an explanation of the syntax used.") ;; Select the frame in question and do more splits there. (select-frame frame) (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) - (cl-incf i)) + (incf i)) ;; Select the frame that has the selected buffer. (when fresult (select-frame (window-frame fresult))))) @@ -343,7 +343,7 @@ See the Gnus manual for an explanation of the syntax used.") ((eq type 'vertical) (setq s (max s window-min-height)))) (setcar (cdar comp-subs) s) - (cl-incf total s))) + (incf total s))) ;; Take care of the "1.0" spec. (if rest (setcar (cdr rest) (- len total)) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index eece03a62bc..954dce92e84 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -773,7 +773,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (when (and (file-regular-p file) (funcall predicate file) (mail-source-movemail file mail-source-crash-box)) - (cl-incf found (mail-source-callback callback file)) + (incf found (mail-source-callback callback file)) (mail-source-run-script postscript `((?t . ,path))) (mail-source-delete-crash-box))) found))) @@ -1029,7 +1029,7 @@ This only works when `display-time' is enabled." (insert "\001\001\001\001\n")) (delete-file file) nil)))) - (cl-incf found (mail-source-callback callback file)) + (incf found (mail-source-callback callback file)) (mail-source-delete-crash-box))))) found))) @@ -1104,7 +1104,7 @@ This only works when `display-time' is enabled." (replace-match ">From ")) (goto-char (point-max)))) (nnheader-ms-strip-cr)) - (cl-incf found (mail-source-callback callback server)) + (incf found (mail-source-callback callback server)) (mail-source-delete-crash-box) (when (and remove fetchflag) (setq remove (nreverse remove)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 67c92ef9978..cbb892f84cb 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2645,7 +2645,7 @@ Return the number of headers removed." (looking-at "[!-9;-~]+:")) (looking-at regexp)) (progn - (cl-incf number) + (incf number) (when first (setq last t)) (delete-region @@ -2670,7 +2670,7 @@ Return the number of headers removed." (save-excursion (goto-char (point-min)) (while (re-search-forward regexp nil t) - (cl-incf count))) + (incf count))) (while (> count 1) (message-remove-header header nil t) (decf count)))) @@ -3881,7 +3881,7 @@ text was killed." "Create a rot table with offset N." (let ((i -1) (table (make-string 256 0))) - (while (< (cl-incf i) 256) + (while (< (incf i) 256) (aset table i i)) (concat (substring table 0 ?A) diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index 863bad4db80..2ac336e800f 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -207,7 +207,7 @@ This is either `base64' or `quoted-printable'." (goto-char (point-min)) (skip-chars-forward "\x20-\x7f\r\n\t" limit) (while (< (point) limit) - (cl-incf n8bit) + (incf n8bit) (forward-char 1) (skip-chars-forward "\x20-\x7f\r\n\t" limit)) (if (or (< (* 6 n8bit) (- limit (point-min))) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 81f85c2fa09..201f64eb654 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -850,7 +850,7 @@ type detected." (defun mml-compute-boundary (cont) "Return a unique boundary that does not exist in CONT." (let ((mml-boundary (funcall mml-boundary-function - (cl-incf mml-multipart-number)))) + (incf mml-multipart-number)))) (unless mml-inhibit-compute-boundary ;; This function tries again and again until it has found ;; a unique boundary. @@ -870,7 +870,7 @@ type detected." (when (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (setq mml-boundary (funcall mml-boundary-function - (cl-incf mml-multipart-number))) + (incf mml-multipart-number))) (throw 'not-unique nil)))) ((eq (car cont) 'multipart) (mapc #'mml-compute-boundary-1 (cddr cont)))) diff --git a/lisp/gnus/nnatom.el b/lisp/gnus/nnatom.el index 7c8236b3547..281c3a1aeed 100644 --- a/lisp/gnus/nnatom.el +++ b/lisp/gnus/nnatom.el @@ -183,7 +183,7 @@ return the subject. Otherwise, return nil." (when-let* (((eq l 'content)) (src (dom-attr link 'src)) (label (concat "Link" - (and (< 1 (cl-incf alt)) + (and (< 1 (incf alt)) (format " %s" alt))))) `(((("text/plain") . ,(format "%s: %s\n" label src)) (("text/html") . ,(format "[%s] " @@ -192,7 +192,7 @@ return the subject. Otherwise, return nil." (name (nnatom--dom-line (dom-child-by-tag link 'name))) (name (if (string-blank-p name) (concat "Author" - (and (< 1 (cl-incf aut)) + (and (< 1 (incf aut)) (format " %s" aut))) name)) (uri (nnatom--dom-line (dom-child-by-tag link 'uri))) @@ -206,26 +206,26 @@ return the subject. Otherwise, return nil." (pcase (cdr (assq 'rel attrs)) ("related" (concat "Related" - (and (< 1 (cl-incf rel)) + (and (< 1 (incf rel)) (format " %s" rel)))) ("self" (concat "More" - (and (< 1 (cl-incf sel)) + (and (< 1 (incf sel)) (format " %s" sel)))) ("enclosure" (concat "Enclosure" - (and (< 1 (cl-incf enc)) + (and (< 1 (incf enc)) (format " %s" enc)))) ("via" (concat "Source" - (and (< 1 (cl-incf via)) + (and (< 1 (incf via)) (format " %s" via)))) (_ (if-let* ((lang (cdr (assq 'hreflang link)))) (format "Link (%s)" lang) (concat "Link" - (and (< 1 (cl-incf alt)) + (and (< 1 (incf alt)) (format " %s" alt)))))))) (link (cdr (assq 'href attrs)))) `(((("text/plain") . ,(format "%s: %s\n" label link)) diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index b5e364b0b4b..be58fac1a8c 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -101,7 +101,7 @@ (insert ".\n")) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) - (zerop (% (cl-incf count) 20)) + (zerop (% (incf count) 20)) (nnheader-message 5 "nnbabyl: Receiving headers... %d%%" (floor (* count 100.0) number)))) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 9647b4dcc17..a430d17caa2 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -786,7 +786,7 @@ from the document.") (setq blk (nndoc-oe-dbx-decode-block))) (while (and blk (> (car blk) 0) (or (zerop (nth 3 blk)) (> (nth 3 blk) p))) - (push (list (cl-incf i) p nil nil nil 0) nndoc-dissection-alist) + (push (list (incf i) p nil nil nil 0) nndoc-dissection-alist) (while (and (> (car blk) 0) (> (nth 3 blk) p)) (goto-char (1+ (nth 3 blk))) (setq blk (nndoc-oe-dbx-decode-block))) @@ -925,7 +925,7 @@ from the document.") (and (re-search-backward nndoc-file-end nil t) (beginning-of-line))))) (setq body-end (point)) - (push (list (cl-incf i) head-begin head-end body-begin body-end + (push (list (incf i) head-begin head-end body-begin body-end (count-lines body-begin body-end)) nndoc-dissection-alist))))) (setq nndoc-dissection-alist (nreverse nndoc-dissection-alist)))) @@ -1038,7 +1038,7 @@ PARENT is the message-ID of the parent summary line, or nil for none." (replace-match line t t summary-insert) (concat summary-insert line))))) ;; Generate dissection information for this entity. - (push (list (cl-incf nndoc-mime-split-ordinal) + (push (list (incf nndoc-mime-split-ordinal) head-begin head-end body-begin body-end (count-lines body-begin body-end) article-insert summary-insert) @@ -1076,7 +1076,7 @@ PARENT is the message-ID of the parent summary line, or nil for none." part-begin part-end article-insert (concat position (and position ".") - (format "%d" (cl-incf part-counter))) + (format "%d" (incf part-counter))) message-id))))))))) ;;;###autoload diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 1123dcb7455..f3a320ab987 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -102,7 +102,7 @@ included.") (nneething-insert-head file) (insert ".\n")) - (cl-incf count) + (incf count) (and large (zerop (% count 20)) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index b1758bd058f..ffa7be8d2ad 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -173,7 +173,7 @@ on your system, you could say something like: (format "fake+none+%s+%d" gnus-newsgroup-name number) (format "fake+none+%s+%s" gnus-newsgroup-name - (int-to-string (cl-incf nnheader-fake-message-id))))) + (int-to-string (incf nnheader-fake-message-id))))) (defsubst nnheader-fake-message-id-p (id) (save-match-data ; regular message-id's are <.*> @@ -601,7 +601,7 @@ the line could be found." (while (and (eq nnheader-head-chop-length (nth 1 (mm-insert-file-contents file nil beg - (cl-incf beg nnheader-head-chop-length)))) + (incf beg nnheader-head-chop-length)))) ;; CRLF or CR might be used for the line-break code. (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t)) (goto-char (point-max))) @@ -773,7 +773,7 @@ If FULL, translate everything." (when (setq trans (cdr (assq (aref leaf i) nnheader-file-name-translation-alist))) (aset leaf i trans)) - (cl-incf i)) + (incf i)) (concat path leaf)))) (defun nnheader-report (backend &rest args) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 4965e66503a..30f0a4b6a62 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -894,7 +894,7 @@ during splitting, which may be slow." (equal id "1") (string-match nnimap-fetch-partial-articles type)) (push id parts)))) - (cl-incf num))) + (incf num))) (nreverse parts))) (deffoo nnimap-request-group (group &optional server dont-check info) @@ -1521,7 +1521,7 @@ If LIMIT, first try to limit the search to the N last articles." (if (and active uidvalidity unexist) ;; Fetch the last 100 flags. (setq start (max 1 (- (cdr active) 100))) - (cl-incf (nnimap-initial-resync nnimap-object)) + (incf (nnimap-initial-resync nnimap-object)) (setq start 1)) (push (list (nnimap-send-command "%s %S" command (nnimap-group-to-imap group)) @@ -1964,7 +1964,7 @@ Return the server's response to the SELECT or EXAMINE command." (get-buffer-process (current-buffer)) (nnimap-log-command (format "%d %s%s\n" - (cl-incf nnimap-sequence) + (incf nnimap-sequence) (apply #'format args) (if (nnimap-newlinep nnimap-object) "" diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index e580d7aebba..8b6dd1cc6b3 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -790,7 +790,7 @@ If SOURCE is a directory spec, try to return the group name component." (narrow-to-region start (point)) (goto-char (point-min)) (nnmail-check-duplication message-id func artnum-func) - (cl-incf count) + (incf count) (setq end (point-max)))) (goto-char end)) count)) @@ -936,7 +936,7 @@ If SOURCE is a directory spec, try to return the group name component." (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) - (cl-incf count) + (incf count) (nnmail-check-duplication message-id func artnum-func) (setq end (point-max)))) (goto-char end))) @@ -989,7 +989,7 @@ If SOURCE is a directory spec, try to return the group name component." (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) - (cl-incf count) + (incf count) (nnmail-check-duplication message-id func artnum-func junk-func) (setq end (point-max)))) (goto-char end) @@ -1848,8 +1848,8 @@ be called once per group or once for all groups." ((error quit) (message "Mail source %s failed: %s" source cond) 0))) - (cl-incf total new) - (cl-incf i))) + (incf total new) + (incf i))) ;; If we did indeed read any incoming spools, we save all info. (if (zerop total) (when mail-source-plugged diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 3fb87f3a712..652b0804add 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -841,7 +841,7 @@ This variable is set by `nnmaildir-request-article'.") ;; then look in marks directories (not (file-exists-p (concat cdir prefix))) (file-exists-p (concat ndir prefix))) - (cl-incf num))))) + (incf num))))) (setf (nnmaildir--grp-cache group) (make-vector num nil)) (let ((inhibit-quit t)) (puthash gname group groups)) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index a494daeaa97..e166fa8424f 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -682,7 +682,7 @@ which RSS 2.0 allows." (setq enclosure (list url name len type)))) (push (list - (cl-incf nnrss-group-max) + (incf nnrss-group-max) (current-time) url (and subject (nnrss-mime-encode-string subject)) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index eb9fd47dc0d..c2d99f8496d 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -736,7 +736,7 @@ group info." (push (1+ seq) old-arts) (setq gnus-newsgroup-selection (vconcat gnus-newsgroup-selection (vector article))) - (cl-incf last))) + (incf last))) (gnus-search-run-query (list (cons 'search-query-spec query-spec) (cons 'search-group-spec group-spec)))) diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 3e6e7382994..4a9e1314a51 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -171,7 +171,7 @@ there.") (delete-region (point) (point-max))) (and do-message - (zerop (% (cl-incf count) 20)) + (zerop (% (incf count) 20)) (nnheader-message 5 "nnspool: Receiving headers... %d%%" (floor (* count 100.0) number)))) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index a086421b049..cc68291868c 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -682,7 +682,7 @@ command whose response triggered the error." ;; `articles' is either a list of article numbers ;; or a list of article IDs. article)) - (cl-incf count) + (incf count) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. (when (or (null articles) ;All requests have been sent. @@ -694,7 +694,7 @@ command whose response triggered the error." ;; Count replies. (while (nntp-next-result-arrived-p) (setq last-point (point)) - (cl-incf received)) + (incf received)) (< received count)) ;; If number of headers is greater than 100, give ;; informative messages. @@ -767,7 +767,7 @@ command whose response triggered the error." "^[.]" "^[0-9]") nil t) - (cl-incf received)) + (incf received)) (setq last-point (point)) (< received count))) (nntp-accept-response)) @@ -832,7 +832,7 @@ command whose response triggered the error." (throw 'done nil)) ;; Send the command to the server. (nntp-send-command nil command (pop groups)) - (cl-incf count) + (incf count) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. (when (or (null groups) ;All requests have been sent. @@ -846,7 +846,7 @@ command whose response triggered the error." (goto-char last-point) ;; Count replies. (while (re-search-forward "^[0-9]" nil t) - (cl-incf received)) + (incf received)) (setq last-point (point)) (< received count))) (nntp-accept-response)))) @@ -918,7 +918,7 @@ command whose response triggered the error." ;; `articles' is either a list of article numbers ;; or a list of article IDs. article)) - (cl-incf count) + (incf count) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. (when (or (null articles) ;All requests have been sent. @@ -931,7 +931,7 @@ command whose response triggered the error." (while (nntp-next-result-arrived-p) (aset map received (cons (aref map received) (point))) (setq last-point (point)) - (cl-incf received)) + (incf received)) (< received count)) ;; If number of headers is greater than 100, give ;; informative messages. @@ -1544,7 +1544,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the ;; Count replies. (while (re-search-forward "^\$[0-9][0-9][0-9]\$ .*\n" nil t) - (cl-incf received) + (incf received) (setq status (match-string 1)) (if (string-match "^[45]" status) (setq status 'error) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index f2cbdd85652..c45c8d756e2 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -778,13 +778,13 @@ based on the marks on the component groups." ;; We need to convert the unreads to reads. We compress the ;; sequence as we go, otherwise it could be huge. - (while (and (<= (cl-incf i) nnvirtual-mapping-len) + (while (and (<= (incf i) nnvirtual-mapping-len) unreads) (if (= i (car unreads)) (setq unreads (cdr unreads)) ;; try to get a range. (setq beg i) - (while (and (<= (cl-incf i) nnvirtual-mapping-len) + (while (and (<= (incf i) nnvirtual-mapping-len) (not (= i (car unreads))))) (setq i (- i 1)) (if (= i beg) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 9ada2dbc1d7..db460181d20 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -357,11 +357,11 @@ The only valid type is currently `google'.") (current-time-string))) (setq From (match-string 4))) (widen) - (cl-incf i) + (incf i) (unless (nnweb-get-hashtb url) (push (list - (cl-incf (cdr active)) + (incf (cdr active)) (make-full-mail-header (cdr active) (if Newsgroups (concat "(" Newsgroups ") " Subject) @@ -393,7 +393,7 @@ The only valid type is currently `google'.") (nconc nnweb-articles (nnweb-google-parse-1))) ;; Check if there are more articles to fetch (goto-char (point-min)) - (cl-incf i 100) + (incf i 100) (if (or (not (re-search-forward "]+href=\"\n?\$[^>\" \n\t]+\$[^<]*]+src=[^>]+next" nil t)) @@ -473,7 +473,7 @@ The only valid type is currently `google'.") (rfc2047-encode-string subject)) (unless (nnweb-get-hashtb (mail-header-xref header)) - (setf (mail-header-number header) (cl-incf (cdr active))) + (setf (mail-header-number header) (incf (cdr active))) (push (list (mail-header-number header) header) map) (nnweb-set-hashtb (cadar map) (car map)))))) (forward-line 1))) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 5c25df049e3..983e82cb028 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -1750,7 +1750,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; eliminate duplicates (dolist (article (copy-sequence ulist)) (when (memq article rlist) - (cl-incf delcount) + (incf delcount) (setq rlist (delq article rlist)) (setq ulist (delq article ulist)))) commit d84dbcb4504f6c53968a9f245b31676c90921b38 Author: Stefan Monnier Date: Sun Feb 23 00:29:49 2025 -0500 (Ftranspose_regions): Fix text-properties for len1==len2 When `len1_byte == len2_byte`, the code presumed that len1==len2 as well in its handling of text-properties. Fix that case. While at it, try and reduce code duplication by hoisting common code out of `if`s, and throw away the optimization for `len_mid == 0` which only saved 3 trivial function calls. * src/editfns.c (Ftranspose_regions): Shuffle the code a bit. * test/src/editfns-tests.el (editfns-tests--transpose-equal-but-not): New test. diff --git a/src/editfns.c b/src/editfns.c index 8fe2ecf1a03..3dff49fb00c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4423,7 +4423,7 @@ ring. */) ptrdiff_t gap, len1, len_mid, len2; unsigned char *start1_addr, *start2_addr, *temp; - INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3; + INTERVAL cur_intv, tmp_interval1, tmp_interval2, tmp_interval3; Lisp_Object buf; XSETBUFFER (buf, current_buffer); @@ -4494,7 +4494,8 @@ ring. */) } start2_byte = CHAR_TO_BYTE (start2); - len1_byte = CHAR_TO_BYTE (end1) - start1_byte; + ptrdiff_t end1_byte = CHAR_TO_BYTE (end1); + len1_byte = end1_byte - start1_byte; len2_byte = end2_byte - start2_byte; #ifdef BYTE_COMBINING_DEBUG @@ -4526,168 +4527,87 @@ ring. */) enough to use as the temporary storage? That would avoid an allocation... interesting. Later, don't fool with it now. */ - if (end1 == start2) /* adjacent regions */ + modify_text (start1, end2); + tmp_interval1 = copy_intervals (cur_intv, start1, len1); + tmp_interval2 = copy_intervals (cur_intv, start2, len2); + USE_SAFE_ALLOCA; + if (len1_byte == len2_byte && len1 == len2) + /* Regions are same size, though, how nice. */ + /* The char lengths also have to match, for text-properties. */ { - modify_text (start1, end2); - record_change (start1, len1 + len2); + if (end1 == start2) /* Merge the two parts into a single one. */ + record_change (start1, (end2 - start1)); + else + { + record_change (start1, len1); + record_change (start2, len2); + } - tmp_interval1 = copy_intervals (cur_intv, start1, len1); - tmp_interval2 = copy_intervals (cur_intv, start2, len2); - /* Don't use Fset_text_properties: that can cause GC, which can - clobber objects stored in the tmp_intervals. */ - tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); + tmp_interval3 = validate_interval_range (buf, &startr1, &endr1, 0); if (tmp_interval3) - set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); - - USE_SAFE_ALLOCA; + set_text_properties_1 (startr1, endr1, Qnil, buf, tmp_interval3); - /* First region smaller than second. */ - if (len1_byte < len2_byte) - { - temp = SAFE_ALLOCA (len2_byte); - - /* Don't precompute these addresses. We have to compute them - at the last minute, because the relocating allocator might - have moved the buffer around during the xmalloc. */ - start1_addr = BYTE_POS_ADDR (start1_byte); - start2_addr = BYTE_POS_ADDR (start2_byte); - - memcpy (temp, start2_addr, len2_byte); - memcpy (start1_addr + len2_byte, start1_addr, len1_byte); - memcpy (start1_addr, temp, len2_byte); - } - else - /* First region not smaller than second. */ - { - temp = SAFE_ALLOCA (len1_byte); - start1_addr = BYTE_POS_ADDR (start1_byte); - start2_addr = BYTE_POS_ADDR (start2_byte); - memcpy (temp, start1_addr, len1_byte); - memcpy (start1_addr, start2_addr, len2_byte); - memcpy (start1_addr + len2_byte, temp, len1_byte); - } - - SAFE_FREE (); - graft_intervals_into_buffer (tmp_interval1, start1 + len2, - len1, current_buffer, 0); - graft_intervals_into_buffer (tmp_interval2, start1, - len2, current_buffer, 0); - update_compositions (start1, start1 + len2, CHECK_BORDER); - update_compositions (start1 + len2, end2, CHECK_TAIL); + tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0); + if (tmp_interval3) + set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3); + + temp = SAFE_ALLOCA (len1_byte); + start1_addr = BYTE_POS_ADDR (start1_byte); + start2_addr = BYTE_POS_ADDR (start2_byte); + memcpy (temp, start1_addr, len1_byte); + memcpy (start1_addr, start2_addr, len2_byte); + memcpy (start2_addr, temp, len1_byte); } - /* Non-adjacent regions, because end1 != start2, bleagh... */ else { - len_mid = start2_byte - (start1_byte + len1_byte); - - if (len1_byte == len2_byte) - /* Regions are same size, though, how nice. */ - { - USE_SAFE_ALLOCA; - - modify_text (start1, end2); - record_change (start1, len1); - record_change (start2, len2); - tmp_interval1 = copy_intervals (cur_intv, start1, len1); - tmp_interval2 = copy_intervals (cur_intv, start2, len2); - - tmp_interval3 = validate_interval_range (buf, &startr1, &endr1, 0); - if (tmp_interval3) - set_text_properties_1 (startr1, endr1, Qnil, buf, tmp_interval3); - - tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0); - if (tmp_interval3) - set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3); - - temp = SAFE_ALLOCA (len1_byte); - start1_addr = BYTE_POS_ADDR (start1_byte); - start2_addr = BYTE_POS_ADDR (start2_byte); - memcpy (temp, start1_addr, len1_byte); - memcpy (start1_addr, start2_addr, len2_byte); - memcpy (start2_addr, temp, len1_byte); - SAFE_FREE (); - - graft_intervals_into_buffer (tmp_interval1, start2, - len1, current_buffer, 0); - graft_intervals_into_buffer (tmp_interval2, start1, - len2, current_buffer, 0); - } - - else if (len1_byte < len2_byte) /* Second region larger than first */ - /* Non-adjacent & unequal size, area between must also be shifted. */ - { - USE_SAFE_ALLOCA; - - modify_text (start1, end2); - record_change (start1, (end2 - start1)); - tmp_interval1 = copy_intervals (cur_intv, start1, len1); - tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); - tmp_interval2 = copy_intervals (cur_intv, start2, len2); - - tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); - if (tmp_interval3) - set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); - + len_mid = start2_byte - end1_byte; + record_change (start1, (end2 - start1)); + INTERVAL tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); + tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); + if (tmp_interval3) + set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); + if (len1_byte < len2_byte) /* Second region larger than first */ + { /* holds region 2 */ temp = SAFE_ALLOCA (len2_byte); start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); - memcpy (temp, start2_addr, len2_byte); - memcpy (start1_addr + len_mid + len2_byte, start1_addr, len1_byte); - memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid); - memcpy (start1_addr, temp, len2_byte); - SAFE_FREE (); - - graft_intervals_into_buffer (tmp_interval1, end2 - len1, - len1, current_buffer, 0); - graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, - len_mid, current_buffer, 0); - graft_intervals_into_buffer (tmp_interval2, start1, - len2, current_buffer, 0); - } + memcpy (temp, start2_addr, len2_byte); + memcpy (start1_addr + len_mid + len2_byte, start1_addr, len1_byte); + memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid); + memcpy (start1_addr, temp, len2_byte); + } else /* Second region smaller than first. */ - { - USE_SAFE_ALLOCA; - - record_change (start1, (end2 - start1)); - modify_text (start1, end2); - - tmp_interval1 = copy_intervals (cur_intv, start1, len1); - tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); - tmp_interval2 = copy_intervals (cur_intv, start2, len2); - - tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); - if (tmp_interval3) - set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); - + { /* holds region 1 */ temp = SAFE_ALLOCA (len1_byte); start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); - memcpy (temp, start1_addr, len1_byte); - memcpy (start1_addr, start2_addr, len2_byte); - memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid); - memcpy (start1_addr + len2_byte + len_mid, temp, len1_byte); - SAFE_FREE (); - - graft_intervals_into_buffer (tmp_interval1, end2 - len1, - len1, current_buffer, 0); - graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, - len_mid, current_buffer, 0); - graft_intervals_into_buffer (tmp_interval2, start1, - len2, current_buffer, 0); - } - - update_compositions (start1, start1 + len2, CHECK_BORDER); - update_compositions (end2 - len1, end2, CHECK_BORDER); + memcpy (temp, start1_addr, len1_byte); + memcpy (start1_addr, start2_addr, len2_byte); + memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid); + memcpy (start1_addr + len2_byte + len_mid, temp, len1_byte); + } + graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, + len_mid, current_buffer, 0); } + SAFE_FREE (); + graft_intervals_into_buffer (tmp_interval1, end2 - len1, + len1, current_buffer, 0); + graft_intervals_into_buffer (tmp_interval2, start1, + len2, current_buffer, 0); + + update_compositions (start1, start1 + len2, CHECK_BORDER); + update_compositions (end2 - len1, end2, CHECK_BORDER); /* When doing multiple transpositions, it might be nice to optimize this. Perhaps the markers in any one buffer should be organized in some sorted data tree. */ if (NILP (leave_markers)) { + /* FIXME: Since the undo info doesn't record the transposition as its own + operation, we won't enjoy 'transpose_markers' during undo :-( */ transpose_markers (start1, end1, start2, end2, start1_byte, start1_byte + len1_byte, start2_byte, start2_byte + len2_byte); diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 8d4e7bc48fa..29b7a850838 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -175,6 +175,21 @@ (should (string= (buffer-string) "éä\"ba÷")) (should (equal (transpose-test-get-byte-positions 7) '(1 3 5 6 7 8 10))))) +(ert-deftest editfns-tests--transpose-equal-but-not () + (with-temp-buffer + (let ((str1 (propertize "ab" 'my-prop 'ab)) + (str2 (propertize "SPC" 'my-prop 'SPC)) + (str3 (propertize "é" 'my-prop 'é))) + (insert " " str1 str2 str3 " ") + (transpose-regions (+ (point-min) 1) (+ (point-min) 3) + (+ (point-min) 6) (+ (point-min) 7)) + (should (equal-including-properties + str3 (buffer-substring (+ (point-min) 1) (+ (point-min) 2)))) + (should (equal-including-properties + str2 (buffer-substring (+ (point-min) 2) (+ (point-min) 5)))) + (should (equal-including-properties + str1 (buffer-substring (+ (point-min) 5) (+ (point-min) 7))))))) + (ert-deftest format-c-float () (should-error (format "%c" 0.5))) commit 7972a3448d53c515b074e6681fe3a369ada642d6 Author: Stefan Kangas Date: Sun Feb 23 04:43:04 2025 +0100 Mark cdl.el as obsolete * lisp/obsolete/cdl.el: Add Obsolete-since header. It is fully replaceable by shell-command and shell-command-on-region. diff --git a/etc/NEWS b/etc/NEWS index ccde4ed4b70..4a89b9abe6f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1292,6 +1292,10 @@ change the selection rules. ** Miscellaneous +--- +*** cdl.el is now obsolete. +Use 'shell-command' and 'shell-command-on-region' instead. + --- *** kermit.el is now obsolete. diff --git a/lisp/obsolete/cdl.el b/lisp/obsolete/cdl.el index 2ae76a908e4..d51ab9f6813 100644 --- a/lisp/obsolete/cdl.el +++ b/lisp/obsolete/cdl.el @@ -5,6 +5,7 @@ ;; Author: Ata Etemadi ;; Maintainer: emacs-devel@gnu.org ;; Keywords: data +;; Obsolete-since: 31.1 ;; This file is part of GNU Emacs. @@ -23,6 +24,10 @@ ;;; Commentary: +;; This library is obsolete. +;; +;; Use `shell-command' and `shell-command-on-region' instead. + ;;; Code: (defun cdl-get-file (filename) commit 827694ff282e2b1b09b277a964db7b3fba776233 Author: Stefan Kangas Date: Sun Feb 23 14:55:40 2025 +0100 Move cdl.el to obsolete/cdl.el * lisp/cdl.el: Move from here... * lisp/obsolete/cdl.el: ...to here. diff --git a/lisp/cdl.el b/lisp/obsolete/cdl.el similarity index 100% rename from lisp/cdl.el rename to lisp/obsolete/cdl.el commit 93f62f10f7b28e0ceeb1464d918746fe2b2beae1 Author: Manuel Giraud Date: Fri Jul 26 17:37:02 2024 +0200 Fix DocView's text conversion on tty Emacs * lisp/doc-view.el (doc-view-open-text): Defaults to first page should `doc-view-current-page' return nil. (Bug#72305) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 98522f35765..2fdcc111cab 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1798,7 +1798,7 @@ For now these keys are useful: (if doc-view--current-converter-processes (message "DocView: please wait till conversion finished.") (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir))) - (page (doc-view-current-page))) + (page (or (doc-view-current-page) 1))) (if (file-readable-p txt) (let ((dv-bfn doc-view--buffer-file-name) (dv-text-buffer-name (format "%s/text" (buffer-name)))) commit 71a4670a9fa238f920ce88b938f703b605ad2f48 Author: Joseph Turner Date: Sun Oct 13 01:10:02 2024 +0200 Upgrade out-of-date VC package dependencies * lisp/emacs-lisp/package-vc.el (package-vc-install-dependencies): Pass the specified package version when checking if a package is installed. (Bug#73781) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 7455bfba69e..daceb4eb9c0 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -417,7 +417,7 @@ this function successfully installs all given dependencies)." "Attempt to find all dependencies for PKG." (cond ((assq (car pkg) to-install)) ;inhibit cycles - ((package-installed-p (car pkg))) + ((package-installed-p (car pkg) (cadr pkg))) ((let* ((pac package-archive-contents) (desc (cadr (assoc (car pkg) pac)))) (if desc commit 70b15c5174e147c25f4cf71f7c94ee72a8839393 Author: Eli Zaretskii Date: Sun Feb 23 12:25:14 2025 +0200 ; Fix last change * src/frame.c (syms_of_frame) : * doc/lispref/frames.texi (Implied Frame Resizing): Don't use passive voice. (Bug#76275) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index c6870f3ff28..8afb2c75ff2 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1249,16 +1249,16 @@ resizing with the following option: If this option is @code{nil}, changing a frame's font, menu bar, tool bar, internal borders, fringes or scroll bars may resize its outer frame in order to keep the number of columns or lines of its text area -unaltered. If this option is @code{t}, no such resizing is done once a -frame has obtained its initial size. If this is the symbol -@code{force}, no implicit resizing is done whenever a new frame is made. +unaltered. If this option is @code{t}, no such resizing happens once a +frame has obtained its initial size. If the value is the symbol +@code{force}, no implicit resizing happens whenever a new frame is made. The latter can be useful with tiling window managers where the initial size of a frame is determined by external means. The value of this option can be also a list of frame parameters. In -that case, implied resizing is inhibited for the change of a parameter -that appears in this list. Parameters currently handled by this -option are @code{font}, @code{font-backend}, +that case, implied resizing is inhibited for the change of the +parameters that appear in this list. Parameters currently handled by +this option are @code{font}, @code{font-backend}, @code{internal-border-width}, @code{menu-bar-lines} and @code{tool-bar-lines}. diff --git a/src/frame.c b/src/frame.c index 7815655cb21..29f1f6ea208 100644 --- a/src/frame.c +++ b/src/frame.c @@ -7113,9 +7113,9 @@ a non-nil value in your init file. */); If this option is nil, setting font, menu bar, tool bar, tab bar, internal borders, fringes or scroll bars of a specific frame may resize the frame in order to preserve the number of columns or lines it -displays. If this option is t, no such resizing is done once a frame +displays. If this option is t, no such resizing happens once a frame has got its initial size. If this is the symbol `force', no implicit -resizing is done whenever a new frame is made. This can be useful with +resizing happens whenever a new frame is made. This can be useful with tiling window managers where the initial size of a frame is determined by external means. commit 499da9e1a9f63d9a767a3cab1f7771799e1d3274 Author: Martin Rudalics Date: Sun Feb 23 11:01:20 2025 +0100 Optionally inhibit implied resizing while frame is made (Bug#76275) * src/frame.c (frame_inhibit_resize): Handle new value 'force' for 'frame-inhibit-implied-resize' (Bug#76275). (frame_inhibit_implied_resize): New value 'force' to inhibit implied resizing while a new frame is made. * lisp/cus-start.el (frame-inhibit-implied-resize): Make new value 'force' customizable. * doc/lispref/frames.texi (Implied Frame Resizing): Describe new value 'force' of 'frame-inhibit-implied-resize'. * etc/NEWS: Announce new value 'force' of 'frame-inhibit-implied-resize'. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 984f9bb597d..c6870f3ff28 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1247,9 +1247,13 @@ resizing with the following option: @defopt frame-inhibit-implied-resize If this option is @code{nil}, changing a frame's font, menu bar, tool -bar, internal borders, fringes or scroll bars may resize its outer -frame in order to keep the number of columns or lines of its text area -unaltered. If this option is @code{t}, no such resizing is done. +bar, internal borders, fringes or scroll bars may resize its outer frame +in order to keep the number of columns or lines of its text area +unaltered. If this option is @code{t}, no such resizing is done once a +frame has obtained its initial size. If this is the symbol +@code{force}, no implicit resizing is done whenever a new frame is made. +The latter can be useful with tiling window managers where the initial +size of a frame is determined by external means. The value of this option can be also a list of frame parameters. In that case, implied resizing is inhibited for the change of a parameter diff --git a/etc/NEWS b/etc/NEWS index ef12f84c7ff..ccde4ed4b70 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -254,6 +254,12 @@ behavior to try to split vertically first. Calling this function before 'delete-frame' is useful to avoid that the latter throws an error when the argument FRAME cannot be deleted. ++++ +*** New value 'force' for option `frame-inhibit-implied-resize'. +This will inhibit implied resizing while a new frame is made and can be +useful on tiling window managers where the initial frame size should be +specified by external means. + ** Tab Bars and Tab Lines --- diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 5d35edd212b..c6e4da6790e 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -347,8 +347,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (choice (const :tag "Never" nil) (const :tag "Always" t) + (const :tag "Force" force) (repeat (symbol :tag "Parameter"))) - "27.1") + "31.1") (iconify-child-frame frames (choice (const :tag "Do nothing" nil) diff --git a/src/frame.c b/src/frame.c index 440d0cbe294..7815655cb21 100644 --- a/src/frame.c +++ b/src/frame.c @@ -172,27 +172,34 @@ get_frame_param (struct frame *frame, Lisp_Object prop) } -/* Return 1 if `frame-inhibit-implied-resize' is non-nil or fullscreen - state of frame F would be affected by a vertical (horizontal if - HORIZONTAL is true) resize. PARAMETER is the symbol of the frame - parameter that is changed. */ +/* Return true if 'frame-inhibit-implied-resize' is non-nil or + fullscreen state of frame F would be affected by a vertical + (horizontal if HORIZONTAL is true) resize. PARAMETER is the symbol + of the frame parameter about to be changed. + + If 'frame-inhibit-implied-resize' equals 'force', unconditionally + return true (Bug#76275). Otherwise, return nil if F has not been + made yet and (on GTK) its tool bar has not been resized at least + once. Together these should ensure that F always gets its requested + initial size. */ bool frame_inhibit_resize (struct frame *f, bool horizontal, Lisp_Object parameter) { Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); - return (f->after_make_frame + return (EQ (frame_inhibit_implied_resize, Qforce) + || (f->after_make_frame #ifdef USE_GTK - && f->tool_bar_resized + && f->tool_bar_resized #endif - && (EQ (frame_inhibit_implied_resize, Qt) - || (CONSP (frame_inhibit_implied_resize) - && !NILP (Fmemq (parameter, frame_inhibit_implied_resize))) - || (horizontal - && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) - || (!horizontal - && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) - || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))); + && (EQ (frame_inhibit_implied_resize, Qt) + || (CONSP (frame_inhibit_implied_resize) + && !NILP (Fmemq (parameter, frame_inhibit_implied_resize))) + || (horizontal + && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) + || (!horizontal + && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) + || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)))); } @@ -6849,6 +6856,7 @@ syms_of_frame (void) DEFSYM (Qmake_invisible, "make-invisible"); DEFSYM (Quse_frame_synchronization, "use-frame-synchronization"); DEFSYM (Qfont_parameter, "font-parameter"); + DEFSYM (Qforce, "force"); for (int i = 0; i < ARRAYELTS (frame_parms); i++) { @@ -7102,12 +7110,14 @@ a non-nil value in your init file. */); DEFVAR_LISP ("frame-inhibit-implied-resize", frame_inhibit_implied_resize, doc: /* Whether frames should be resized implicitly. -If this option is nil, setting font, menu bar, tool bar, tab bar, internal -borders, fringes or scroll bars of a specific frame may resize the frame -in order to preserve the number of columns or lines it displays. If -this option is t, no such resizing is done. Note that the size of -fullscreen and maximized frames, the height of fullheight frames and the -width of fullwidth frames never change implicitly. +If this option is nil, setting font, menu bar, tool bar, tab bar, +internal borders, fringes or scroll bars of a specific frame may resize +the frame in order to preserve the number of columns or lines it +displays. If this option is t, no such resizing is done once a frame +has got its initial size. If this is the symbol `force', no implicit +resizing is done whenever a new frame is made. This can be useful with +tiling window managers where the initial size of a frame is determined +by external means. The value of this option can be also a list of frame parameters. In this case, resizing is inhibited when changing a parameter that @@ -7132,9 +7142,11 @@ adding/removing a tool bar or tab bar does not change the frame height. Otherwise it's t which means the frame size never changes implicitly when there's no window system support. -Note that when a frame is not large enough to accommodate a change of -any of the parameters listed above, Emacs may try to enlarge the frame -even if this option is non-nil. */); +Note that the size of fullscreen and maximized frames, the height of +fullheight frames and the width of fullwidth frames never change +implicitly. Note also that when a frame is not large enough to +accommodate a change of any of the parameters listed above, Emacs may +try to enlarge the frame even if this option is non-nil. */); #if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_ANDROID) #if defined (USE_GTK) || defined (HAVE_NS) frame_inhibit_implied_resize = list1 (Qtab_bar_lines); commit 4f89aa3d8285e0d94c8203be60b134a83abf82f7 Merge: 949739571ba 2a756ce9d77 Author: Michael Albinus Date: Sun Feb 23 10:48:28 2025 +0100 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 949739571ba48bcece296d805668de71b2481e82 Author: Michael Albinus Date: Sun Feb 23 10:47:58 2025 +0100 Tramp: Improve doc of ad-hoc multi-hop file names * doc/misc/tramp.texi (Ad-hoc multi-hops, Frequently Asked Questions): Improve description how ad-hoc multi-hop file names can be made persistent. (Bug#65039, Bug#76457) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ac6ae94f060..1eed1acd964 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3371,8 +3371,8 @@ Another option is to create better backup file naming with user and host names prefixed to the file name. For example, transforming @file{/etc/secretfile} to @file{~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile}, set the -@value{tramp} user option @code{tramp-backup-directory-alist} from -the existing user option @code{backup-directory-alist}. +@value{tramp} user option @code{tramp-backup-directory-alist} from the +existing user option @code{backup-directory-alist}. Then @value{tramp} backs up to a file name that is transformed with a prefix consisting of the DIRECTORY name. This file name prefixing @@ -3394,10 +3394,12 @@ Example: The backup file name of @file{@trampfn{su,root@@localhost,/etc/secretfile}} would be @ifset unified -@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~}}. +@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/@c +!su:root@@localhost:!etc!secretfile~}}. @end ifset @ifset separate -@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~}}. +@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/@c +![su!root@@localhost]!etc!secretfile~}}. @end ifset @vindex auto-save-file-name-transforms @@ -3847,15 +3849,21 @@ ssh@value{postfixhop}you@@remotehost@value{postfix}/path @key{RET}} Each involved method must be an inline method (@pxref{Inline methods}). -@value{tramp} adds the ad-hoc definitions on the fly to -@code{tramp-default-proxies-alist} and is available for reuse during -that Emacs session. Subsequent @value{tramp} connections to the same -remote host can then use the shortcut form: -@samp{@trampfn{ssh,you@@remotehost,/path}}. +@value{tramp} adds the ad-hoc definitions as an ephemeral record to +@code{tramp-default-proxies-alist}, which are available for reuse +during that Emacs session. Subsequent @value{tramp} connections to +the same remote host can then use the abbreviated form +@file{@trampfn{ssh,you@@remotehost,/path}}. +@anchor{tramp-show-ad-hoc-proxies} @defopt tramp-show-ad-hoc-proxies If this user option is non-@code{nil}, ad-hoc definitions are kept in -remote file names instead of showing the shortcuts. +remote file names instead of showing the abbreviations. This is +useful if the ad-hoc proxy definition shall be used in further Emacs +sessions, kept in configuration files of recentf and other packages. + +A non-@code{nil} setting of this option has effect only if set before +the connection is established. @lisp (customize-set-variable 'tramp-show-ad-hoc-proxies t) @@ -3866,10 +3874,18 @@ Ad-hoc definitions are removed from @code{tramp-default-proxies-alist} via the command @kbd{M-x tramp-cleanup-all-connections @key{RET}} (@pxref{Cleanup remote connections}). +@anchor{tramp-save-ad-hoc-proxies} @defopt tramp-save-ad-hoc-proxies For ad-hoc definitions to be saved automatically in @code{tramp-default-proxies-alist} for future Emacs sessions, set -@code{tramp-save-ad-hoc-proxies} to non-@code{nil}. +@code{tramp-save-ad-hoc-proxies} to non-@code{nil}. The resulting +user option @code{tramp-default-proxies-alist} is saved in your +@file{.emacs} file. + +If you use saved configuration files with abbreviated ad-hoc proxy +definitions on another host, for example by distribution of the +@code{recentf-save-file}, you must distribute your @file{.emacs} file +as well. @lisp (customize-set-variable 'tramp-save-ad-hoc-proxies t) @@ -6052,18 +6068,30 @@ Thanks to @value{tramp} users for contributing to these recipes. @item -Why saved multi-hop file names do not work in a new Emacs session? - -When saving ad-hoc multi-hop @value{tramp} file names (@pxref{Ad-hoc -multi-hops}) via bookmarks, recent files, filecache, bbdb, or another -package, use the full ad-hoc file name including all hops, like -@file{@trampfn{ssh,bird@@bastion|ssh@value{postfixhop}@c -news.my.domain,/opt/news/etc}}. - -Alternatively, when saving abbreviated multi-hop file names -@file{@trampfn{ssh,news@@news.my.domain,/opt/news/etc}}, the user -option @code{tramp-save-ad-hoc-proxies} must be set non-@code{nil} -value. +Why don't saved ad-hoc multi-hop file names work in a new Emacs session? + +By default, ad-hoc multi-hop file names are abbreviated after +completing the initial connection. These abbreviated forms retain +only the final hop, and so only the Emacs session that generated the +abbreviated form can understand it. @xref{Ad-hoc multi-hops}. + +For example, after connecting to @file{@trampfn{ssh,bird@@bastion|@c +ssh@value{postfixhop}news@@news.my.domain,/opt/news/etc}}, the file +name becomes @file{@trampfn{ssh,news@@news.my.domain,/opt/news/etc}}. +If the abbreviated form is saved in a bookmark, the recent files list, +bbdb, or similar, a new Emacs session has no way to know that the +connection must go through @samp{bird@@bastion} first. + +There are two mechanisms to deal with this. The first is to customize +@code{tramp-show-ad-hoc-proxies} to a non-@code{nil} value, which +disables abbreviation. Then the fully-qualified ad-hoc multi-hop file +name is the one that will be both displayed and saved. +@xref{tramp-show-ad-hoc-proxies}. + +Alternatively, you can customize @code{tramp-save-ad-hoc-proxies} to a +non-@code{nil} value which means to save the information how an +abbreviated multi-hop file name can be expanded. +@xref{tramp-save-ad-hoc-proxies}. @item commit 2a756ce9d774a91774fdf4c5cd40562540a40633 Author: Gerd Möllmann Date: Sun Feb 23 05:07:55 2025 +0100 Enforce redisplay when deleting a child frame (bug#76406) * src/term.c (tty_free_frame_resources): When deleting a child mark its root frame to garbaged. * src/dispnew.c (prepare_desired_root_row): Add a check for GLYPH_DEBUG. diff --git a/src/dispnew.c b/src/dispnew.c index 228aab77753..cd0ed7e6414 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3525,12 +3525,22 @@ prepare_desired_root_row (struct frame *root, int y) return desired_row; /* If we have a current row that is up to date, copy that to the - desired row and use that. */ - /* Don't copy rows that aren't enabled, in particuler because they - might not have the 'frame' member of glyphs set. */ + desired row and use that. Don't copy rows that are bot enabled, in + particular because they might not have the 'frame' member of glyphs + set. */ struct glyph_row *current_row = MATRIX_ROW (root->current_matrix, y); if (current_row->enabled_p) { +# ifdef GLYPH_DEBUG + /* Safety belt: Try to make sure that we don't copy glyphs from a + stale current matrix that contains glyphs referring to dead + frames. */ + for (int i = 0; i < current_row->used[TEXT_AREA]; ++i) + { + struct glyph *glyph = current_row->glyphs[TEXT_AREA] + i; + eassert (glyph->frame && FRAME_LIVE_P (glyph->frame)); + } +# endif memcpy (desired_row->glyphs[0], current_row->glyphs[0], root->current_matrix->matrix_w * sizeof (struct glyph)); desired_row->enabled_p = true; diff --git a/src/term.c b/src/term.c index fd95e75a007..ba7b14de158 100644 --- a/src/term.c +++ b/src/term.c @@ -4077,7 +4077,8 @@ create_tty_output (struct frame *f) f->output_data.tty = t; } -/* Delete frame F's face cache, and its tty-dependent part. */ +/* Delete frame F's face cache, and its tty-dependent part. This is + installed as a delete_frame_hook. */ static void tty_free_frame_resources (struct frame *f) @@ -4085,6 +4086,11 @@ tty_free_frame_resources (struct frame *f) eassert (FRAME_TERMCAP_P (f)); free_frame_faces (f); xfree (f->output_data.tty); + + /* Deleting a child frame means we have to thoroughly redisplay its + root frame to make sure the child disappears from the display. */ + if (FRAME_PARENT_FRAME (f)) + SET_FRAME_GARBAGED (root_frame (f)); } #elif defined MSDOS commit 99410ba902a01d56b49001b4c18a5390b3c5463b Author: Martin Rudalics Date: Sun Feb 23 10:19:49 2025 +0100 Implement new user option 'quit-window-kill-buffer' (Bug#76248) * lisp/window.el (quit-window-kill-buffer): New option. (quit-window): Handle it. * doc/lispref/windows.texi (Quitting Windows): Describe new option 'quit-window-kill-buffer'. * etc/NEWS: Announce new option 'quit-window-kill-buffer'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 7a98cf4ff13..6c4e59d448f 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4953,11 +4953,26 @@ instead of burying it. @vindex quit-window-hook The function @code{quit-window} first runs @code{quit-window-hook}. -Then it calls the function @code{quit-restore-window}, described next, +Then it calls the function @code{quit-restore-window}, described below, which does the hard work. @end deffn -You can get more control by calling @code{quit-restore-window} instead. +The following option tells @code{quit-window} whether it should +preferably kill or bury @var{window}'s buffer. + +@defopt quit-window-kill-buffer +If this is @code{nil} and @var{kill} is @code{nil}, @code{quit-window} +will bury @var{window}'s buffer. If this is @code{t}, +@code{quit-window} will try to kill @var{window}'s buffer. Otherwise, +this should be a list of major modes. @code{quit-window} will kill the +buffer of @var{window} regardless of the value of @var{kill} if that +buffer's major mode is either a member of this list or is derived from a +member of this list. In any other case, @code{quit-window} will kill +the buffer only if @var{kill} is non-@code{nil} and bury it otherwise. +@end defopt + +You can get more control by calling @code{quit-restore-window} instead +of @code{quit-window}. @defun quit-restore-window &optional window bury-or-kill This function handles @var{window} and its buffer after quitting. The diff --git a/etc/NEWS b/etc/NEWS index 4d9e94113ac..ef12f84c7ff 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -199,6 +199,11 @@ This abnormal hook gives its client a way to save a window from getting deleted implicitly by functions like 'kill-buffer', 'bury-buffer' and 'quit-restore-window'. ++++ +*** New user option 'quit-window-kill-buffer'. +This option specifies whether 'quit-window' should preferably kill or +bury the buffer shown by the window to quit. + +++ *** New user option 'kill-buffer-quit-windows'. This option has 'kill-buffer' call 'quit-restore-window' to handle the diff --git a/lisp/window.el b/lisp/window.el index 1204103e83c..f94558c6850 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5447,6 +5447,21 @@ elsewhere. This value is used by `quit-windows-on'." ((eq bury-or-kill 'bury) (bury-buffer-internal buffer))))) +(defcustom quit-window-kill-buffer nil + "Non-nil means `quit-window' will try to kill WINDOW's buffer. +If this is nil and the KILL argument is nil, `quit-window' will bury +WINDOW's buffer. If this is t, `quit-window' will always try to kill +WINDOW's buffer. Otherwise, this should be a list of major modes. +`quit-window' will kill the buffer of its WINDOW argument regardless of +the value of KILL if that buffer's major mode is either a member of this +list or is derived from a member of this list. In any other case, +`quit-window' will kill the buffer only if KILL is non-nil and bury it +otherwise." + :type '(choice (boolean :tag "All major modes") + (repeat (symbol :tag "Major mode"))) + :version "31.1" + :group 'windows) + (defun quit-window (&optional kill window) "Quit WINDOW and bury its buffer. WINDOW must be a live window and defaults to the selected one. @@ -5460,11 +5475,19 @@ Windows' for more details. The functions in `quit-window-hook' will be run before doing anything else." (interactive "P") - ;; Run the hook from the buffer implied to get any buffer-local - ;; values. - (with-current-buffer (window-buffer (window-normalize-window window)) - (run-hooks 'quit-window-hook)) - (quit-restore-window window (if kill 'kill 'bury))) + (let (kill-from-mode) + (with-current-buffer (window-buffer (window-normalize-window window)) + ;; Run the hook from the buffer implied to get any buffer-local + ;; values. + (run-hooks 'quit-window-hook) + + (setq kill-from-mode + (or (eq quit-window-kill-buffer t) + (and (listp quit-window-kill-buffer) + (derived-mode-p quit-window-kill-buffer))))) + + (quit-restore-window + window (if (or kill kill-from-mode) 'kill 'bury)))) (defun quit-windows-on (&optional buffer-or-name kill frame) "Quit all windows showing BUFFER-OR-NAME.