commit 689f4212520bfe96cc8b060c4514abe7f97d0d64 (HEAD, refs/remotes/origin/master) Author: Noam Postavsky Date: Fri Sep 4 06:43:13 2020 +0200 Allow "lambda" spelling for ucs-insert * lisp/international/mule-cmds.el (ucs-names): Add a "LAMBDA" completion variant for every "LAMDA" name (bug#30513). diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 02dacaf0a2..e49d1fa91e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3010,6 +3010,15 @@ on encoding." ;; higher code, so it gets pushed later! (if new-name (puthash new-name c names)) (if old-name (puthash old-name c names)) + ;; Unicode uses the spelling "lamda" in character + ;; names, instead of "lambda", due to "preferences + ;; expressed by the Greek National Body" (Bug#30513). + ;; Some characters have an old-name with the "lambda" + ;; spelling, but others don't. Add the traditional + ;; spelling for more convenient completion. + (when (and (not old-name) new-name + (string-match "LAMDA" new-name)) + (puthash (replace-match "LAMBDA" t t new-name) c names)) (setq c (1+ c)))))) ;; Special case for "BELL" which is apparently the only char which ;; doesn't have a new name and whose old-name is shadowed by a newer commit 66d01012ba61a364fe92cdc1728bfa135a90626a Author: Robert Pluim Date: Fri Sep 4 06:28:21 2020 +0200 Show log suppression buttons in display-warning buffer * etc/NEWS: Describe 'display-warning' button change (bug#30757). * lisp/emacs-lisp/warnings.el (warning-suppress-warning): Define button. (warning-suppress-action): New function. (warning-suppress-log-warning): Define button. (warning-suppress-log-action): New function. (display-warning): Show buttons to allow permanent modification of warning-suppress-types and warning-suppress-log-types per warning. diff --git a/etc/NEWS b/etc/NEWS index 1ae24d946d..e88eaa7167 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -167,6 +167,14 @@ same for a button. * Changes in Specialized Modes and Packages in Emacs 28.1 +--- +** Specific warnings can now be disabled from the warning buffer. +When a warning is displayed to the user, the resulting buffer now has +buttons which allow making permanent changes to the treatment of that +warning. Automatic showing of the warning can be disabled (although +it is still logged to the *Messages* buffer), or the warning can be +disabled entirely. + ** mspool.el --- *** Autoload the main entry point 'mspool-show' diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index b1fd6ed80a..3a568cb834 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -200,6 +200,21 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress." ;; we return t. some-match)) +(define-button-type 'warning-suppress-warning + 'action #'warning-suppress-action + 'help-echo "mouse-2, RET: Don't display this warning automatically") +(defun warning-suppress-action (button) + (customize-save-variable 'warning-suppress-types + (cons (list (button-get button 'warning-type)) + warning-suppress-types))) +(define-button-type 'warning-suppress-log-warning + 'action #'warning-suppress-log-action + 'help-echo "mouse-2, RET: Don't log this warning") +(defun warning-suppress-log-action (button) + (customize-save-variable 'warning-suppress-log-types + (cons (list (button-get button 'warning-type)) + warning-suppress-types))) + ;;;###autoload (defun display-warning (type message &optional level buffer-name) "Display a warning message, MESSAGE. @@ -227,7 +242,12 @@ See the `warnings' custom group for user customization features. See also `warning-series', `warning-prefix-function', `warning-fill-prefix', and `warning-fill-column' for additional -programming features." +programming features. + +This will also display buttons allowing the user to permanently +disable automatic display of the warning or disable the warning +entirely by setting `warning-suppress-types' or +`warning-suppress-log-types' on their behalf." (if (not (or after-init-time noninteractive (daemonp))) ;; Ensure warnings that happen early in the startup sequence ;; are visible when startup completes (bug#20792). @@ -272,6 +292,14 @@ programming features." (insert (format (nth 1 level-info) (format warning-type-format typename)) message) + (insert " ") + (insert-button "Disable showing" + 'type 'warning-suppress-warning + 'warning-type type) + (insert " ") + (insert-button "Disable logging" + 'type 'warning-suppress-log-warning + 'warning-type type) (funcall newline) (when (and warning-fill-prefix (not (string-match "\n" message))) (let ((fill-prefix warning-fill-prefix) commit 7769cad1e396c1ab68d2e6c35fc1846003b4639d Author: Tino Calancha Date: Fri Sep 4 06:09:23 2020 +0200 wdired-do-renames: Speed up for long Emacs sessions `dired-rename-file' calls unconditionally `dired-rename-subdir'. The second function performs performs a loop on all the Emacs buffers; this step is only needed if FILE is a directory (bug#32899). In a long lived Emacs session, this can make a difference when renaming a bunch of files with `wdired'. For instance, in my 40 days old Emacs session, with ~ 700 buffers, this patch increases the speed to rename 2000 files a factor ~ 15. * lisp/dired-aux.el (dired-rename-file): Call `dired-rename-subdir' iif FILE is a directory. Add docstring. (dired-rename-subdir, dired-remove-entry) (dired-remove-file): Add docstring. (dired-remove-entry): Move definition into `dired.el'. * lisp/wdired.el (wdired-do-renames): Use a progress-reporter. * lisp/dired.el (dired-delete-entry): Use `dired-remove-entry'. Add docstring. (dired-buffers-for-dir, dired-fun-in-all-buffers): Change comment into docstring. (dired-fun-in-all-buffers): Prefer `when' and `push' here. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index ab13b3e26e..eeb06beafd 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1549,17 +1549,13 @@ files matching `dired-omit-regexp'." ;;;###autoload (defun dired-remove-file (file) + "Remove entry FILE on each dired buffer. +Note this doesn't delete FILE in the file system. +See `dired-delete-file' in case you wish that." (dired-fun-in-all-buffers (file-name-directory file) (file-name-nondirectory file) #'dired-remove-entry file)) -(defun dired-remove-entry (file) - (save-excursion - (and (dired-goto-file file) - (let (buffer-read-only) - (delete-region (progn (beginning-of-line) (point)) - (line-beginning-position 2)))))) - ;;;###autoload (defun dired-relist-file (file) "Create or update the line for FILE in all Dired buffers it would belong in." @@ -1676,6 +1672,9 @@ rename them using `vc-rename-file'." ;;;###autoload (defun dired-rename-file (file newname ok-if-already-exists) + "Rename FILE to NEWNAME. +Signal a `file-already-exists' error if a file NEWNAME already exists +unless OK-IF-ALREADY-EXISTS is non-nil." (dired-handle-overwrite newname) (dired-maybe-create-dirs (file-name-directory newname)) (if (and dired-vc-rename-file diff --git a/lisp/dired.el b/lisp/dired.el index d122869a5e..e4bc4decf8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2908,12 +2908,12 @@ You can then feed the file name(s) to other commands with \\[yank]." ;; Keeping Dired buffers in sync with the filesystem and with each other (defun dired-buffers-for-dir (dir &optional file) -;; Return a list of buffers for DIR (top level or in-situ subdir). -;; If FILE is non-nil, include only those whose wildcard pattern (if any) -;; matches FILE. -;; The list is in reverse order of buffer creation, most recent last. -;; As a side effect, killed dired buffers for DIR are removed from -;; dired-buffers. + "Return a list of buffers for DIR (top level or in-situ subdir). +If FILE is non-nil, include only those whose wildcard pattern (if any) +matches FILE. +The list is in reverse order of buffer creation, most recent last. +As a side effect, killed dired buffers for DIR are removed from +dired-buffers." (setq dir (file-name-as-directory dir)) (let (result buf) (dolist (elt dired-buffers) @@ -3462,18 +3462,28 @@ Return list of buffers where FUN succeeded (i.e., returned non-nil)." (let (success-list) (dolist (buf (dired-buffers-for-dir (expand-file-name directory) file)) (with-current-buffer buf - (if (apply fun args) - (push buf success-list)))) + (when (apply fun args) + (push (buffer-name buf) success-list)))) ;; FIXME: AFAICT, this return value is not used by any of the callers! success-list)) ;; Delete the entry for FILE from -(defun dired-delete-entry (file) +(defun dired-remove-entry (file) + "Remove entry FILE in the current dired buffer. +Note this doesn't delete FILE in the file system. +See `dired-delete-file' in case you wish that." (save-excursion (and (dired-goto-file file) (let ((inhibit-read-only t)) (delete-region (progn (beginning-of-line) (point)) - (save-excursion (forward-line 1) (point)))))) + (line-beginning-position 2)))))) + +(defun dired-delete-entry (file) + "Remove entry FILE in the current dired buffer. +Like `dired-remove-entry' followed by `dired-clean-up-after-deletion'. +Note this doesn't delete FILE in the file system. +See `dired-delete-file' in case you wish that." + (dired-remove-entry file) (dired-clean-up-after-deletion file)) (defvar dired-clean-up-buffers-too) diff --git a/lisp/wdired.el b/lisp/wdired.el index b98becfafe..6defbf8bc8 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -461,10 +461,12 @@ non-nil means return old filename." (defun wdired-do-renames (renames) "Perform RENAMES in parallel." - (let ((residue ()) - (progress nil) - (errors 0) - (overwrite (or (not wdired-confirm-overwrite) 1))) + (let* ((residue ()) + (progress nil) + (errors 0) + (total (1- (length renames))) + (prep (make-progress-reporter "Renaming" 0 total)) + (overwrite (or (not wdired-confirm-overwrite) 1))) (while (or renames ;; We've done one round through the renames, we have found ;; some residue, but we also made some progress, so maybe @@ -472,6 +474,7 @@ non-nil means return old filename." (prog1 (setq renames residue) (setq progress nil) (setq residue nil))) + (progress-reporter-update prep (- total (length renames))) (let* ((rename (pop renames)) (file-new (cdr rename))) (cond @@ -519,6 +522,7 @@ non-nil means return old filename." (dired-log "Rename `%s' to `%s' failed:\n%s\n" file-ori file-new err))))))))) + (progress-reporter-done prep) errors)) (defun wdired-create-parentdirs (file-new) commit 70af9a9cb914ffc276eac58b10106f9449f2544c Author: Harald Jörg Date: Fri Sep 4 05:13:43 2020 +0200 Fix infloop when indenting in cperl-mode * lisp/progmodes/cperl-mode.el (cperl-indent-exp): Fix (Bug#10483) Perl expressions (e.g. function calls) ending in ")" without statement terminator on the same line no longer loop endlessly. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index e2628c834c..5dee5007e2 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -4819,9 +4819,10 @@ conditional/loop constructs." (while (< (point) tmp-end) (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol (or (eolp) (forward-sexp 1))) - (if (> (point) tmp-end) ; Yes, there an unfinished block + (if (> (point) tmp-end) ; Check for an unfinished block nil (if (eq ?\) (preceding-char)) + ;; closing parens can be preceded by up to three sexps (progn ;; Plan B: find by REGEXP block followup this line (setq top (point)) (condition-case nil @@ -4842,7 +4843,9 @@ conditional/loop constructs." (progn (goto-char top) (forward-sexp 1) - (setq top (point))))) + (setq top (point))) + ;; no block to be processed: expression ends here + (setq done t))) (error (setq done t))) (goto-char top)) (if (looking-at ; Try Plan C: continuation block diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl new file mode 100644 index 0000000000..4a9842ffa5 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl @@ -0,0 +1,52 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.020; + +# This file contains test input and expected output for the tests in +# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is +# syntactically valid, but doesn't make much sense. + +# -------- for loop: input -------- +for my $foo (@ARGV) +{ +...; +} +# -------- for loop: expected output -------- +for my $foo (@ARGV) { + ...; +} +# -------- for loop: end -------- + +# -------- while loop: input -------- +{ +while (1) +{ +say "boring loop"; +} +continue +{ +last; # no endless loop, though +} +} +# -------- while loop: expected output -------- +{ + while (1) { + say "boring loop"; + } continue { + last; # no endless loop, though + } +} +# -------- while loop: end -------- + +# -------- if-then-else: input -------- +if (my $foo) { bar() } elsif (quux()) { baz() } else { quuux } +# -------- if-then-else: expected output -------- +if (my $foo) { + bar(); +} elsif (quux()) { + baz(); +} else { + quuux; +} +# -------- if-then-else: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 1efcad5007..b549b92404 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -24,10 +24,7 @@ ;;; Commentary: -;; This is a collection of tests for the fontification of CPerl-mode. - -;; Run these tests interactively: -;; (ert-run-tests-interactively '(tag :fontification)) +;; This is a collection of tests for CPerl-mode. ;;; Code: @@ -35,6 +32,14 @@ (require 'cperl-mode) +(defvar cperl-mode-tests-data-directory + (expand-file-name "lisp/progmodes/cperl-mode-resources" + (or (getenv "EMACS_TEST_DIRECTORY") + (expand-file-name "../../../" + (or load-file-name + buffer-file-name)))) + "Directory containing cperl-mode test data.") + (defun cperl-test-ppss (text regexp) "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT." (interactive) @@ -86,4 +91,82 @@ have a face property." (should (equal result nil)) (should (= (point) 15))))) ; point has skipped the group +(defun cperl-mode-test--run-bug-10483 () + "Runs a short program, intended to be under timer scrutiny. +This function is intended to be used by an Emacs subprocess in +batch mode. The message buffer is used to report the result of +running `cperl-indent-exp' for a very simple input. The result +is expected to be different from the input, to verify that +indentation actually takes place.." + (let ((code "poop ('foo', \n'bar')")) ; see the bug report + (message "Test Bug#10483 started") + (with-temp-buffer + (insert code) + (funcall cperl-test-mode) + (goto-char (point-min)) + (search-forward "poop") + (cperl-indent-exp) + (message "%s" (buffer-string))))) + +(ert-deftest cperl-mode-test-bug-10483 () + "Verifies that a piece of code which ends in a paren without a +statement terminato ron tne same line does not loop forever. The +test starts an asynchronous Emacs batch process under timeout +control." + (interactive) + (let* ((emacs (concat invocation-directory invocation-name)) + (test-function 'cperl-mode-test--run-bug-10483) + (test-function-name (symbol-name test-function)) + (test-file (symbol-file test-function 'defun)) + (ran-out-of-time nil) + (process-connection-type nil) + runner) + (with-temp-buffer + (with-timeout (1 + (delete-process runner) + (setq ran-out-of-time t)) + (setq runner (start-process "speedy" + (current-buffer) + emacs + "-batch" + "--quick" + "--load" test-file + "--funcall" test-function-name)) + (while (accept-process-output runner))) + (should (equal ran-out-of-time nil)) + (goto-char (point-min)) + ;; just a very simple test for indentation: This should + ;; be rather robust with regard to indentation defaults + (should (string-match + "poop ('foo', \n 'bar')" (buffer-string)))))) + +(ert-deftest cperl-mode-test-indent-exp () + "Run various tests for `cperl-indent-exp' edge cases. +These exercise some standard blocks and also the special +treatment for Perl expressions where a closing paren isn't the +end of the statement." + (let ((file (expand-file-name "cperl-indent-exp.pl" + cperl-mode-tests-data-directory))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward + (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n" + "\\(?2:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: expected output ?-+\n" + "\\(?3:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: end ?-+") + nil t) + (let ((name (match-string 1)) + (code (match-string 2)) + (expected (match-string 3)) + got) + (with-temp-buffer + (insert code) + (goto-char (point-min)) + (cperl-indent-exp) ; here we go! + (setq expected (concat "test case " name ":\n" expected)) + (setq got (concat "test case " name ":\n" (buffer-string))) + (should (equal got expected)))))))) + ;;; cperl-mode-tests.el ends here commit 74ba8f8421a064f39d9544b7b9a4e400e07f3b86 Author: Lars Ingebrigtsen Date: Fri Sep 4 04:58:17 2020 +0200 Fix previous buffer name fixup in save-some-buffers * lisp/files.el (save-some-buffers): Get the file name for the correct buffer in the buffer name check (bug#43192). diff --git a/lisp/files.el b/lisp/files.el index 3403e257a1..5f5902d0cb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5574,7 +5574,7 @@ change the additional actions you can take on files." (concat "\\<" (regexp-quote (file-name-nondirectory - buffer-file-name)) + (buffer-file-name buffer))) "<[^>]*>\\'") (buffer-name buffer))) ;; The buffer name is similar to the commit a0e026b274ea76845e1eee94dcc90da07fb06666 Author: Lars Ingebrigtsen Date: Fri Sep 4 04:45:49 2020 +0200 Don't display the Gnus splash on gnus-read-ephemeral-emacs-bug-group * lisp/gnus/gnus.el: Don't display the Gnus splash at load time (bug#43123). diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index f615d49d27..295395c79c 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -853,12 +853,6 @@ be used directly.") (cons (car list) (list :type type :data data))) list))) -(let ((command (format "%s" this-command))) - (when (string-match "gnus" command) - (if (eq 'gnus-other-frame this-command) - (gnus-get-buffer-create gnus-group-buffer) - (gnus-splash)))) - ;;; Do the rest. (require 'gnus-util) commit 6f88247a6c44e8ca6c36f7db36f9bc2a878c8cf6 Author: Stefan Monnier Date: Thu Sep 3 22:03:46 2020 -0400 * lisp/mail/mspools.el: Use lexical-scoping. Autoload `mspools-show`. (mspools-mode-map): Remove bindings made redundant by `special-mode-map`. (mspools-show): Autoload. Use `erase-buffer`. (mspools-visit-spool): Use `inhibit-read-only`; simplify a bit. (mspools-get-spool-files): Avoid `setq`. Use `pcase-dolist`. (mspools-revert-buffer): Make (unused) args optional. (mspools-help, mspools-show-again, mspools-quit): Declare obsolete. diff --git a/etc/NEWS b/etc/NEWS index 38cfeaee9b..1ae24d946d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -167,6 +167,9 @@ same for a button. * Changes in Specialized Modes and Packages in Emacs 28.1 +** mspool.el +--- +*** Autoload the main entry point 'mspool-show' ** Windows *** The key prefix 'C-x 4 1' displays next command buffer in the same window. diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index 21aefa6c79..ab2649feb4 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -1,4 +1,4 @@ -;;; mspools.el --- show mail spools waiting to be read +;;; mspools.el --- show mail spools waiting to be read -*- lexical-binding: t; -*- ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. @@ -170,11 +170,8 @@ your primary spool is. If this fails, set it to something like (define-key map "\C-c\C-c" 'mspools-visit-spool) (define-key map "\C-m" 'mspools-visit-spool) (define-key map " " 'mspools-visit-spool) - (define-key map "?" 'mspools-help) - (define-key map "q" 'mspools-quit) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) - (define-key map "g" 'revert-buffer) map) "Keymap for the *spools* buffer.") @@ -216,14 +213,15 @@ your primary spool is. If this fails, set it to something like (concat mspools-folder-directory s "." mspools-suffix) (concat mspools-folder-directory s ".crash"))) ;; So I create a vm-spool-files entry for each of those mail drops - (mapcar 'file-name-sans-extension + (mapcar #'file-name-sans-extension (directory-files mspools-folder-directory nil (format "\\`[^.]+\\.%s" mspools-suffix))) )) )) ;;; MSPOOLS-SHOW -- the main function -(defun mspools-show ( &optional noshow) +;;;###autoload +(defun mspools-show (&optional noshow) "Show the list of non-empty spool files in the *spools* buffer. Buffer is not displayed if SHOW is non-nil." (interactive) @@ -232,7 +230,7 @@ Buffer is not displayed if SHOW is non-nil." (progn (set-buffer mspools-buffer) (setq buffer-read-only nil) - (delete-region (point-min) (point-max))) + (erase-buffer)) ;; else buffer doesn't exist so create it (get-buffer-create mspools-buffer)) @@ -255,8 +253,8 @@ Buffer is not displayed if SHOW is non-nil." (defun mspools-visit-spool () "Visit the folder on the current line of the *spools* buffer." (interactive) - (let ( spool-name folder-name) - (setq spool-name (mspools-get-spool-name)) + (let ((spool-name (mspools-get-spool-name)) + folder-name) (if (null spool-name) (message "No spool on current line") @@ -265,19 +263,20 @@ Buffer is not displayed if SHOW is non-nil." ;; put in a little "*" to indicate spool file has been read. (if (not mspools-update) (save-excursion - (setq buffer-read-only nil) (beginning-of-line) - (insert "*") - (delete-char 1) - (setq buffer-read-only t) - )) + (let ((inhibit-read-only t)) + (insert "*") + (delete-char 1)))) (message "folder %s spool %s" folder-name spool-name) - (if (eq (count-lines (point-min) (point-at-eol)) - mspools-files-len) - (forward-line (- 1 mspools-files-len)) ;back to top of list - ;; else just on to next line - (forward-line 1)) + (forward-line (if (eq (count-lines (point-min) (point-at-eol)) + mspools-files-len) + ;; FIXME: Why use `mspools-files-len' instead + ;; of looking if we're on the last line and + ;; jumping to the first one if so? + (- 1 mspools-files-len) ;back to top of list + ;; else just on to next line + 1)) ;; Choose whether to use VM or RMAIL for reading folder. (if mspools-using-vm @@ -291,8 +290,8 @@ Buffer is not displayed if SHOW is non-nil." (if mspools-update ;; generate new list of spools. - (save-excursion - (mspools-show-again 'noshow)))))) + (save-excursion ;;FIXME: Why? + (mspools-revert-buffer)))))) (defun mspools-get-folder-from-spool (name) "Return folder name corresponding to the spool file NAME." @@ -314,27 +313,31 @@ Buffer is not displayed if SHOW is non-nil." (defun mspools-get-spool-name () "Return the name of the spool on the current line." (let ((line-num (1- (count-lines (point-min) (point-at-eol))))) + ;; FIXME: Why not extract the name directly from the current line's text? (car (nth line-num mspools-files)))) ;;; Spools mode functions -(defun mspools-revert-buffer (ignore noconfirm) - "Re-run mspools-show to revert the *spools* buffer." +(defun mspools-revert-buffer (&optional _ignore _noconfirm) + "Re-run `mspools-show' to revert the *spools* buffer." (mspools-show 'noshow)) (defun mspools-show-again (&optional noshow) - "Update the *spools* buffer. This is useful if mspools-update is -nil." + "Update the *spools* buffer. +This is useful if `mspools-update' is nil." + (declare (obsolete revert-buffer "28.1")) (interactive) (mspools-show noshow)) (defun mspools-help () "Show help for `mspools-mode'." + (declare (obsolete describe-mode "28.1")) (interactive) (describe-function 'mspools-mode)) (defun mspools-quit () "Quit the *spools* buffer." + (declare (obsolete quit-window "28.1")) (interactive) (kill-buffer mspools-buffer)) @@ -348,32 +351,26 @@ nil." (defun mspools-get-spool-files () "Find the list of spool files and display them in *spools* buffer." - (let (folders head spool len beg end any) - (if (null mspools-folder-directory) - (error "Set `mspools-folder-directory' to where the spool files are")) - (setq folders (directory-files mspools-folder-directory nil + (if (null mspools-folder-directory) + (error "Set `mspools-folder-directory' to where the spool files are")) + (let* ((folders (directory-files mspools-folder-directory nil (format "\\`[^.]+\\.%s\\'" mspools-suffix))) - (setq folders (mapcar 'mspools-size-folder folders)) - (setq folders (delq nil folders)) + (folders (delq nil (mapcar #'mspools-size-folder folders))) + ;; beg end + ) (setq mspools-files folders) (setq mspools-files-len (length mspools-files)) - (set-buffer mspools-buffer) - (while folders - (setq any t) - (setq head (car folders)) - (setq spool (car head)) - (setq len (cdr head)) - (setq folders (cdr folders)) - (setq beg (point)) - (insert (format " %10d %s" len spool)) - (setq end (point)) - (insert "\n") - ;;(put-text-property beg end 'mouse-face 'highlight) - ) - (if any - (delete-char -1)) ;delete last RET - (goto-char (point-min)) - )) + (with-current-buffer mspools-buffer + (pcase-dolist (`(,spool . ,len) folders) + ;; (setq beg (point)) + (insert (format " %10d %s" len spool)) + ;; (setq end (point)) + (insert "\n") + ;;(put-text-property beg end 'mouse-face 'highlight) + ) + (if (not (bolp)) + (delete-char -1)) ;delete last RET + (goto-char (point-min))))) (defun mspools-size-folder (spool) "Return (SPOOL . SIZE ), if SIZE of spool file is non-zero." commit ae6daa680a5f5f5fb9c6a15296e5e88c97cd770a Author: João Távora Date: Thu Sep 3 22:17:29 2020 +0100 Fix ElDoc's eldoc-documentation-enthusiast strategy As soon as we get a response from any of the user functions/sources in eldoc-documentation-functions, we must make sure to call the display-doc local function, just like in the other strategies. That is even if that response produced nil, meaning that there's no doc coming from that source. Failure to do so when none of the sources produced non-nil would keep stale documentation displaying. First reported in https://github.com/joaotavora/eglot/issues/503 * lisp/emacs-lisp/eldoc.el (eldoc--invoke-strategy): Fix :enthusiast strategy. (Version): Bump to 1.10.0 diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 6bb732ef85..772c907c28 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -5,7 +5,7 @@ ;; Author: Noah Friedman ;; Keywords: extensions ;; Created: 1995-10-06 -;; Version: 1.9.0 +;; Version: 1.10.0 ;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -740,14 +740,14 @@ should endeavour to display the docstrings eventually produced." (when (and string (cl-loop for (p) in docs-registered never (< p pos))) (setq docs-registered '()) - (register-doc pos string plist) - (when (and (timerp eldoc--enthusiasm-curbing-timer) - (memq eldoc--enthusiasm-curbing-timer - timer-list)) - (cancel-timer eldoc--enthusiasm-curbing-timer)) - (setq eldoc--enthusiasm-curbing-timer - (run-at-time (unless (zerop pos) 0.3) - nil #'display-doc))) + (register-doc pos string plist)) + (when (and (timerp eldoc--enthusiasm-curbing-timer) + (memq eldoc--enthusiasm-curbing-timer + timer-list)) + (cancel-timer eldoc--enthusiasm-curbing-timer)) + (setq eldoc--enthusiasm-curbing-timer + (run-at-time (unless (zerop pos) 0.3) + nil #'display-doc)) t)) (:patient (cl-incf want) commit 7921b5db1049709a1d4ed143d1f44417d5087dc1 Author: Harald Jörg Date: Thu Sep 3 22:11:47 2020 +0200 Fix freeze in cperl-mode when editing a regexp * lisp/progmodes/cperl-mode.el (cperl-forward-group-in-re): Make sure that an error is reported back to the caller (Bug#16368). * test/lisp/progmodes/cperl-mode-tests.el (cperl-mode-test-bug-16368): Tests for balanced (no error) and unbalanced (caught exception) cases of `cperl-forward-group-in-re'. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 44579cfd38..e2628c834c 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3241,8 +3241,8 @@ Return the error message (if any). Does not work if delimiter is `)'. Works before syntax recognition is done." ;; Works *before* syntax recognition is done (or st-l (setq st-l (list nil))) ; Avoid overwriting '() - (let (st b reset-st) - (condition-case b + (let (st result reset-st) + (condition-case err (progn (setq st (cperl-cached-syntax-table st-l)) (modify-syntax-entry ?\( "()" st) @@ -3250,8 +3250,7 @@ Works before syntax recognition is done." (setq reset-st (syntax-table)) (set-syntax-table st) (forward-sexp 1)) - (error (message - "cperl-forward-group-in-re: error %s" b))) + (error (setq result err))) ;; now restore the initial state (if st (progn @@ -3259,7 +3258,7 @@ Works before syntax recognition is done." (modify-syntax-entry ?\) "." st))) (if reset-st (set-syntax-table reset-st)) - b)) + result)) (defvar font-lock-string-face) diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index abb13f2555..1efcad5007 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -33,6 +33,8 @@ (defvar cperl-test-mode #'cperl-mode) +(require 'cperl-mode) + (defun cperl-test-ppss (text regexp) "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT." (interactive) @@ -63,4 +65,25 @@ have a face property." (let ((code "{ $a- / $b } # /")) (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))) +(ert-deftest cperl-mode-test-bug-16368 () + "Verify that `cperl-forward-group-in-re' doesn't hide errors." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((code "/(\\d{4})(?{2}/;") ; the regex from the bug report + (result)) + (with-temp-buffer + (insert code) + (goto-char 9) + (setq result (cperl-forward-group-in-re)) + (should (equal (car result) 'scan-error)) + (should (equal (nth 1 result) "Unbalanced parentheses")) + (should (= (point) 9)))) ; point remains unchanged on error + (let ((code "/(\\d{4})(?{2})/;") ; here all parens are balanced + (result)) + (with-temp-buffer + (insert code) + (goto-char 9) + (setq result (cperl-forward-group-in-re)) + (should (equal result nil)) + (should (= (point) 15))))) ; point has skipped the group + ;;; cperl-mode-tests.el ends here commit 4ea928e14f486ae8b89c0cdf1d19d3dc3d6498a2 Author: Alan Third Date: Thu Sep 3 21:56:03 2020 +0100 * configure.ac (GNU_OBJC_CFLAGS): Check ObjC defaults to C99. (bug#43167) diff --git a/configure.ac b/configure.ac index dd2adb7e74..0bcff587e8 100644 --- a/configure.ac +++ b/configure.ac @@ -1900,8 +1900,7 @@ tmp_CPPFLAGS="$CPPFLAGS" tmp_CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS -x objective-c" CFLAGS="$CFLAGS -x objective-c" -# Recent versions of GCC don't use C99 to compile Obj-C. -GNU_OBJC_CFLAGS="-std=c99" +GNU_OBJC_CFLAGS="" LIBS_GNUSTEP= if test "${with_ns}" != no; then # macfont.o requires macuvs.h which is absent after 'make extraclean', @@ -1917,7 +1916,7 @@ if test "${with_ns}" != no; then elif flags=$( (gnustep-config --objc-flags) 2>/dev/null); then NS_IMPL_GNUSTEP=yes NS_GNUSTEP_CONFIG=yes - GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS $flags" + GNU_OBJC_CFLAGS="$flags" LIBS_GNUSTEP=$(gnustep-config --gui-libs) || exit elif test -f $GNUSTEP_CONFIG_FILE; then NS_IMPL_GNUSTEP=yes @@ -2067,6 +2066,20 @@ if test "${HAVE_NS}" = yes; then AC_DEFINE(NATIVE_OBJC_INSTANCETYPE, 1, [Define if ObjC compiler supports instancetype natively.]) fi + + AC_CACHE_CHECK( + [if the Objective C compiler defaults to C99], + [emacs_cv_objc_c99], + [AC_LANG_PUSH([Objective C]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([], [[for (int i = 0;;);]])], + emacs_cv_objc_c99=yes, + emacs_cv_objc_c99=no) + AC_LANG_POP([Objective C])]) + + if test x$emacs_cv_objc_c99 = xno ; then + GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -std=c99" + fi fi HAVE_W32=no commit 00b22239ab7cd8bd6af6a234ceb673b43dd01df4 Author: Stefan Kangas Date: Thu Sep 3 21:57:06 2020 +0200 ; * test/lisp/progmodes/cperl-mode-tests.el: Add license statement. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index be8b42d99a..abb13f2555 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -7,6 +7,21 @@ ;; Keywords: internal ;; Homepage: https://github.com/HaraldJoerg/cperl-mode +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + ;;; Commentary: ;; This is a collection of tests for the fontification of CPerl-mode. commit aff58e3f03d44f48ceba48f75414ab687de4eec7 Author: Alan Third Date: Tue Sep 1 19:53:01 2020 +0100 * src/image.c (svg_load_image): Use xmalloc and xfree. (bug#43135) diff --git a/src/image.c b/src/image.c index 35c5946c72..d8c34669cc 100644 --- a/src/image.c +++ b/src/image.c @@ -9830,7 +9830,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, img->background_valid = 1; } - wrapped_contents = malloc (buffer_size); + wrapped_contents = xmalloc (buffer_size); if (!wrapped_contents || buffer_size <= snprintf (wrapped_contents, buffer_size, wrapper, @@ -9889,7 +9889,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, pixbuf = rsvg_handle_get_pixbuf (rsvg_handle); if (!pixbuf) goto rsvg_error; g_object_unref (rsvg_handle); - free (wrapped_contents); + xfree (wrapped_contents); /* Extract some meta data from the svg handle. */ width = gdk_pixbuf_get_width (pixbuf); @@ -9960,7 +9960,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, if (rsvg_handle) g_object_unref (rsvg_handle); if (wrapped_contents) - free (wrapped_contents); + xfree (wrapped_contents); /* FIXME: Use error->message so the user knows what is the actual problem with the image. */ image_error ("Error parsing SVG image `%s'", img->spec); commit c47be1b8440883b07b6cf918235a13b65e3d7be6 Author: Paul Eggert Date: Thu Sep 3 12:10:26 2020 -0700 Revert recent GC-related changes (Bug#43152) * src/alloc.c (live_string_holding, live_cons_holding) (live_symbol_holding, live_large_vector_holding) (live_small_vector_holding): Go back to old approach of treating every would-be pointer to any byte in the object (though not to just past the object end) as addressing the object. (live_float_p): Require that the would-be float point to the start of the Lisp_Float, and not anywhere else. (live_vector_pointer, live_float_holding, mark_objects): Remove. All uses removed. (mark_maybe_object, mark_maybe_objects): Bring back these functions. * src/lisp.h (SAFE_ALLOCA_LISP_EXTRA): Do not clear the new slots, as they're now checked via mark_maybe_objects, not via mark_objects. diff --git a/src/alloc.c b/src/alloc.c index b12922b585..b16b2f8b93 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4457,17 +4457,9 @@ live_string_holding (struct mem_node *m, void *p) must not be on the free-list. */ if (0 <= offset && offset < sizeof b->strings) { - ptrdiff_t off = offset % sizeof b->strings[0]; - if (off == Lisp_String - || off == 0 - || off == offsetof (struct Lisp_String, u.s.size_byte) - || off == offsetof (struct Lisp_String, u.s.intervals) - || off == offsetof (struct Lisp_String, u.s.data)) - { - struct Lisp_String *s = p = cp -= off; - if (s->u.s.data) - return s; - } + struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0]; + if (s->u.s.data) + return s; } return NULL; } @@ -4497,15 +4489,9 @@ live_cons_holding (struct mem_node *m, void *p) && (b != cons_block || offset / sizeof b->conses[0] < cons_block_index)) { - ptrdiff_t off = offset % sizeof b->conses[0]; - if (off == Lisp_Cons - || off == 0 - || off == offsetof (struct Lisp_Cons, u.s.u.cdr)) - { - struct Lisp_Cons *s = p = cp -= off; - if (!deadp (s->u.s.car)) - return s; - } + struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; + if (!deadp (s->u.s.car)) + return s; } return NULL; } @@ -4536,23 +4522,9 @@ live_symbol_holding (struct mem_node *m, void *p) && (b != symbol_block || offset / sizeof b->symbols[0] < symbol_block_index)) { - ptrdiff_t off = offset % sizeof b->symbols[0]; - if (off == Lisp_Symbol - - /* Plain '|| off == 0' would run afoul of GCC 10.2 - -Wlogical-op, as Lisp_Symbol happens to be zero. */ - || (Lisp_Symbol != 0 && off == 0) - - || off == offsetof (struct Lisp_Symbol, u.s.name) - || off == offsetof (struct Lisp_Symbol, u.s.val) - || off == offsetof (struct Lisp_Symbol, u.s.function) - || off == offsetof (struct Lisp_Symbol, u.s.plist) - || off == offsetof (struct Lisp_Symbol, u.s.next)) - { - struct Lisp_Symbol *s = p = cp -= off; - if (!deadp (s->u.s.function)) - return s; - } + struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; + if (!deadp (s->u.s.function)) + return s; } return NULL; } @@ -4564,70 +4536,23 @@ live_symbol_p (struct mem_node *m, void *p) } -/* If P is a (possibly-tagged) pointer to a live Lisp_Float on the - heap, return the address of the Lisp_Float. Otherwise, return NULL. - M is a pointer to the mem_block for P. */ +/* Return true if P is a pointer to a live Lisp float on + the heap. M is a pointer to the mem_block for P. */ -static struct Lisp_Float * -live_float_holding (struct mem_node *m, void *p) +static bool +live_float_p (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_FLOAT); struct float_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->floats[0]; - /* P must point to (or be a tagged pointer to) the start of a - Lisp_Float and not be one of the unused cells in the current - float block. */ - if (0 <= offset && offset < sizeof b->floats) - { - int off = offset % sizeof b->floats[0]; - if ((off == Lisp_Float || off == 0) + /* P must point to the start of a Lisp_Float and not be + one of the unused cells in the current float block. */ + return (0 <= offset && offset < sizeof b->floats + && offset % sizeof b->floats[0] == 0 && (b != float_block - || offset / sizeof b->floats[0] < float_block_index)) - { - p = cp - off; - return p; - } - } - return NULL; -} - -static bool -live_float_p (struct mem_node *m, void *p) -{ - return live_float_holding (m, p) == p; -} - -/* Return VECTOR if P points within it, NULL otherwise. */ - -static struct Lisp_Vector * -live_vector_pointer (struct Lisp_Vector *vector, void *p) -{ - void *vvector = vector; - char *cvector = vvector; - char *cp = p; - ptrdiff_t offset = cp - cvector; - return ((offset == Lisp_Vectorlike - || offset == 0 - || (sizeof vector->header <= offset - && offset < vector_nbytes (vector) - && (! (vector->header.size & PSEUDOVECTOR_FLAG) - ? (offsetof (struct Lisp_Vector, contents) <= offset - && (((offset - offsetof (struct Lisp_Vector, contents)) - % word_size) - == 0)) - /* For non-bool-vector pseudovectors, treat any pointer - past the header as valid since it's too much of a pain - to write special-case code for every pseudovector. */ - : (! PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR) - || offset == offsetof (struct Lisp_Bool_Vector, size) - || (offsetof (struct Lisp_Bool_Vector, data) <= offset - && (((offset - - offsetof (struct Lisp_Bool_Vector, data)) - % sizeof (bits_word)) - == 0)))))) - ? vector : NULL); + || offset / sizeof b->floats[0] < float_block_index)); } /* If P is a pointer to a live, large vector-like object, return the object. @@ -4638,7 +4563,10 @@ static struct Lisp_Vector * live_large_vector_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_VECTORLIKE); - return live_vector_pointer (large_vector_vec (m->start), p); + struct Lisp_Vector *vp = p; + struct Lisp_Vector *vector = large_vector_vec (m->start); + struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector)); + return vector <= vp && vp < next ? vector : NULL; } static bool @@ -4668,7 +4596,7 @@ live_small_vector_holding (struct mem_node *m, void *p) { struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector)); if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE)) - return live_vector_pointer (vector, vp); + return vector; vector = next; } return NULL; @@ -4680,33 +4608,117 @@ live_small_vector_p (struct mem_node *m, void *p) return live_small_vector_holding (m, p) == p; } -/* If P points to Lisp data, mark that as live if it isn't already - marked. */ +/* Mark OBJ if we can prove it's a Lisp_Object. */ static void -mark_maybe_pointer (void *p) +mark_maybe_object (Lisp_Object obj) { - struct mem_node *m; - #if USE_VALGRIND - VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); + VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj)); #endif + int type_tag = XTYPE (obj); + intptr_t pointer_word_tag = LISP_WORD_TAG (type_tag), offset, ipo; + + switch (type_tag) + { + case_Lisp_Int: case Lisp_Type_Unused0: + return; + + case Lisp_Symbol: + offset = (intptr_t) lispsym; + break; + + default: + offset = 0; + break; + } + + INT_ADD_WRAPV ((intptr_t) XLP (obj), offset - pointer_word_tag, &ipo); + void *po = (void *) ipo; + /* If the pointer is in the dump image and the dump has a record of the object starting at the place where the pointer points, we definitely have an object. If the pointer is in the dump image and the dump has no idea what the pointer is pointing at, we definitely _don't_ have an object. */ - if (pdumper_object_p (p)) + if (pdumper_object_p (po)) { /* Don't use pdumper_object_p_precise here! It doesn't check the tag bits. OBJ here might be complete garbage, so we need to verify both the pointer and the tag. */ + if (pdumper_find_object_type (po) == type_tag) + mark_object (obj); + return; + } + + struct mem_node *m = mem_find (po); + + if (m != MEM_NIL) + { + bool mark_p = false; + + switch (type_tag) + { + case Lisp_String: + mark_p = m->type == MEM_TYPE_STRING && live_string_p (m, po); + break; + + case Lisp_Cons: + mark_p = m->type == MEM_TYPE_CONS && live_cons_p (m, po); + break; + + case Lisp_Symbol: + mark_p = m->type == MEM_TYPE_SYMBOL && live_symbol_p (m, po); + break; + + case Lisp_Float: + mark_p = m->type == MEM_TYPE_FLOAT && live_float_p (m, po); + break; + + case Lisp_Vectorlike: + mark_p = (m->type == MEM_TYPE_VECTOR_BLOCK + ? live_small_vector_p (m, po) + : (m->type == MEM_TYPE_VECTORLIKE + && live_large_vector_p (m, po))); + break; + + default: + eassume (false); + } + + if (mark_p) + mark_object (obj); + } +} + +void +mark_maybe_objects (Lisp_Object const *array, ptrdiff_t nelts) +{ + for (Lisp_Object const *lim = array + nelts; array < lim; array++) + mark_maybe_object (*array); +} + +/* If P points to Lisp data, mark that as live if it isn't already + marked. */ + +static void +mark_maybe_pointer (void *p) +{ + struct mem_node *m; + +#if USE_VALGRIND + VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); +#endif + + if (pdumper_object_p (p)) + { int type = pdumper_find_object_type (p); if (pdumper_valid_object_type_p (type)) mark_object (type == Lisp_Symbol ? make_lisp_symbol (p) : make_lisp_ptr (p, type)); + /* See mark_maybe_object for why we can confidently return. */ return; } @@ -4750,12 +4762,9 @@ mark_maybe_pointer (void *p) break; case MEM_TYPE_FLOAT: - { - struct Lisp_Float *h = live_float_holding (m, p); - if (!h) - return; - obj = make_lisp_ptr (h, Lisp_Float); - } + if (! live_float_p (m, p)) + return; + obj = make_lisp_ptr (p, Lisp_Float); break; case MEM_TYPE_VECTORLIKE: @@ -4840,6 +4849,11 @@ mark_memory (void const *start, void const *end) intptr_t ip; INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip); mark_maybe_pointer ((void *) ip); + + verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0); + if (alignof (Lisp_Object) == GC_POINTER_ALIGNMENT + || (uintptr_t) pp % alignof (Lisp_Object) == 0) + mark_maybe_object (*(Lisp_Object const *) pp); } } @@ -6247,6 +6261,7 @@ mark_vectorlike (union vectorlike_header *header) { struct Lisp_Vector *ptr = (struct Lisp_Vector *) header; ptrdiff_t size = ptr->header.size; + ptrdiff_t i; eassert (!vector_marked_p (ptr)); @@ -6261,7 +6276,8 @@ mark_vectorlike (union vectorlike_header *header) the number of Lisp_Object fields that we should trace. The distinction is used e.g. by Lisp_Process which places extra non-Lisp_Object fields at the end of the structure... */ - mark_objects (ptr->contents, size); + for (i = 0; i < size; i++) /* ...and then mark its elements. */ + mark_object (ptr->contents[i]); } /* Like mark_vectorlike but optimized for char-tables (and @@ -6360,7 +6376,8 @@ mark_face_cache (struct face_cache *c) { if (c) { - for (int i = 0; i < c->used; i++) + int i, j; + for (i = 0; i < c->used; ++i) { struct face *face = FACE_FROM_ID_OR_NULL (c->f, i); @@ -6369,7 +6386,8 @@ mark_face_cache (struct face_cache *c) if (face->font && !vectorlike_marked_p (&face->font->header)) mark_vectorlike (&face->font->header); - mark_objects (face->lface, LFACE_VECTOR_SIZE); + for (j = 0; j < LFACE_VECTOR_SIZE; ++j) + mark_object (face->lface[j]); } } } @@ -6482,13 +6500,6 @@ mark_hash_table (struct Lisp_Vector *ptr) } } -void -mark_objects (Lisp_Object *obj, ptrdiff_t n) -{ - for (ptrdiff_t i = 0; i < n; i++) - mark_object (obj[i]); -} - /* Determine type of generic Lisp_Object and mark it accordingly. This function implements a straightforward depth-first marking diff --git a/src/eval.c b/src/eval.c index 126ee2e955..9daae92e55 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3960,7 +3960,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) break; case SPECPDL_UNWIND_ARRAY: - mark_objects (pdl->unwind_array.array, pdl->unwind_array.nelts); + mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts); break; case SPECPDL_UNWIND_EXCURSION: @@ -3974,7 +3974,8 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) mark_object (backtrace_function (pdl)); if (nargs == UNEVALLED) nargs = 1; - mark_objects (backtrace_args (pdl), nargs); + while (nargs--) + mark_object (backtrace_args (pdl)[nargs]); } break; diff --git a/src/fringe.c b/src/fringe.c index 75496692d5..c3d64fefc8 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1733,7 +1733,11 @@ If nil, also continue lines which are exactly as wide as the window. */); void mark_fringe_data (void) { - mark_objects (fringe_faces, max_fringe_bitmaps); + int i; + + for (i = 0; i < max_fringe_bitmaps; i++) + if (!NILP (fringe_faces[i])) + mark_object (fringe_faces[i]); } /* Initialize this module when Emacs starts. */ diff --git a/src/keyboard.c b/src/keyboard.c index 590d183c4c..5fa58abce1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12475,11 +12475,13 @@ keys_of_keyboard (void) void mark_kboards (void) { - for (KBOARD *kb = all_kboards; kb; kb = kb->next_kboard) + KBOARD *kb; + Lisp_Object *p; + for (kb = all_kboards; kb; kb = kb->next_kboard) { if (kb->kbd_macro_buffer) - mark_objects (kb->kbd_macro_buffer, - kb->kbd_macro_ptr - kb->kbd_macro_buffer); + for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) + mark_object (*p); mark_object (KVAR (kb, Voverriding_terminal_local_map)); mark_object (KVAR (kb, Vlast_command)); mark_object (KVAR (kb, Vreal_last_command)); diff --git a/src/lisp.h b/src/lisp.h index 88e69b9061..bc069ef277 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3756,12 +3756,12 @@ extern AVOID memory_full (size_t); extern AVOID buffer_memory_full (ptrdiff_t); extern bool survives_gc_p (Lisp_Object); extern void mark_object (Lisp_Object); -extern void mark_objects (Lisp_Object *, ptrdiff_t); #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC extern void refill_memory_reserve (void); #endif extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); +extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t); extern void mark_stack (char const *, char const *); extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg); @@ -4873,10 +4873,7 @@ safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val) (buf) = AVAIL_ALLOCA (alloca_nbytes); \ else \ { \ - /* Although only the first nelt words need clearing, \ - typically EXTRA is 0 or small so just use xzalloc; \ - this is simpler and often faster. */ \ - (buf) = xzalloc (alloca_nbytes); \ + (buf) = xmalloc (alloca_nbytes); \ record_unwind_protect_array (buf, nelt); \ } \ } while (false) commit c449a00aa51185486d76ebf602d84e189af702c0 Merge: a4e45a13b6 54070a5e20 Author: Eli Zaretskii Date: Thu Sep 3 20:20:56 2020 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit a4e45a13b65c496a0c53b58992a4be2e3d923325 Author: Eli Zaretskii Date: Thu Sep 3 20:16:33 2020 +0300 Fix 'expand-file-name' for remote files This reverts most of commit 14fb657ba82da346d36f05f88da26f1c5498b798 and its followup fixes, and instead fixes the original bugs in a different manner that doesn't affect any unrelated use cases. As part of this, the code which caused 'expand-file-name' to enforce a trailing slash on expanded directories is removed, as this kind of semantic processing is outside of 'expand-file-name's scope. * src/fileio.c (Fexpand_file_name): If expanding default_directory yields a remote file name, call its handlers. (Bug#26911) (Bug#34834) * doc/lispref/files.texi (File Name Expansion): Remove the requirement that expanding a directory name yields a directory name, i.e. that the expansion must end in a slash. * etc/NEWS: Remove the announcement of the changed behavior of 'expand-file-name' wrt trailing slashes. * test/src/fileio-tests.el (fileio-tests--HOME-trailing-slash) (fileio-tests--expand-file-name-trailing-slash): Remove tests. * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name): No need to expect different results in Emacs 28 and later. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 090c54f8cd..92cbc2a1c9 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2438,26 +2438,14 @@ This is for the sake of filesystems that have the concept of a superroot above the root directory @file{/}. On other filesystems, @file{/../} is interpreted exactly the same as @file{/}. -If a filename must be that of a directory, its expansion must be too. -For example, if a filename ends in @samp{/} or @samp{/.} or @samp{/..} -then its expansion ends in @samp{/} so that it cannot be -misinterpreted as the name of a symbolic link: - -@example -@group -(expand-file-name "/a///b//.") - @result{} "/a/b/" -@end group -@end example - Expanding @file{.} or the empty string returns the default directory: @example @group (expand-file-name "." "/usr/spool/") - @result{} "/usr/spool/" + @result{} "/usr/spool" (expand-file-name "" "/usr/spool/") - @result{} "/usr/spool/" + @result{} "/usr/spool" @end group @end example diff --git a/etc/NEWS b/etc/NEWS index 1cb1b7ee4f..38cfeaee9b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1181,12 +1181,6 @@ region's (or buffer's) end. This function can be used by modes to add elements to the 'choice' customization type of a variable. -+++ -** 'expand-file-name' no longer omits a trailing slash if the omission -changes the filename's meaning. E.g., (expand-file-name "/a/b/.") now -returns "/a/b/" not "/a/b", which might be misinterpreted as the name -of a symbolic link rather than of the directory it points to. - +++ ** New function 'file-modes-number-to-symbolic' to convert a numeric file mode specification into symbolic form. diff --git a/src/fileio.c b/src/fileio.c index c91af36fdf..1e4ca82e5f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -827,9 +827,9 @@ the root directory. */) ptrdiff_t tlen; #ifdef DOS_NT int drive = 0; + bool collapse_newdir = true; bool is_escaped = 0; #endif /* DOS_NT */ - bool collapse_newdir = true; ptrdiff_t length, nbytes; Lisp_Object handler, result, handled_name; bool multibyte; @@ -947,6 +947,22 @@ the root directory. */) ) { default_directory = Fexpand_file_name (default_directory, Qnil); + + /* The above expansion might have produced a remote file name, + so give the handlers one last chance to DTRT. This can + happen when both NAME and DEFAULT-DIRECTORY arguments are + relative file names, and the buffer's default-directory is + remote. */ + handler = Ffind_file_name_handler (default_directory, + Qexpand_file_name); + if (!NILP (handler)) + { + handled_name = call3 (handler, Qexpand_file_name, + name, default_directory); + if (STRINGP (handled_name)) + return handled_name; + error ("Invalid handler in `file-name-handler-alist'"); + } } } multibyte = STRING_MULTIBYTE (name); @@ -1065,7 +1081,7 @@ the root directory. */) #endif /* WINDOWSNT */ #endif /* DOS_NT */ - /* If nm is absolute, look for "/./" or "/../" or "//" sequences; if + /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if none are found, we can probably return right away. We will avoid allocating a new string if name is already fully expanded. */ if ( @@ -1183,7 +1199,9 @@ the root directory. */) newdir = SSDATA (hdir); newdirlim = newdir + SBYTES (hdir); } +#ifdef DOS_NT collapse_newdir = false; +#endif } else /* ~user/filename */ { @@ -1203,7 +1221,9 @@ the root directory. */) while (*++nm && !IS_DIRECTORY_SEP (*nm)) continue; +#ifdef DOS_NT collapse_newdir = false; +#endif } /* If we don't find a user of that name, leave the name @@ -1370,15 +1390,12 @@ the root directory. */) } #endif /* DOS_NT */ - length = newdirlim - newdir; - -#ifdef DOS_NT /* Ignore any slash at the end of newdir, unless newdir is just "/" or "//". */ + length = newdirlim - newdir; while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0]))) length--; -#endif /* Now concatenate the directory and name to new space in the stack frame. */ tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1; @@ -1392,16 +1409,12 @@ the root directory. */) #else /* not DOS_NT */ target = SAFE_ALLOCA (tlen); #endif /* not DOS_NT */ + *target = 0; nbytes = 0; if (newdir) { -#ifndef DOS_NT - bool treat_as_absolute = !collapse_newdir; -#else - bool treat_as_absolute = !nm[0] || IS_DIRECTORY_SEP (nm[0]); -#endif - if (treat_as_absolute) + if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) { #ifdef DOS_NT /* If newdir is effectively "C:/", then the drive letter will have @@ -1413,23 +1426,13 @@ the root directory. */) && newdir[1] == '\0')) #endif { - /* With ~ or ~user, leave NEWDIR as-is to avoid transforming - it from a symlink (or a regular file!) into a directory. */ memcpy (target, newdir, length); + target[length] = 0; nbytes = length; } } else nbytes = file_name_as_directory (target, newdir, length, multibyte); - -#ifndef DOS_NT - /* If TARGET ends in a directory separator, omit leading - directory separators from NM so that concatenating a TARGET "/" - to an NM "/foo" does not result in the incorrect "//foo". */ - if (nbytes && IS_DIRECTORY_SEP (target[nbytes - 1])) - while (IS_DIRECTORY_SEP (nm[0])) - nm++; -#endif } memcpy (target + nbytes, nm, nmlim - nm + 1); @@ -1446,20 +1449,6 @@ the root directory. */) { *o++ = *p++; } -#ifndef DOS_NT - else if (p[1] == '.' && IS_DIRECTORY_SEP (p[2])) - { - /* Replace "/./" with "/". */ - p += 2; - } - else if (p[1] == '.' && !p[2]) - { - /* At the end of the file name, replace "/." with "/". - The trailing "/" is for symlinks. */ - *o++ = *p; - p += 2; - } -#else else if (p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0)) @@ -1470,7 +1459,6 @@ the root directory. */) *o++ = *p; p += 2; } -#endif else if (p[1] == '.' && p[2] == '.' /* `/../' is the "superroot" on certain file systems. Turned off on DOS_NT systems because they have no @@ -1484,35 +1472,21 @@ the root directory. */) #endif && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) { -#ifndef DOS_NT - while (o != target) - { - o--; - if (IS_DIRECTORY_SEP (*o)) - { - /* Keep "/" at the end of the name, for symlinks. */ - o += p[3] == 0; - - break; - } - } -#else -# ifdef WINDOWSNT +#ifdef WINDOWSNT char *prev_o = o; -# endif +#endif while (o != target && (--o, !IS_DIRECTORY_SEP (*o))) continue; -# ifdef WINDOWSNT +#ifdef WINDOWSNT /* Don't go below server level in UNC filenames. */ if (o == target + 1 && IS_DIRECTORY_SEP (*o) && IS_DIRECTORY_SEP (*target)) o = prev_o; else -# endif +#endif /* Keep initial / only if this is the whole name. */ if (o == target && IS_ANY_SEP (*o) && p[3] == 0) ++o; -#endif p += 3; } else if (IS_DIRECTORY_SEP (p[1]) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 71c6302e0e..c170d2c6bf 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2139,19 +2139,16 @@ is greater than 10. (expand-file-name "/method:host:/path/../file") "/method:host:/file")) (should (string-equal - (expand-file-name "/method:host:/path/.") - (if (tramp--test-emacs28-p) "/method:host:/path/" "/method:host:/path"))) + (expand-file-name "/method:host:/path/.") "/method:host:/path")) (should (string-equal (expand-file-name "/method:host:/path/..") "/method:host:/")) (should (string-equal - (expand-file-name "." "/method:host:/path/") - (if (tramp--test-emacs28-p) "/method:host:/path/" "/method:host:/path"))) + (expand-file-name "." "/method:host:/path/") "/method:host:/path")) (should (string-equal - (expand-file-name "" "/method:host:/path/") - (if (tramp--test-emacs28-p) "/method:host:/path/" "/method:host:/path"))) + (expand-file-name "" "/method:host:/path/") "/method:host:/path")) ;; Quoting local part. (should (string-equal diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index bedda83bbd..ed381d151e 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -107,43 +107,6 @@ Also check that an encoding error can appear in a symlink." (setenv "HOME" "x:foo") (should (equal (expand-file-name "~/bar") "x:/foo/bar"))))) -(ert-deftest fileio-tests--HOME-trailing-slash () - "Test that expand-file-name of \"~\" respects trailing slash." - :expected-result (if (memq system-type '(windows-nt ms-dos)) - :failed - :passed) - (let ((process-environment (copy-sequence process-environment))) - (dolist (home - (if (memq system-type '(windows-nt ms-dos)) - '("c:/a/b/c" "c:/a/b/c/") - '("/a/b/c" "/a/b/c/"))) - (setenv "HOME" home) - (should (equal (expand-file-name "~") (expand-file-name home)))))) - -(ert-deftest fileio-tests--expand-file-name-trailing-slash () - (dolist (fooslashalias '("foo/" "foo//" "foo/." "foo//." "foo///././." - "foo/a/..")) - (if (memq system-type '(windows-nt ms-dos)) - (progn - (should (equal (expand-file-name fooslashalias "c:/") "c:/foo/")) - (should (equal (expand-file-name (concat "c:/" fooslashalias)) - "c:/foo/")) - (should (equal (expand-file-name "." "c:/usr/spool/") - "c:/usr/spool/")) - (should (equal (expand-file-name "" "c:/usr/spool/") - "c:/usr/spool/"))) - (should (equal (expand-file-name fooslashalias "/") "/foo/")) - (should (equal (expand-file-name (concat "/" fooslashalias)) "/foo/")) - (should (equal (expand-file-name "." "/usr/spool/") "/usr/spool/")) - (should (equal (expand-file-name "" "/usr/spool/") "/usr/spool/")))) - ;; Trailing "B/C/.." means B must be a directory. - (if (memq system-type '(windows-nt ms-dos)) - (progn - (should (equal (expand-file-name "c:/a/b/c/..") "c:/a/b/")) - (should (equal (expand-file-name "c:/a/b/c/../") "c:/a/b/"))) - (should (equal (expand-file-name "/a/b/c/..") "/a/b/")) - (should (equal (expand-file-name "/a/b/c/../") "/a/b/")))) - (ert-deftest fileio-tests--insert-file-interrupt () (let ((text "-*- coding: binary -*-\n\xc3\xc3help") f) commit 54070a5e207f11fbea5adef1dbd7709f42232f0b Author: Stefan Kangas Date: Thu Sep 3 17:19:15 2020 +0200 Fix my previous change to cancel world-clock timer * lisp/time.el (subr-x): Require when compiling. (world-clock): Set 'kill-buffer-hook' buffer locally only. (world-clock-update): Break out timer cancellation from here... (world-clock-cancel-timer): ...to here, and don't rely on variable to find the timer to cancel. (world-clock-timer): Delete now superfluous variable. diff --git a/lisp/time.el b/lisp/time.el index 5ced920552..534f128342 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) + (defgroup display-time nil "Display time and load in mode line of Emacs." :group 'mode-line @@ -523,8 +525,6 @@ See `world-clock'." (setq-local revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) -(defvar world-clock-timer nil) - (defun world-clock-display (alist) "Replace current buffer text with times in various zones, based on ALIST." (let ((inhibit-read-only t) @@ -561,34 +561,31 @@ See `world-clock'." The variable `world-clock-list' specifies which time zones to use. To turn off the world time display, go to the window and type `\\[quit-window]'." (interactive) - (when (and world-clock-timer-enable - (not (get-buffer world-clock-buffer-name))) - (setq world-clock-timer - (run-at-time t world-clock-timer-second #'world-clock-update)) - (add-hook 'kill-buffer-hook #'world-clock-cancel-timer)) - (pop-to-buffer world-clock-buffer-name) + (if-let ((buffer (get-buffer world-clock-buffer-name))) + (pop-to-buffer buffer) + (pop-to-buffer world-clock-buffer-name) + (when world-clock-timer-enable + (run-at-time t world-clock-timer-second #'world-clock-update) + (add-hook 'kill-buffer-hook #'world-clock-cancel-timer nil t))) (world-clock-display (time--display-world-list)) (world-clock-mode) (fit-window-to-buffer)) (defun world-clock-cancel-timer () "Cancel the world clock timer." - (when world-clock-timer - (cancel-timer world-clock-timer) - (setq world-clock-timer nil))) + (let ((list timer-list)) + (while list + (let ((elt (pop list))) + (when (equal (symbol-name (timer--function elt)) + "world-clock-update") + (cancel-timer elt)))))) (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." (if (get-buffer world-clock-buffer-name) (with-current-buffer (get-buffer world-clock-buffer-name) (world-clock-display (time--display-world-list))) - ;; cancel timer - (let ((list timer-list)) - (while list - (let ((elt (pop list))) - (when (equal (symbol-name (timer--function elt)) - "world-clock-update") - (cancel-timer elt))))))) + (world-clock-cancel-timer))) ;;;###autoload (defun emacs-uptime (&optional format) commit 8cb15183aa8faba4af52d7b87e5ee4dcd3b1104f Author: Eli Zaretskii Date: Thu Sep 3 15:59:46 2020 +0300 Fix vertical cursor motion when 'visual-line-mode' is in effect * src/xdisp.c (move_it_in_display_line_to): Fix a logic error made as part of introducing the 'word-wrap-by-category' feature; that error brought back bug#8155. diff --git a/src/xdisp.c b/src/xdisp.c index dd73758043..406b2d70d5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9532,7 +9532,7 @@ move_it_in_display_line_to (struct it *it, we can't wrap here. Therefore, wrap_it (previously found wrap-point) _is_ relevant in that case. */ - && !(moved_forward && char_can_wrap_before (it))) + && (!moved_forward || char_can_wrap_before (it))) { /* If we've found TO_X, go back there, as we now know the last word fits on this screen line. */ commit 5142149758333cfddc25c8c696e0e6f322e37d62 Author: João Távora Date: Thu Sep 3 13:34:08 2020 +0100 Unbreak project.el, the GNU Elpa package, for Emacs 26.3 Fixes: bug#43164 * lisp/progmodes/project.el: Bump to 0.5.2 (bound-and-true-p): Check that tab-prefix-map is bound before binding. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4fae3e9186..7180ba317c 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. -;; Version: 0.5.1 +;; Version: 0.5.2 ;; Package-Requires: ((emacs "26.3") (xref "1.0.2")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -667,7 +667,9 @@ The following commands are available: (interactive) (project--other-place-command '((display-buffer-in-new-tab)))) -;;;###autoload (define-key tab-prefix-map "p" #'project-other-tab-command) +;;;###autoload +(when (bound-and-true-p tab-prefix-map) + (define-key tab-prefix-map "p" #'project-other-tab-command)) (declare-function grep-read-files "grep") (declare-function xref--show-xrefs "xref") commit 73d202e4503c0f960dac00bb891d22d82814d38a Author: Stefan Kangas Date: Thu Sep 3 14:31:46 2020 +0200 * lisp/eshell/esh-mode.el: Remove redundant :group args. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 791d472ec0..ecdfd285f9 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -72,51 +72,43 @@ (defcustom eshell-mode-unload-hook nil "A hook that gets run when `eshell-mode' is unloaded." - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-mode-hook nil "A hook that gets run when `eshell-mode' is entered." - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-first-time-mode-hook nil "A hook that gets run the first time `eshell-mode' is entered. That is to say, the first time during an Emacs session." - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-exit-hook nil "A hook that is run whenever `eshell' is exited. This hook is only run if exiting actually kills the buffer." :version "24.1" ; removed eshell-query-kill-processes - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-kill-on-exit t "If non-nil, kill the Eshell buffer on the `exit' command. Otherwise, the buffer will simply be buried." - :type 'boolean - :group 'eshell-mode) + :type 'boolean) (defcustom eshell-input-filter-functions nil "Functions to call before input is processed. The input is contained in the region from `eshell-last-input-start' to `eshell-last-input-end'." - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-send-direct-to-subprocesses nil "If t, send any input immediately to a subprocess." - :type 'boolean - :group 'eshell-mode) + :type 'boolean) (defcustom eshell-expand-input-functions nil "Functions to call before input is parsed. Each function is passed two arguments, which bounds the region of the current input text." - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-scroll-to-bottom-on-input nil "Controls whether input to interpreter causes window to scroll. @@ -126,8 +118,7 @@ buffer. If `this', scroll only the selected window. See `eshell-preinput-scroll-to-bottom'." :type '(radio (const :tag "Do not scroll Eshell windows" nil) (const :tag "Scroll all windows showing the buffer" all) - (const :tag "Scroll only the selected window" this)) - :group 'eshell-mode) + (const :tag "Scroll only the selected window" this))) (defcustom eshell-scroll-to-bottom-on-output nil "Controls whether interpreter output causes window to scroll. @@ -140,8 +131,7 @@ See variable `eshell-scroll-show-maximum-output' and function :type '(radio (const :tag "Do not scroll Eshell windows" nil) (const :tag "Scroll all windows showing the buffer" all) (const :tag "Scroll only the selected window" this) - (const :tag "Scroll all windows other than selected" others)) - :group 'eshell-mode) + (const :tag "Scroll all windows other than selected" others))) (defcustom eshell-scroll-show-maximum-output t "Controls how interpreter output causes window to scroll. @@ -149,16 +139,14 @@ If non-nil, then show the maximum output when the window is scrolled. See variable `eshell-scroll-to-bottom-on-output' and function `eshell-postoutput-scroll-to-bottom'." - :type 'boolean - :group 'eshell-mode) + :type 'boolean) (defcustom eshell-buffer-maximum-lines 1024 "The maximum size in lines for eshell buffers. Eshell buffers are truncated from the top to be no greater than this number, if the function `eshell-truncate-buffer' is on `eshell-output-filter-functions'." - :type 'integer - :group 'eshell-mode) + :type 'integer) (defcustom eshell-output-filter-functions '(eshell-postoutput-scroll-to-bottom @@ -168,36 +156,31 @@ number, if the function `eshell-truncate-buffer' is on "Functions to call before output is displayed. These functions are only called for output that is displayed interactively, and not for output which is redirected." - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-preoutput-filter-functions nil "Functions to call before output is inserted into the buffer. These functions get one argument, a string containing the text to be inserted. They return the string as it should be inserted." - :type 'hook - :group 'eshell-mode) + :type 'hook) (defcustom eshell-password-prompt-regexp (format "\\(%s\\)[^:：៖]*[:：៖]\\s *\\'" (regexp-opt password-word-equivalents)) "Regexp matching prompts for passwords in the inferior process. This is used by `eshell-watch-for-password-prompt'." :type 'regexp - :version "27.1" - :group 'eshell-mode) + :version "27.1") (defcustom eshell-skip-prompt-function nil "A function called from beginning of line to skip the prompt." - :type '(choice (const nil) function) - :group 'eshell-mode) + :type '(choice (const nil) function)) (define-obsolete-variable-alias 'eshell-status-in-modeline 'eshell-status-in-mode-line "24.3") (defcustom eshell-status-in-mode-line t "If non-nil, let the user know a command is running in the mode line." - :type 'boolean - :group 'eshell-mode) + :type 'boolean) (defcustom eshell-directory-name (locate-user-emacs-file "eshell/" ".eshell/") commit 23ee78b00512ea0001f8e21646a725ac13c96e17 Author: Stefan Kangas Date: Thu Sep 3 14:30:53 2020 +0200 Support bookmarking Eshell buffers * lisp/eshell/esh-mode.el (eshell-bookmark-name) (eshell-bookmark-make-record, eshell-bookmark-jump): New defuns. (eshell-mode): Set up bookmark handler. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 8799007c59..791d472ec0 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -329,6 +329,8 @@ and the hook `eshell-exit-hook'." (if mode-line-elt (setcar mode-line-elt 'eshell-command-running-string)))) + (set (make-local-variable 'bookmark-make-record-function) + 'eshell-bookmark-make-record) (setq local-abbrev-table eshell-mode-abbrev-table) (set (make-local-variable 'list-buffers-directory) @@ -1015,5 +1017,28 @@ This function could be in the list `eshell-output-filter-functions'." (custom-add-option 'eshell-output-filter-functions 'eshell-handle-ansi-color) +;;; Bookmark support: + +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) + +(defun eshell-bookmark-name () + (format "eshell-%s" + (file-name-nondirectory + (directory-file-name + (file-name-directory default-directory))))) + +(defun eshell-bookmark-make-record () + "Create a bookmark for the current Eshell buffer." + `(,(eshell-bookmark-name) + (location . ,default-directory) + (handler . eshell-bookmark-jump))) + +(defun eshell-bookmark-jump (bookmark) + "Default bookmark handler for Eshell buffers." + (let ((default-directory (bookmark-prop-get bookmark 'location))) + (eshell))) + (provide 'esh-mode) ;;; esh-mode.el ends here commit d37861535dfd452f7c2255ae5edcf7686b75fe5a Author: Stefan Kangas Date: Thu Sep 3 12:54:30 2020 +0200 Cancel timer when world-clock buffer is killed * lisp/time.el (world-clock-timer): New variable. (world-clock-cancel-timer): New defun. (world-clock): Add 'world-clock-cancel-timer' to 'kill-buffer-hook'. diff --git a/lisp/time.el b/lisp/time.el index 1ab992adb4..5ced920552 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -523,6 +523,8 @@ See `world-clock'." (setq-local revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) +(defvar world-clock-timer nil) + (defun world-clock-display (alist) "Replace current buffer text with times in various zones, based on ALIST." (let ((inhibit-read-only t) @@ -561,12 +563,20 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (interactive) (when (and world-clock-timer-enable (not (get-buffer world-clock-buffer-name))) - (run-at-time t world-clock-timer-second #'world-clock-update)) + (setq world-clock-timer + (run-at-time t world-clock-timer-second #'world-clock-update)) + (add-hook 'kill-buffer-hook #'world-clock-cancel-timer)) (pop-to-buffer world-clock-buffer-name) (world-clock-display (time--display-world-list)) (world-clock-mode) (fit-window-to-buffer)) +(defun world-clock-cancel-timer () + "Cancel the world clock timer." + (when world-clock-timer + (cancel-timer world-clock-timer) + (setq world-clock-timer nil))) + (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." (if (get-buffer world-clock-buffer-name)