commit 0c640b82f0b3d9a06156a61af0aeec11a2f98ba0 (HEAD, refs/remotes/origin/master) Author: Gabriel do Nascimento Ribeiro Date: Mon Aug 23 19:05:58 2021 -0300 Fix to clear echo-area after repeat-exit-timeout. * lisp/repeat.el (repeat-echo-message): Use 'string-match-p' to handle cases where echo-area contains other messages (bug#50176). diff --git a/lisp/repeat.el b/lisp/repeat.el index cec3cb643a..054eacf8ec 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -474,7 +474,7 @@ When Repeat mode is enabled, and the command symbol has the property named (if (current-message) (message "%s [%s]" (current-message) mess) (message mess))) - (when (string-prefix-p "Repeat with " (current-message)) + (when (string-match-p "Repeat with " (current-message)) (message nil)))) (defvar repeat-echo-mode-line-string commit ca3e4b3072884ab157328a4f2a4cf5a12b5d367f Author: Stephen Gildea Date: Mon Aug 23 20:04:02 2021 -0700 ; * lisp/time-stamp.el: Improve doc strings. Thanks to VEB for her help with the clarity of the documentation. diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index ae91171715..f568142e8f 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -44,10 +44,7 @@ (defcustom time-stamp-format "%Y-%02m-%02d %02H:%02M:%02S %l" "Format of the string inserted by \\[time-stamp]. This is a string, used verbatim except for character sequences beginning -with %, as follows. The values of non-numeric formatted items depend -on the locale setting recorded in `system-time-locale' and -`locale-coding-system'. The examples here are for the default -\(`C') locale. +with %, as follows. %:A weekday name: `Monday' %#A gives uppercase: `MONDAY' %3a abbreviated weekday: `Mon' %#a gives uppercase: `MON' @@ -79,6 +76,11 @@ A leading zero in the field width zero-fills a number. For example, to get the format used by the `date' command, use \"%3a %3b %2d %02H:%02M:%02S %Z %Y\". +The values of non-numeric formatted items depend on the locale +setting recorded in `system-time-locale' and `locale-coding-system'. +The examples here are for the default (`C') locale. +`time-stamp-time-zone' controls the time zone used. + The default padding of some formats has changed to be more compatible with format-time-string. To be compatible with older versions of Emacs, specify a padding width (as shown) or use the : modifier to request the @@ -100,6 +102,10 @@ when they are saved, either add this line to your init file: (add-hook \\='before-save-hook \\='time-stamp) or customize option `before-save-hook'. +To enable automatic time-stamping for only a specific file, add this +line to a local variables list near the end of the file: + eval: (add-hook \\='before-save-hook \\='time-stamp nil t) + See also the variable `time-stamp-warn-inactive'." :type 'boolean) @@ -151,26 +157,27 @@ the first (last) `time-stamp-line-limit' lines of the file for the file to be time-stamped by \\[time-stamp]. A value of 0 searches the entire buffer (use with care). -This value can also be set with the variable `time-stamp-pattern'. +It may be more convenient to use `time-stamp-pattern' if you set more +than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', +or `time-stamp-format'. -Do not change `time-stamp-line-limit', `time-stamp-start', -`time-stamp-end', or `time-stamp-pattern' for yourself or you will be -incompatible with other people's files! If you must change them for some -application, do so in the local variables section of the time-stamped file -itself.") +These variables are best changed with file-local variables. +If you change `time-stamp-line-limit', `time-stamp-start', +`time-stamp-end', or `time-stamp-pattern' in your init file, you +will be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-line-limit 'safe-local-variable 'integerp) (defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change! "Regexp after which the time stamp is written by \\[time-stamp]. -See also the variables `time-stamp-end' and `time-stamp-line-limit'. -This value can also be set with the variable `time-stamp-pattern'. +It may be more convenient to use `time-stamp-pattern' if you set more +than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', +or `time-stamp-format'. -Do not change `time-stamp-line-limit', `time-stamp-start', -`time-stamp-end', or `time-stamp-pattern' for yourself or you will be -incompatible with other people's files! If you must change them for some -application, do so in the local variables section of the time-stamped file -itself.") +These variables are best changed with file-local variables. +If you change `time-stamp-line-limit', `time-stamp-start', +`time-stamp-end', or `time-stamp-pattern' in your init file, you +will be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-start 'safe-local-variable 'stringp) (defvar time-stamp-end "\\\\?[\">]" ;Do not change! @@ -179,7 +186,9 @@ itself.") and the following match of `time-stamp-end', then writes the time stamp specified by `time-stamp-format' between them. -This value can also be set with the variable `time-stamp-pattern'. +It may be more convenient to use `time-stamp-pattern' if you set more +than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', +or `time-stamp-format'. The end text normally starts on the same line as the start text ends, but if there are any newlines in `time-stamp-format', the same number @@ -187,10 +196,10 @@ of newlines must separate the start and end. \\[time-stamp] tries to not change the number of lines in the buffer. `time-stamp-inserts-lines' controls this behavior. -Do not change `time-stamp-start', `time-stamp-end', `time-stamp-pattern', -or `time-stamp-inserts-lines' for yourself or you will be incompatible -with other people's files! If you must change them for some application, -do so in the local variables section of the time-stamped file itself.") +These variables are best changed with file-local variables. +If you change `time-stamp-line-limit', `time-stamp-start', +`time-stamp-end', `time-stamp-pattern', or `time-stamp-inserts-lines' in +your init file, you will be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-end 'safe-local-variable 'stringp) @@ -204,10 +213,9 @@ immediately after the start pattern. This behavior can cause unexpected changes in the buffer if used carelessly, but it is useful for generating repeated time stamps. -Do not change `time-stamp-end' or `time-stamp-inserts-lines' for -yourself or you will be incompatible with other people's files! -If you must change them for some application, do so in the local -variables section of the time-stamped file itself.") +These variables are best changed with file-local variables. +If you change `time-stamp-end' or `time-stamp-inserts-lines' in +your init file, you will be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-inserts-lines 'safe-local-variable 'symbolp) @@ -215,10 +223,9 @@ variables section of the time-stamped file itself.") "How many templates \\[time-stamp] will look for in a buffer. The same time stamp will be written in each case. -Do not change `time-stamp-count' for yourself or you will be -incompatible with other people's files! If you must change it for -some application, do so in the local variables section of the -time-stamped file itself.") +`time-stamp-count' is best changed with a file-local variable. +If you change it in your init file, you will be incompatible with +other people's files.") ;;;###autoload(put 'time-stamp-count 'safe-local-variable 'integerp) @@ -244,6 +251,15 @@ part as \"%%\" to use the normal format. The fourth part is a regexp identifying the pattern following the time stamp. This part may be omitted to use the normal pattern. +The pattern does not need to match the entire line of the time stamp. + +These variables are best changed with file-local variables. +If you change `time-stamp-pattern', `time-stamp-line-limit', +`time-stamp-start', or `time-stamp-end' in your init file, you +will be incompatible with other people's files. + +See also `time-stamp-count' and `time-stamp-inserts-lines'. + Examples: \"-10/\" (sets only `time-stamp-line-limit') @@ -255,38 +271,45 @@ Examples: `time-stamp-format' and `time-stamp-end') \"newcommand{\\\\\\\\timestamp}{%%}\" (sets `time-stamp-start' -and `time-stamp-end') - -Do not change `time-stamp-pattern' `time-stamp-line-limit', -`time-stamp-start', or `time-stamp-end' for yourself or you will be -incompatible with other people's files! If you must change them for -some application, do so only in the local variables section of the -time-stamped file itself.") +and `time-stamp-end')") ;;;###autoload(put 'time-stamp-pattern 'safe-local-variable 'stringp) ;;;###autoload (defun time-stamp () - "Update the time stamp string(s) in the buffer. -A template in a file can be automatically updated with a new time stamp -every time you save the file. Add this line to your init file: - (add-hook \\='before-save-hook \\='time-stamp) -or customize option `before-save-hook'. -Normally the template must appear in the first 8 lines of a file and -look like one of the following: + "Update any time stamp string(s) in the buffer. +This function looks for a time stamp template and updates it with +the current date, time, and/or other info. + +The template, which you manually create on one of the first 8 lines +of the file before running this function, by default can look like +one of the following (your choice): Time-stamp: <> Time-stamp: \" \" -The time stamp is written between the brackets or quotes: +This function writes the current time between the brackets or quotes, +by default formatted like this: Time-stamp: <2020-08-07 17:10:21 gildea> -The time stamp is updated only if the variable -`time-stamp-active' is non-nil. -The format of the time stamp is set by the variable -`time-stamp-pattern' or `time-stamp-format'. -The variables `time-stamp-pattern', `time-stamp-line-limit', -`time-stamp-start', `time-stamp-end', `time-stamp-count', and -`time-stamp-inserts-lines' control finding the template." +Although you can run this function manually to update a time stamp +once, usually you want automatic time stamp updating. + +A time stamp can be automatically updated with current information +every time you save a file. To enable time-stamping for all files, +customize option `before-save-hook' or add this line to your init file: + (add-hook \\='before-save-hook \\='time-stamp) + +To enable automatic time-stamping for only a specific file, add +this line to a local variables list near the end of the file: + eval: (add-hook \\='before-save-hook \\='time-stamp nil t) + +If the first 8 lines of the file do not have a time-stamp template, +this function does nothing. + +You can set `time-stamp-pattern' in a files's local variables list +to customize the information in the time stamp and where it is written. + +The time stamp is updated only if `time-stamp-active' is non-nil." (interactive) (let ((line-limit time-stamp-line-limit) (ts-start time-stamp-start) @@ -431,6 +454,8 @@ With ARG, turn time stamping on if and only if ARG is positive." (message "time-stamp is now %s." (if time-stamp-active "active" "off"))) (defun time-stamp--format (format time) + "FORMAT a TIME in zone `time-stamp-time-zone'. +Internal helper used by `time-stamp-string-preprocess'." (format-time-string format time time-stamp-time-zone)) (defun time-stamp-string (&optional ts-format time) @@ -457,7 +482,7 @@ normally the current time is used." (defun time-stamp-string-preprocess (format &optional time) "Use a FORMAT to format date, time, file, and user information. Optional second argument TIME is only for testing. -Implements extensions to `format-time-string' +This is an internal routine implementing extensions to `format-time-string' and all `time-stamp-format' compatibility." (let ((fmt-len (length format)) (ind 0) @@ -682,14 +707,15 @@ and all `time-stamp-format' compatibility." (defun time-stamp-do-number (format-char alt-form field-width time) "Handle compatible FORMAT-CHAR where only default width/padding will change. ALT-FORM is whether `#' specified. FIELD-WIDTH is the string -width specification or \"\". TIME is the time to convert." +width specification or \"\". TIME is the time to convert. +This is an internal helper for `time-stamp-string-preprocess'." (let ((format-string (concat "%" (char-to-string format-char)))) (if (and (> alt-form 0) (not (string-equal field-width ""))) "" ;discourage "%:2d" and the like (string-to-number (time-stamp--format format-string time))))) (defvar time-stamp-conversion-warn t - "Warn about soon-to-be-unsupported forms in `time-stamp-format'. + "Enable warnings about soon-to-be-unsupported forms in `time-stamp-format'. If nil, these warnings are disabled, which would be a bad idea! You really need to update your files instead. @@ -755,7 +781,7 @@ Suggests replacing OLD-FORM with NEW-FORM." ;; Principles guiding our choices: ;; ;; - The syntax should be easy to remember and the effect predictable. -;; - It should be possible to produces as many useful effects as possible. +;; - The syntax should enable as many useful effects as possible. ;; ;; Padding choices: ;; @@ -789,21 +815,21 @@ Suggests replacing OLD-FORM with NEW-FORM." ;; %07:z "+99:00:00" "+100:00" ;; %7::z "+99:00:00" "+100:00:00" -;;; * BNF syntax of the offset string produced by %z - -;; ::= [[]] | -;; [[]] | -;; [] -;; ::= "+"|"-" -;; ::= <2digits> -;; ::= <2digits> -;; ::= <2digits> -;; ::= ":" -;; ::= ":" -;; <2digits> ::= -;; ::= "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9" -;; ::= *<2digits> -;; ::= " "* +;;; * ABNF syntax of the offset string produced by %z + +;; offset = sign hours [minutes [seconds]] padding / +;; sign hours [colonminutes [colonseconds]] padding / +;; sign bighours colonminutes [colonseconds] padding +;; sign = "+" / "-" +;; hours = digitpair +;; minutes = digitpair +;; seconds = digitpair +;; colonminutes = ":" minutes +;; colonseconds = ":" seconds +;; digitpair = digit digit +;; digit = "0" / "1" / "2" / "3" / "4" / "5" / "6" / "7" / "8" / "9" +;; bighours = 1*digit digitpair +;; padding = *" " (defun time-stamp-formatz-from-parsed-options (flag-minimize flag-pad-spaces-only commit 120b2bb67b6186427ca1a007f1a11ddf3e220c5b Author: Stephen Gildea Date: Mon Aug 23 19:58:13 2021 -0700 ; migrate MH-E to mail-parse library Move MH-E from low-level libraries to the high-level mail-parse library. * lisp/mh-e/mh-comp.el: replace ietf-drums-parse-address with mail-header-parse-address. * lisp/mh-e/mh-junk.el: replace ietf-drums-parse-address with mail-header-parse-address; remove mh-funcall-if-exists wrapper. * lisp/mh-e/mh-xface.el: replace ietf-drums-parse-address with mail-header-parse-address; remove fboundp wrapper. * lisp/mh-e/mh-mime.el: replace rfc2047-decode-region with mail-decode-encoded-word-region. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 4fae69defa..404b6b3ce7 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -38,6 +38,7 @@ (require 'sendmail) (autoload 'easy-menu-add "easymenu") +(autoload 'mail-header-parse-address "mail-parse") (autoload 'mml-insert-tag "mml") @@ -452,7 +453,7 @@ See also `mh-send'." ;; Header field exists and we have a value (let (address mailbox (alias (mh-alias-expand value))) (and alias - (setq address (ietf-drums-parse-address alias)) + (setq address (mail-header-parse-address alias)) (setq mailbox (car address))) ;; XXX - Need to parse all addresses out of field (if (and diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index 6c3674811b..467667f5af 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -31,6 +31,8 @@ (require 'mh-e) (require 'mh-scan) +(autoload 'mail-header-parse-address "mail-parse") + ;;;###mh-autoload (defun mh-junk-blocklist (range) "Blocklist RANGE as spam. @@ -312,8 +314,7 @@ See `mh-spamassassin-blocklist' for more information." "--ham" "--local" "--no-sync"))) (message "Allowlisting sender of message %d..." msg) (setq from - (car (mh-funcall-if-exists - ietf-drums-parse-address (mh-get-header-field "From:")))) + (car (mail-header-parse-address (mh-get-header-field "From:")))) (kill-buffer nil) (if (or (null from) (equal from "")) (message "Allowlisting sender of message %d...%s" diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index ef702525b7..ad594aef90 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -51,6 +51,7 @@ (autoload 'article-emphasize "gnus-art") (autoload 'gnus-eval-format "gnus-spec") (autoload 'mail-content-type-get "mail-parse") +(autoload 'mail-decode-encoded-word-region "mail-parse") (autoload 'mail-decode-encoded-word-string "mail-parse") (autoload 'mail-header-parse-content-type "mail-parse") (autoload 'mail-header-strip-cte "mail-parse") @@ -61,7 +62,6 @@ (autoload 'mm-decode-body "mm-bodies") (autoload 'mm-uu-dissect "mm-uu") (autoload 'mml-unsecure-message "mml-sec") -(autoload 'rfc2047-decode-region "rfc2047") (autoload 'widget-convert-button "wid-edit") @@ -496,7 +496,7 @@ decoding the same message multiple times." "Decode RFC2047 encoded message header fields." (when mh-decode-mime-flag (let ((buffer-read-only nil)) - (rfc2047-decode-region (point-min) (mh-mail-header-end))))) + (mail-decode-encoded-word-region (point-min) (mh-mail-header-end))))) ;;;###mh-autoload (defun mh-decode-message-subject () @@ -504,8 +504,9 @@ decoding the same message multiple times." (when mh-decode-mime-flag (save-excursion (let ((buffer-read-only nil)) - (rfc2047-decode-region (progn (mh-goto-header-field "Subject:") (point)) - (progn (mh-header-field-end) (point))))))) + (mail-decode-encoded-word-region + (progn (mh-goto-header-field "Subject:") (point)) + (progn (mh-header-field-end) (point))))))) ;;;###mh-autoload (defun mh-mime-display (&optional pre-dissected-handles) diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index bc4cc6ecd7..58177c1794 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -27,6 +27,7 @@ (require 'mh-e) +(autoload 'mail-header-parse-address "mail-parse") (autoload 'message-fetch-field "message") (defvar mh-show-xface-function @@ -190,11 +191,7 @@ The directories are searched for in the order they appear in the list.") (let* ((from-field (ignore-errors (car (message-tokenize-header (mh-get-header-field "from:"))))) (from (car (ignore-errors - ;; Don't use mh-funcall-if-exists because - ;; ietf-drums-parse-address might exist at run-time but - ;; not at compile-time. - (when (fboundp 'ietf-drums-parse-address) - (ietf-drums-parse-address from-field))))) + (mail-header-parse-address from-field)))) (host (and from (string-match "\\([^+]*\\)\\(\\+.*\\)?@\\(.*\\)" from) (downcase (match-string 3 from)))) commit a849b5641044c19ee3d8a4206c7c827e2620c325 Author: Eli Zaretskii Date: Mon Aug 23 23:14:00 2021 +0300 Document 'jit-lock-bounds' * doc/lispref/modes.texi (Other Font Lock Variables): * lisp/jit-lock.el (jit-lock-functions, jit-lock-register): Document the return value of the fontification functions. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 951f30fc6f..ee55f982d0 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3315,6 +3315,11 @@ This function tells Font Lock mode to run the Lisp function current buffer. It calls @var{function} before calling the default fontification functions, and gives it two arguments, @var{start} and @var{end}, which specify the region to be fontified or refontified. +If @var{function} performs fontifications, it can return a list of the +form @w{@code{(jit-lock-bounds @var{beg} . @var{end})}}, to indicate +the bounds of the region it actually fontified; JIT font-lock will use +this information to optimize subsequent redisplay cycles and regions +of buffer text it will pass to future calls to @var{function}. The optional argument @var{contextual}, if non-@code{nil}, forces Font Lock mode to always refontify a syntactically relevant part of the diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index a1287926eb..a905936b6b 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -150,7 +150,10 @@ If 0, then fontification is only deferred while there is input pending." (defvar jit-lock-functions nil "Special hook run to do the actual fontification. The functions are called with two arguments: -the START and END of the region to fontify.") +the START and END of the region to fontify. +Each function can return a list of the form (jit-lock-bounds BEG . END), +to indicate the bounds of the region it actually fontified; +JIT font-lock will use this information to optimize redisplay cycles.") (defvar-local jit-lock-context-unfontify-pos nil "Consider text after this position as contextually unfontified. @@ -332,7 +335,10 @@ like `debug-on-error' and Edebug can be used." "Register FUN as a fontification function to be called in this buffer. FUN will be called with two arguments START and END indicating the region that needs to be (re)fontified. -If non-nil, CONTEXTUAL means that a contextual fontification would be useful." +If non-nil, CONTEXTUAL means that a contextual fontification would be useful. +FUN can return a list of the form (jit-lock-bounds BEG . END), +to indicate the bounds of the region it actually fontified; JIT +font-lock will use this information to optimize redisplay cycles." (add-hook 'jit-lock-functions fun nil t) (when (and contextual jit-lock-contextually) (setq-local jit-lock-contextually t)) commit 8f43180f0dc5b3e25d8252950ea63e2e92d40611 Author: Eli Zaretskii Date: Mon Aug 23 22:14:03 2021 +0300 Improve documentation of 'inhibit-mouse-event-check' * etc/NEWS: * src/callint.c (syms_of_callint): Fix wording of the documentation of 'inhibit-mouse-event-check'. diff --git a/etc/NEWS b/etc/NEWS index ed77443dbf..588290f433 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3848,9 +3848,9 @@ current buffer will be shown first in the "*xref*" buffer. --- ** New variable 'inhibit-mouse-event-check'. -If bound to non-nil, a command with '(interactive "e")' -doesn't signal an error when no mouse event is produced -while using the keyboard. +If bound to non-nil, a command with '(interactive "e")' doesn't signal +an error when invoked by input event that is not a mouse click (e.g., +a key sequence). * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/src/callint.c b/src/callint.c index 5201dc7ba1..44dae361c1 100644 --- a/src/callint.c +++ b/src/callint.c @@ -901,10 +901,11 @@ a way to turn themselves off when a mouse command switches windows. */); Vmouse_leave_buffer_hook = Qnil; DEFVAR_BOOL ("inhibit-mouse-event-check", inhibit_mouse_event_check, - doc: /* Non-nil means the interactive spec "e" doesn't check for events. -In this case `(interactive "e")' doesn't signal an error when no mouse event -is produced while using the keyboard. Then `event-start', `event-end', -`event-click-count' can create a new event. */); + doc: /* Whether the interactive spec "e" requires a mouse gesture event. +If non-nil, `(interactive "e")' doesn't signal an error when the command +was invoked by an input event that is not a mouse gesture: a click, a drag, +etc. To create the event data when the input was some other event, +use `event-start', `event-end', and `event-click-count'. */); inhibit_mouse_event_check = false; defsubr (&Sinteractive); commit 4281e5b34d47052f3f8aa07295032ba3a764c54e Author: Mattias Engdegård Date: Mon Aug 23 17:02:51 2021 +0200 Add example of advanced user-defined Rx form to manual * doc/lispref/searching.texi (Extending Rx): Add example illustrating how to define a user-defined Rx form that performs computation, from a discussion with Michael Herdeegen (bug#50136). * lisp/emacs-lisp/rx.el (rx): Clarify evaluation time for `eval`. diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 4d5ae3cb43..68061f0b09 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -1649,6 +1649,24 @@ extra actual argument values not matched by any other parameter in Since the definition is global, it is recommended to give @var{name} a package prefix to avoid name clashes with definitions elsewhere, as is usual when naming non-local variables and functions. + +Forms defined this way only perform simple template substitution. +For arbitrary computations, use them together with with the @code{rx} +forms @code{eval}, @code{regexp} or @code{literal}. Example: + +@example +@group +(defun n-tuple-rx (n element) + `(seq "<" + (group-n 1 ,element) + ,@@(mapcar (lambda (i) `(seq ?, (group-n ,i ,element))) + (number-sequence 2 n)) + ">")) +(rx-define n-tuple (n element) (eval (n-tuple-rx n 'element))) +(rx (n-tuple 3 (+ (in "0-9")))) + @result{} "<\\(?1:[0-9]+\\),\\(?2:[0-9]+\\),\\(?3:[0-9]+\\)>" +@end group +@end example @end defmac @defmac rx-let (bindings@dots{}) body@dots{} diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 071d390f0e..c48052dee9 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1266,7 +1266,8 @@ Zero-width assertions: these all match the empty string in specific places. (literal EXPR) Match the literal string from evaluating EXPR at run time. (regexp EXPR) Match the string regexp from evaluating EXPR at run time. -(eval EXPR) Match the rx sexp from evaluating EXPR at compile time. +(eval EXPR) Match the rx sexp from evaluating EXPR at macro-expansion + (compile) time. Additional constructs can be defined using `rx-define' and `rx-let', which see. commit 976594d905ceacc3c351735ba099ac71ea31f014 Author: Juri Linkov Date: Mon Aug 23 20:42:16 2021 +0300 * lisp/mouse.el (context-menu-open): New command bound to [S-f10]. * doc/emacs/frames.texi (Menu Mouse Clicks): Mention S-F10 to pop up the context menu. * src/callint.c (Fcall_interactively): Use inhibit_mouse_event_check for the case 'e'. (inhibit-mouse-event-check): New variable. https://lists.gnu.org/archive/html/emacs-devel/2021-08/msg00733.html diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index d582d24e76..22f22efaca 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -370,6 +370,7 @@ This menu is for changing the default face within the window's buffer. @findex context-menu-mode @vindex context-menu-functions @kindex Down-mouse-3 +@kindex S-F10 Many GUI applications use @kbd{mouse-3} to display @dfn{context menus}: menus that provide access to various pertinent settings and actions for the location and context of the mouse click. If you @@ -382,6 +383,7 @@ mode and the buffer contents around the place where you click the mouse. To customize the contents of the context menu, you can use the variable @code{context-menu-functions} (@pxref{Major Mode Conventions,,, elisp, The Emacs Lisp Reference Manual}). +You can also invoke the context menu by pressing @kbd{S-@key{F10}}. @node Mode Line Mouse @section Mode Line Mouse Commands diff --git a/etc/NEWS b/etc/NEWS index b008c46291..ed77443dbf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -398,6 +398,7 @@ When this mode is enabled, clicking 'down-mouse-3' anywhere in the buffer pops up a menu whose contents depends on surrounding context near the mouse click. You can change the order of the default sub-menus in the context menu by customizing the user option 'context-menu-functions'. +You can also invoke the context menu by pressing 'S-'. +++ *** The "Edit => Clear" menu item now obeys a rectangular region. @@ -3845,6 +3846,12 @@ to match the behaviour.) When non-nil, matches for identifiers in the file visited by the current buffer will be shown first in the "*xref*" buffer. +--- +** New variable 'inhibit-mouse-event-check'. +If bound to non-nil, a command with '(interactive "e")' +doesn't signal an error when no mouse event is produced +while using the keyboard. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/mouse.el b/lisp/mouse.el index 28996e373d..9d86681384 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -469,6 +469,15 @@ When Context Menu mode is enabled, clicking the mouse button down-mouse-3 activates the menu whose contents depends on its surrounding context." :global t :group 'mouse) +(defun context-menu-open () + "Start key navigation of the context menu. +This is the keyboard interface to \\[context-menu-map]." + (interactive) + (let ((inhibit-mouse-event-check t)) + (popup-menu (context-menu-map) (point)))) + +(global-set-key [S-f10] 'context-menu-open) + ;; Commands that operate on windows. diff --git a/src/callint.c b/src/callint.c index 6f8a7f13f6..5201dc7ba1 100644 --- a/src/callint.c +++ b/src/callint.c @@ -606,7 +606,7 @@ invoke it (via an `interactive' spec that contains, for instance, an break; case 'e': /* The invoking event. */ - if (next_event >= key_count) + if (!inhibit_mouse_event_check && next_event >= key_count) error ("%s must be bound to an event with parameters", (SYMBOLP (function) ? SSDATA (SYMBOL_NAME (function)) @@ -900,6 +900,13 @@ Its purpose is to give temporary modes such as Isearch mode a way to turn themselves off when a mouse command switches windows. */); Vmouse_leave_buffer_hook = Qnil; + DEFVAR_BOOL ("inhibit-mouse-event-check", inhibit_mouse_event_check, + doc: /* Non-nil means the interactive spec "e" doesn't check for events. +In this case `(interactive "e")' doesn't signal an error when no mouse event +is produced while using the keyboard. Then `event-start', `event-end', +`event-click-count' can create a new event. */); + inhibit_mouse_event_check = false; + defsubr (&Sinteractive); defsubr (&Scall_interactively); defsubr (&Sfuncall_interactively); commit c1c2266a1c38b1f8dfd001f653ebec6fa79fb3c3 Author: Glenn Morris Date: Mon Aug 23 10:36:57 2021 -0700 Fix recently added cperl test * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-here-doc-missing-end): Fix quote regexp. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index bcef885a77..1d7565ae46 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -231,7 +231,7 @@ issued by CPerl mode." (goto-char (point-min)) (funcall cperl-test-mode) (cperl-find-pods-heres) - (should (string-match "End of here-document [‘']HERE[’']" + (should (string-match "End of here-document [‘'`]HERE[’']" collected-messages)))) (ert-with-message-capture collected-messages (with-temp-buffer @@ -242,7 +242,7 @@ issued by CPerl mode." (goto-char (point-min)) (funcall cperl-test-mode) (cperl-find-pods-heres) - (should (string-match "End of here-document [‘']THERE[’']" + (should (string-match "End of here-document [‘'`]THERE[’']" collected-messages))))) (defvar perl-continued-statement-offset) commit 00edc8329a6277f2e5b5204efbe503e2b7957006 Author: Eli Zaretskii Date: Mon Aug 23 19:19:13 2021 +0300 ; * doc/emacs/files.texi (Auto Save Files): Fix a typo. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 9338e77859..65a57ccd31 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1196,7 +1196,7 @@ any auto-save file to go with the new visited name. file. If @code{kill-buffer-delete-auto-save-files} is non-@code{nil}, killing a buffer that has an auto-save file will make Emacs prompt the user for whether the auto-save file should be deleted. (This is -inhibited is @code{delete-auto-save-files} is @code{nil}.) +inhibited if @code{delete-auto-save-files} is @code{nil}.) @node Auto Save Control @subsection Controlling Auto-Saving commit efddcc9fbef9e3b11362cc05b12d3e378a0b11c4 Author: Eli Zaretskii Date: Mon Aug 23 19:11:49 2021 +0300 Improve recently-changed docs * src/frame.c (Fnext_frame): * doc/lispref/frames.texi (Finding All Frames): Improve wording and style of the 'next-frame's documentation. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 596585f99b..477c105a95 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2692,21 +2692,21 @@ frame and defaults to the selected frame. It never returns a frame whose @code{no-other-frame} parameter (@pxref{Frame Interaction Parameters}) is non-@code{nil}. -The second argument, @var{minibuf}, says which frames to include when -considering what the next frame should be: +The second argument, @var{minibuf}, says which frames to consider when +deciding what the next frame should be: @table @asis @item @code{nil} -Include all frames except minibuffer-only frames. +Consider all frames except minibuffer-only frames. @item @code{visible} -Include only visible frames. +Consider only visible frames. @item 0 -Include only visible or iconified frames. +Consider only visible or iconified frames. @item a window -Include only the frames using that particular window as their -minibuffer. +Consider only the frames using that particular window as their +minibuffer window. @item anything else -Include all frames. +Consider all frames. @end table @end defun diff --git a/src/frame.c b/src/frame.c index c6b4c5946c..74ef2afdb1 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1837,8 +1837,8 @@ prev_frame (Lisp_Object frame, Lisp_Object minibuf) DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0, doc: /* Return the next frame in the frame list after FRAME. -Only frames on the same terminal as FRAME are included. If omitted, -FRAME defaults to the selected frame. +Only frames on the same terminal as FRAME are included in the list +of candidate frames. If omitted, FRAME defaults to the selected frame. If MINIFRAME is nil (the default), include all frames except minibuffer-only frames. @@ -1846,12 +1846,11 @@ minibuffer-only frames. If MINIFRAME is a window, include only its own frame and any frame now using that window as the minibuffer. -If MINIFRAME is `visible', only include visible frames. +If MINIFRAME is `visible', include only visible frames. -If MINIFRAME is 0, only include visible and iconified frames. +If MINIFRAME is 0, include only visible and iconified frames. -If MINIFRAME is any other value than these values, include all -frames. */) +If MINIFRAME is any other value, include all frames. */) (Lisp_Object frame, Lisp_Object miniframe) { if (NILP (frame)) commit 9936e1478f26c35576644dc15370c4897eb6351d Author: Eli Zaretskii Date: Mon Aug 23 19:01:09 2021 +0300 Fix doc strings in recent changes. * lisp/progmodes/cperl-mode.el (cperl-commentify) (cperl-here-doc-functions, cperl-is-here-doc-p) (cperl-find-pods-heres): Fix wording, style, and punctuation of doc strings. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 6bffea5936..727deaba5f 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3150,11 +3150,11 @@ Returns true if comment is found. In POD will not move the point." (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct)))) (defun cperl-commentify (begin end string) - "Marks text from BEGIN to END as generic string or comment. -Marks as generic string if STRING, as generic comment otherwise. + "Mark text from BEGIN to END as generic string or comment. +Mark as generic string if STRING, as generic comment otherwise. A single character is marked as punctuation and directly -fontified. Does nothing if BEGIN and END are equal. If -`cperl-use-syntax-text-property' is nil, just fontifies." +fontified. Do nothing if BEGIN and END are equal. If +`cperl-use-syntax-text-property' is nil, just fontify." (if (and cperl-use-syntax-table-text-property (> end begin)) (progn @@ -3520,8 +3520,8 @@ Should be called with the point before leading colon of an attribute." "system" "exec" ; system $progname < Date: Mon Aug 23 16:26:45 2021 +0200 ; cperl-mode: bugfix / rework fontification of here-docs * lisp/progmodes/cperl-mode.el (cperl-mode): Use `cperl-font-lock-syntactic-face-function'. (cperl-commentify): Add a docstring, eliminate unused formal parameter `noface'. (cperl-is-here-doc-p): New function to detect whether "<<" starts a here-document, factored out from `cperl-find-pods-heres'. (cperl-here-doc-functions): New variable: List of functions which allow here-documents as parameters, for use in `cperl-is-here-doc-p'. (cperl-process-here-doc): New function, factored out from `cperl-find-pods-heres'. Fixed to keep correct fontification after non-interactive (elisp) changes (Bug#14343, Bug#28962). (cperl-find-pods-heres): Extend the doc-string to describe all parameters. Don't remove text properties in recursive calls on the same line. Call `cperl-process-here-doc' when appropriate. (cperl-font-lock-syntactic-face-function): New function to highlight c-style comments as here-documents (adapted from perl-mode.el). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-identify-heredoc): New test for the new function `cperl-is-here-doc-p'. (cperl-test-identify-no-heredoc): New test for the new function `cperl-is-here-doc-p', testing constructs which start with "<<" but are no here-documents. (cperl-test-here-doc-missing-end): New test to verify correct detection of a missing here-document delimiter. (cperl-test-bug-14343): New test to verify that inserting text into a here-document with elisp does not break fontification. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 3370df6491..6bffea5936 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1741,7 +1741,9 @@ or as help on variables `cperl-tips', `cperl-problems', '((cperl-load-font-lock-keywords cperl-load-font-lock-keywords-1 cperl-load-font-lock-keywords-2) - nil nil ((?_ . "w")))) + nil nil ((?_ . "w")) nil + (font-lock-syntactic-face-function + . cperl-font-lock-syntactic-face-function))) ;; Reset syntaxification cache. (setq-local cperl-syntax-state nil) (when cperl-use-syntax-table-text-property @@ -3147,26 +3149,29 @@ Returns true if comment is found. In POD will not move the point." (while (re-search-forward "^\\s(" e 'to-end) (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct)))) -(defun cperl-commentify (bb e string &optional noface) - (if cperl-use-syntax-table-text-property - (if (eq noface 'n) ; Only immediate - nil - ;; We suppose that e is _after_ the end of construction, as after eol. - (setq string (if string cperl-st-sfence cperl-st-cfence)) - (if (> bb (- e 2)) +(defun cperl-commentify (begin end string) + "Marks text from BEGIN to END as generic string or comment. +Marks as generic string if STRING, as generic comment otherwise. +A single character is marked as punctuation and directly +fontified. Does nothing if BEGIN and END are equal. If +`cperl-use-syntax-text-property' is nil, just fontifies." + (if (and cperl-use-syntax-table-text-property + (> end begin)) + (progn + (setq string (if string cperl-st-sfence cperl-st-cfence)) + (if (> begin (- end 2)) ;; one-char string/comment?! - (cperl-modify-syntax-type bb cperl-st-punct) - (cperl-modify-syntax-type bb string) - (cperl-modify-syntax-type (1- e) string)) - (if (and (eq string cperl-st-sfence) (> (- e 2) bb)) - (put-text-property (1+ bb) (1- e) + (cperl-modify-syntax-type begin cperl-st-punct) + (cperl-modify-syntax-type begin string) + (cperl-modify-syntax-type (1- end) string)) + (if (and (eq string cperl-st-sfence) (> (- end 2) begin)) + (put-text-property (1+ begin) (1- end) 'syntax-table cperl-string-syntax-table)) - (cperl-protect-defun-start bb e)) + (cperl-protect-defun-start begin end)) ;; Fontify - (or noface - (not cperl-pod-here-fontify) - (put-text-property bb e 'face (if string 'font-lock-string-face - 'font-lock-comment-face))))) + (when cperl-pod-here-fontify + (put-text-property begin end 'face (if string 'font-lock-string-face + 'font-lock-comment-face))))) (defvar cperl-starters '(( ?\( . ?\) ) ( ?\[ . ?\] ) @@ -3510,19 +3515,191 @@ Should be called with the point before leading colon of an attribute." (goto-char endbracket) ; just in case something misbehaves??? t)) +(defvar cperl-here-doc-functions + (regexp-opt '("print" "printf" "say" ; print $handle <>") ; <<>> operator + (save-excursion ; 1 << func_name, or $foo << 10 + (condition-case nil + (progn + (goto-char start) + (forward-sexp -1) ;; examine the part before "<<" + (save-match-data + (cond + ((looking-at "[0-9$({]") + (forward-sexp 1) + (and + (looking-at "[ \t]*<<") + (condition-case nil + ;; print $foo <= min (car cperl-syntax-state)))) + (state-point (if use-syntax-state + (car cperl-syntax-state) + (point-min))) + (state (if use-syntax-state + (cdr cperl-syntax-state))) + here-doc-start here-doc-end defs-eol + warning-message) + (when cperl-pod-here-fontify + ;; Highlight the starting delimiter + (cperl-postpone-fontification delim-begin delim-end + 'face my-cperl-delimiters-face) + (cperl-put-do-not-fontify delim-begin delim-end t)) + (forward-line) + (setq here-doc-start (point) ; first char of (first) here-doc + defs-eol (1- here-doc-start)) ; end of definitions line + (if end-of-here-doc + ;; skip to the end of the previous here-doc + (goto-char end-of-here-doc) + ;; otherwise treat the first (or only) here-doc: Check for + ;; special cases if the line containing the delimiter(s) + ;; ends in a regular comment or a solitary ?# + (let* ((eol-state (save-excursion (syntax-ppss defs-eol)))) + (when (nth 4 eol-state) ; EOL is in a comment + (if (= (1- defs-eol) (nth 8 eol-state)) + ;; line ends with a naked comment starter. + ;; We let it start the here-doc. + (progn + (put-text-property (1- defs-eol) defs-eol + 'font-lock-face + 'font-lock-comment-face) + (put-text-property (1- defs-eol) defs-eol + 'syntax-type 'here-doc) + (put-text-property (1- defs-eol) defs-eol + 'syntax-type 'here-doc) + (put-text-property (1- defs-eol) defs-eol + 'syntax-table + (string-to-syntax "< c")) + ) + ;; line ends with a "regular" comment: make + ;; the last character of the comment closing + ;; it so that we can use the line feed to + ;; start the here-doc + (put-text-property (1- defs-eol) defs-eol + 'syntax-table + (string-to-syntax ">")))))) + (setq here-doc-start (point)) ; now points to current here-doc + ;; Find the terminating delimiter. + ;; We do not search to max, since we may be called from + ;; some hook of fontification, and max is random + (or (re-search-forward + (concat "^" (when indented-here-doc-p "[ \t]*") + qtag "$") + stop-point 'toend) + (progn ; Pretend we matched at the end + (goto-char (point-max)) + (re-search-forward "\\'") + (setq warning-message + (format "End of here-document `%s' not found." delimiter)) + (or (car err-l) (setcar err-l here-doc-start)))) + (when cperl-pod-here-fontify + ;; Highlight the ending delimiter + (cperl-postpone-fontification + (match-beginning 0) (match-end 0) + 'face my-cperl-delimiters-face) + (cperl-put-do-not-fontify here-doc-start (match-end 0) t)) + (setq here-doc-end (cperl-1+ (match-end 0))) ; eol after delim + (put-text-property here-doc-start (match-beginning 0) + 'syntax-type 'here-doc) + (put-text-property (match-beginning 0) here-doc-end + 'syntax-type 'here-doc-delim) + (put-text-property here-doc-start here-doc-end 'here-doc-group t) + ;; This makes insertion at the start of HERE-DOC update + ;; the whole construct: + (put-text-property here-doc-start (cperl-1+ here-doc-start) 'front-sticky '(syntax-type)) + (cperl-commentify (match-beginning 0) (1- here-doc-end) nil) + (when (> (match-beginning 0) here-doc-start) + ;; here-document has non-zero length + (cperl-modify-syntax-type (1- here-doc-start) (string-to-syntax "< c")) + (cperl-modify-syntax-type (1- (match-beginning 0)) + (string-to-syntax "> c"))) + (cperl-put-do-not-fontify here-doc-start (match-end 0) t) + ;; Cache the syntax info... + (setq cperl-syntax-state (cons state-point state)) + ;; ... and process the rest of the line... + (setq overshoot + (elt ; non-inter ignore-max + (cperl-find-pods-heres todo-pos defs-eol + t end t here-doc-end) + 1)) + (if (and overshoot (> overshoot (point))) + (goto-char overshoot) + (setq overshoot here-doc-end)) + (list (if (> here-doc-end max) matched-pos nil) + overshoot + warning-message))) + ;; Debugging this may require (setq max-specpdl-size 2000)... (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc) "Scans the buffer for hard-to-parse Perl constructions. -If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify -the sections using `cperl-pod-head-face', `cperl-pod-face', -`cperl-here-face'." +If `cperl-pod-here-fontify' is not-nil after evaluation, will +fontify the sections using `cperl-pod-head-face', +`cperl-pod-face', `cperl-here-face'. The optional parameters are +for internal use: Scans from MIN to MAX, or the whole buffer if +these are nil. If NON-INTER, does't write progress messages. If +IGNORE-MAX, scans to end of buffer. If END, we are after a +\"__END__\" or \"__DATA__\" token and ignore unbalanced +constructs. END-OF-HERE-DOC points to the end of a here-document +which has already been processed. Returns a two-element list of +the position where an error occurred (if any) and the +\"overshoot\", which is used for recursive calls in starting +lines of here-documents." (interactive) (or min (setq min (point-min) cperl-syntax-state nil cperl-syntax-done-to min)) (or max (setq max (point-max))) - (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend - face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb + (let* (go tmpend + face head-face b e bb tag qtag b1 e1 argument i c tail tb is-REx is-x-REx REx-subgr-start REx-subgr-end was-subgr i2 hairy-RE (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p)) overshoot is-o-REx name @@ -3619,20 +3796,20 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (and cperl-pod-here-fontify ;; We had evals here, do not know why... (setq face cperl-pod-face - head-face cperl-pod-head-face - here-face cperl-here-face)) - (remove-text-properties min max - '(syntax-type t in-pod t syntax-table t - attrib-group t - REx-interpolated t - cperl-postpone t - syntax-subtype t - rear-nonsticky t - front-sticky t - here-doc-group t - first-format-line t - REx-part2 t - indentable t)) + head-face cperl-pod-head-face)) + (unless end-of-here-doc + (remove-text-properties min max + '(syntax-type t in-pod t syntax-table t + attrib-group t + REx-interpolated t + cperl-postpone t + syntax-subtype t + rear-nonsticky t + front-sticky t + here-doc-group t + first-format-line t + REx-part2 t + indentable t))) ;; Need to remove face as well... (goto-char min) (while (and @@ -3751,120 +3928,36 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; but multiline quote on the same line as <>") ; <<>> operator - (save-excursion ; 1 << func_name, or $foo << 10 - (condition-case nil - (progn - (goto-char tb) - ;;; XXX What to do: foo <"))) - (error t))))))) - (error nil))) ; func(< overshoot (point))) - (goto-char overshoot) - (setq overshoot e1)) - (if (> e1 max) - (setq tmpend tb)))) + ((match-beginning 3) ; 2 + 1: found "<<", detect its type + (let* ((matched-pos (match-beginning 0)) + (quoted-delim-p (if (match-beginning 6) nil t)) + (delim-capture (if quoted-delim-p 5 6))) + (when (cperl-is-here-doc-p matched-pos) + (let ((here-doc-results + (cperl-process-here-doc + min max end overshoot stop-point ; for recursion + end-of-here-doc err-l ; for recursion + (equal (match-string 2) "~") ; indented here-doc? + matched-pos ; for recovery (?) + (match-end 3) ; todo from here + (match-beginning delim-capture) ; starting delimiter + (match-end delim-capture)))) ; boundaries + (setq tmpend (nth 0 here-doc-results) + overshoot (nth 1 here-doc-results)) + (and (nth 2 here-doc-results) + (setq warning-message (nth 2 here-doc-results))))))) ;; format ((match-beginning 8) ;; 1+6=7 extra () before this: @@ -5458,6 +5551,18 @@ comment, or POD." (or cperl-faces-init (cperl-init-faces)) cperl-font-lock-keywords-2) +(defun cperl-font-lock-syntactic-face-function (state) + "Apply faces according to their syntax type. In CPerl mode, this +is used for here-documents which have been marked as c-style +comments. For everything else, delegate to the default +function." + (cond + ;; A c-style comment is a HERE-document. Fontify if requested. + ((and (eq 2 (nth 7 state)) + cperl-pod-here-fontify) + cperl-here-face) + (t (funcall (default-value 'font-lock-syntactic-face-function) state)))) + (defun cperl-init-faces () (condition-case errs (progn diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 4d2bac6ee4..bcef885a77 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -154,6 +154,97 @@ point in the distant past, and is still broken in perl-mode. " (should (equal (get-text-property (match-beginning 0) 'face) 'font-lock-keyword-face)))) +(ert-deftest cperl-test-identify-heredoc () + "Test whether a construct containing \"<<\" followed by a + bareword is properly identified for a here-document if + appropriate." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((here-docs + '("$text .= <>) { ...; }" ; double angle bracket operator + "expr < Date: Mon Aug 23 16:32:33 2021 +0200 Clarify the documentation of `next-frame' * doc/lispref/frames.texi (Finding All Frames): Clarify what it means to "consider". * src/frame.c (Fnext_frame): Rewrite doc string to say what the parameters actually mean (bug#13339). diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 25706befc8..596585f99b 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2692,20 +2692,21 @@ frame and defaults to the selected frame. It never returns a frame whose @code{no-other-frame} parameter (@pxref{Frame Interaction Parameters}) is non-@code{nil}. -The second argument, @var{minibuf}, says which frames to consider: +The second argument, @var{minibuf}, says which frames to include when +considering what the next frame should be: @table @asis @item @code{nil} -Exclude minibuffer-only frames. +Include all frames except minibuffer-only frames. @item @code{visible} -Consider all visible frames. +Include only visible frames. @item 0 -Consider all visible or iconified frames. +Include only visible or iconified frames. @item a window -Consider only the frames using that particular window as their +Include only the frames using that particular window as their minibuffer. @item anything else -Consider all frames. +Include all frames. @end table @end defun diff --git a/src/frame.c b/src/frame.c index b105268d42..c6b4c5946c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1837,15 +1837,21 @@ prev_frame (Lisp_Object frame, Lisp_Object minibuf) DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0, doc: /* Return the next frame in the frame list after FRAME. -It considers only frames on the same terminal as FRAME. -By default, skip minibuffer-only frames. -If omitted, FRAME defaults to the selected frame. -If optional argument MINIFRAME is nil, exclude minibuffer-only frames. -If MINIFRAME is a window, include only its own frame -and any frame now using that window as the minibuffer. -If MINIFRAME is `visible', include all visible frames. -If MINIFRAME is 0, include all visible and iconified frames. -Otherwise, include all frames. */) +Only frames on the same terminal as FRAME are included. If omitted, +FRAME defaults to the selected frame. + +If MINIFRAME is nil (the default), include all frames except +minibuffer-only frames. + +If MINIFRAME is a window, include only its own frame and any frame now +using that window as the minibuffer. + +If MINIFRAME is `visible', only include visible frames. + +If MINIFRAME is 0, only include visible and iconified frames. + +If MINIFRAME is any other value than these values, include all +frames. */) (Lisp_Object frame, Lisp_Object miniframe) { if (NILP (frame)) commit 591b8bd87a30bda3dad680752b7f63da8b5b74bd Author: Lars Ingebrigtsen Date: Mon Aug 23 15:56:50 2021 +0200 Add new variable 'kill-buffer/delete-auto-save-files' * doc/emacs/files.texi (Auto Save Files): Document it. * lisp/cus-start.el (standard): Add customize form. * lisp/files.el (delete-auto-save-files): Move definition to C (since it's used in the C layer). * src/buffer.c (Fkill_buffer): Use the new variable (and remove the old code that apparently didn't trigger for kill-buffer/delete-auto-save-files. (syms_of_buffer): Add new variable kill-buffer-delete-auto-save-files and move definition of delete-auto-save-files here (bug#21612). diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 9aae0e9a0b..9338e77859 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1191,6 +1191,13 @@ visited file. (You can inhibit this by setting the variable file name with @kbd{C-x C-w} or @code{set-visited-file-name} renames any auto-save file to go with the new visited name. +@vindex kill-buffer-delete-auto-save-files + Killing a buffer, by default, doesn't remove the buffer's auto-save +file. If @code{kill-buffer-delete-auto-save-files} is non-@code{nil}, +killing a buffer that has an auto-save file will make Emacs prompt the +user for whether the auto-save file should be deleted. (This is +inhibited is @code{delete-auto-save-files} is @code{nil}.) + @node Auto Save Control @subsection Controlling Auto-Saving diff --git a/etc/NEWS b/etc/NEWS index aefe582ad7..b008c46291 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3824,12 +3824,22 @@ whenever the protected form terminates without error, with the specified variable bound to the the value of the protected form. +++ -** 'The 'uniquify' argument in 'auto-save-file-name-transforms' can be a symbol. +** The 'uniquify' argument in 'auto-save-file-name-transforms' can be a symbol. If this symbol is one of the members of 'secure-hash-algorithms', Emacs constructs the nondirectory part of the auto-save file name by applying that 'secure-hash' to the buffer file name. This avoids any risk of excessively long file names. ++++ +** New user option 'kill-buffer-delete-auto-save-files'. +If non-nil, killing a buffer that has an auto-save file will prompt +the user for whether that buffer should be deleted. (Note that +'delete-auto-save-files', if non-nil, was previously documented to +result in deletion of auto-save files when killing a buffer without +unsaved changes, but this has apparently not worked for several +decades, so the documented semantics of this variable has been changed +to match the behaviour.) + --- ** New user option 'etags-xref-prefer-current-file'. When non-nil, matches for identifiers in the file visited by the diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 1997530789..1a3e5682bb 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -171,6 +171,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "Right to Left" right-to-left) (const :tag "Dynamic, according to paragraph text" nil)) "24.1") + (delete-auto-save-files auto-save boolean) + (kill-buffer-delete-auto-save-files auto-save boolean "28.1") ;; callint.c (mark-even-if-inactive editing-basics boolean) ;; callproc.c diff --git a/lisp/files.el b/lisp/files.el index e519a8ea8b..bd87b99575 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -42,15 +42,6 @@ "Finding files." :group 'files) - -(defcustom delete-auto-save-files t - "Non-nil means delete auto-save file when a buffer is saved or killed. - -Note that the auto-save file will not be deleted if the buffer is killed -when it has unsaved changes." - :type 'boolean - :group 'auto-save) - (defcustom directory-abbrev-alist nil "Alist of abbreviations for file directories. diff --git a/src/buffer.c b/src/buffer.c index 7e4c84911b..7ba0c8bc2a 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1768,6 +1768,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* Run hooks with the buffer to be killed as the current buffer. */ { ptrdiff_t count = SPECPDL_INDEX (); + bool modified; record_unwind_protect_excursion (); set_buffer_internal (b); @@ -1782,9 +1783,12 @@ cleaning up all windows currently displaying the buffer to be killed. */) return unbind_to (count, Qnil); } + /* Is this a modified buffer that's visiting a file? */ + modified = !NILP (BVAR (b, filename)) + && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b); + /* Query if the buffer is still modified. */ - if (INTERACTIVE && !NILP (BVAR (b, filename)) - && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) + if (INTERACTIVE && modified) { AUTO_STRING (format, "Buffer %s modified; kill anyway? "); tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name))); @@ -1792,6 +1796,17 @@ cleaning up all windows currently displaying the buffer to be killed. */) return unbind_to (count, Qnil); } + /* Delete the autosave file, if requested. */ + if (modified + && kill_buffer_delete_auto_save_files + && delete_auto_save_files + && !NILP (Frecent_auto_save_p ())) + { + tem = do_yes_or_no_p (build_string ("Delete auto-save file? ")); + if (!NILP (tem)) + call0 (intern ("delete-auto-save-file-if-necessary")); + } + /* If the hooks have killed the buffer, exit now. */ if (!BUFFER_LIVE_P (b)) return unbind_to (count, Qt); @@ -1888,24 +1903,6 @@ cleaning up all windows currently displaying the buffer to be killed. */) replace_buffer_in_windows_safely (buffer); Vinhibit_quit = tem; - /* Delete any auto-save file, if we saved it in this session. - But not if the buffer is modified. */ - if (STRINGP (BVAR (b, auto_save_file_name)) - && BUF_AUTOSAVE_MODIFF (b) != 0 - && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b) - && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) - && NILP (Fsymbol_value (intern ("auto-save-visited-file-name")))) - { - Lisp_Object delete; - delete = Fsymbol_value (intern ("delete-auto-save-files")); - if (! NILP (delete)) - internal_delete_file (BVAR (b, auto_save_file_name)); - } - - /* Deleting an auto-save file could have killed our buffer. */ - if (!BUFFER_LIVE_P (b)) - return Qt; - if (b->base_buffer) { INTERVAL i; @@ -6366,6 +6363,18 @@ nil NORECORD argument since it may lead to infinite recursion. */); Vbuffer_list_update_hook = Qnil; DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook"); + DEFVAR_BOOL ("kill-buffer-delete-auto-save-files", + kill_buffer_delete_auto_save_files, + doc: /* If non-nil, offer to delete any autosave file when killing a buffer. + +If `delete-auto-save-files' is nil, any autosave deletion is inhibited. */); + kill_buffer_delete_auto_save_files = 0; + + DEFVAR_BOOL ("delete-auto-save-files", delete_auto_save_files, + doc: /* Non-nil means delete auto-save file when a buffer is saved. +This is the default. If nil, auto-save file deletion is inhibited. */); + delete_auto_save_files = 1; + defsubr (&Sbuffer_live_p); defsubr (&Sbuffer_list); defsubr (&Sget_buffer); diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 118311c4d2..059926ff46 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1420,4 +1420,67 @@ with parameters from the *Messages* buffer modification." (remove-overlays) (should (= (length (overlays-in (point-min) (point-max))) 0)))) +(ert-deftest test-kill-buffer-auto-save-default () + (let ((file (make-temp-file "ert")) + auto-save) + (should (file-exists-p file)) + ;; Always answer yes. + (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t))) + (unwind-protect + (progn + (find-file file) + (auto-save-mode t) + (insert "foo\n") + (should buffer-auto-save-file-name) + (setq auto-save buffer-auto-save-file-name) + (do-auto-save) + (should (file-exists-p auto-save)) + (kill-buffer (current-buffer)) + (should (file-exists-p auto-save))) + (ignore-errors (delete-file file)) + (when auto-save + (ignore-errors (delete-file auto-save))))))) + +(ert-deftest test-kill-buffer-auto-save-delete () + (let ((file (make-temp-file "ert")) + auto-save) + (should (file-exists-p file)) + (setq kill-buffer-delete-auto-save-files t) + ;; Always answer yes. + (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t))) + (unwind-protect + (progn + (find-file file) + (auto-save-mode t) + (insert "foo\n") + (should buffer-auto-save-file-name) + (setq auto-save buffer-auto-save-file-name) + (do-auto-save) + (should (file-exists-p auto-save)) + ;; This should delete the auto-save file. + (kill-buffer (current-buffer)) + (should-not (file-exists-p auto-save))) + (ignore-errors (delete-file file)) + (when auto-save + (ignore-errors (delete-file auto-save))))) + ;; Answer no to deletion. + (cl-letf (((symbol-function #'yes-or-no-p) + (lambda (prompt) + (not (string-search "Delete auto-save file" prompt))))) + (unwind-protect + (progn + (find-file file) + (auto-save-mode t) + (insert "foo\n") + (should buffer-auto-save-file-name) + (setq auto-save buffer-auto-save-file-name) + (do-auto-save) + (should (file-exists-p auto-save)) + ;; This should not delete the auto-save file. + (kill-buffer (current-buffer)) + (should (file-exists-p auto-save))) + (ignore-errors (delete-file file)) + (when auto-save + (ignore-errors (delete-file auto-save))))))) + ;;; buffer-tests.el ends here commit f00af4be3d8c14fc83925dcd244701c0dce7604a Author: Michael Albinus Date: Mon Aug 23 15:47:19 2021 +0200 Complete implementation of `copy-directory-create-symlink' in Tramp * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory): Fix the case NEWNAME is a directory name with a trailing slash. * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory): Implement `copy-directory-create-symlink'. (Bug#10897) * test/lisp/net/tramp-tests.el (tramp--test-ignore-make-symbolic-link-error): Move up. (tramp-test15-copy-directory): Extend test. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 9dcf55340c..e0bc28c983 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1857,16 +1857,21 @@ ID-FORMAT valid values are `string' and `integer'." (dirname newname &optional keep-date parents copy-contents) "Like `copy-directory' for Tramp files." (let ((t1 (tramp-tramp-file-p dirname)) - (t2 (tramp-tramp-file-p newname))) + (t2 (tramp-tramp-file-p newname)) + target) (with-parsed-tramp-file-name (if t1 dirname newname) nil (unless (file-exists-p dirname) (tramp-compat-file-missing v dirname)) ;; `copy-directory-create-symlink' exists since Emacs 28.1. (if (and (bound-and-true-p copy-directory-create-symlink) - (file-symlink-p dirname) + (setq target (file-symlink-p dirname)) (tramp-equal-remote dirname newname)) - (make-symbolic-link (file-symlink-p dirname) newname) + (make-symbolic-link + target + (if (directory-name-p newname) + (concat newname (file-name-nondirectory dirname)) newname) + t) (if (and (not copy-contents) (tramp-get-method-parameter v 'tramp-copy-recursive) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 6937244917..5cfe874f00 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -414,157 +414,176 @@ arguments to pass to the OPERATION." (defun tramp-smb-handle-copy-directory (dirname newname &optional keep-date parents copy-contents) "Like `copy-directory' for Tramp files." - (if copy-contents - ;; We must do it file-wise. - (tramp-run-real-handler - #'copy-directory (list dirname newname keep-date parents copy-contents)) - - (setq dirname (expand-file-name dirname) - newname (expand-file-name newname)) - (let ((t1 (tramp-tramp-file-p dirname)) - (t2 (tramp-tramp-file-p newname))) - (with-parsed-tramp-file-name (if t1 dirname newname) nil - (with-tramp-progress-reporter - v 0 (format "Copying %s to %s" dirname newname) - (unless (file-exists-p dirname) - (tramp-compat-file-missing v dirname)) - (when (and (file-directory-p newname) - (not (directory-name-p newname))) - (tramp-error v 'file-already-exists newname)) - (cond - ;; We must use a local temporary directory. - ((and t1 t2) - (let ((tmpdir (tramp-compat-make-temp-name))) - (unwind-protect - (progn - (make-directory tmpdir) - (copy-directory - dirname (file-name-as-directory tmpdir) keep-date 'parents) - (copy-directory - (expand-file-name (file-name-nondirectory dirname) tmpdir) - newname keep-date parents)) - (delete-directory tmpdir 'recursive)))) - - ;; We can copy recursively. - ;; TODO: Does not work reliably. - (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) + (let ((t1 (tramp-tramp-file-p dirname)) + (t2 (tramp-tramp-file-p newname)) + target) + (with-parsed-tramp-file-name (if t1 dirname newname) nil + (unless (file-exists-p dirname) + (tramp-compat-file-missing v dirname)) + + ;; `copy-directory-create-symlink' exists since Emacs 28.1. + (if (and (bound-and-true-p copy-directory-create-symlink) + (setq target (file-symlink-p dirname)) + (tramp-equal-remote dirname newname)) + (make-symbolic-link + target + (if (directory-name-p newname) + (concat newname (file-name-nondirectory dirname)) newname) + t) + + (if copy-contents + ;; We must do it file-wise. + (tramp-run-real-handler + #'copy-directory + (list dirname newname keep-date parents copy-contents)) + + (setq dirname (expand-file-name dirname) + newname (expand-file-name newname)) + (with-tramp-progress-reporter + v 0 (format "Copying %s to %s" dirname newname) + (unless (file-exists-p dirname) + (tramp-compat-file-missing v dirname)) (when (and (file-directory-p newname) - (not (string-equal (file-name-nondirectory dirname) - (file-name-nondirectory newname)))) - (setq newname - (expand-file-name - (file-name-nondirectory dirname) newname)) - (if t2 (setq v (tramp-dissect-file-name newname)))) - (if (not (file-directory-p newname)) - (make-directory newname parents)) - - (let* ((share (tramp-smb-get-share v)) - (localname (file-name-as-directory - (tramp-compat-string-replace - "\\" "/" (tramp-smb-get-localname v)))) - (tmpdir (tramp-compat-make-temp-name)) - (args (list (concat "//" host "/" share) "-E")) - (options tramp-smb-options)) - - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) - - (when domain (setq args (append args (list "-W" domain)))) - (when port (setq args (append args (list "-p" port)))) - (when tramp-smb-conf - (setq args (append args (list "-s" tramp-smb-conf)))) - (while options + (not (directory-name-p newname))) + (tramp-error v 'file-already-exists newname)) + (cond + ;; We must use a local temporary directory. + ((and t1 t2) + (let ((tmpdir (tramp-compat-make-temp-name))) + (unwind-protect + (progn + (make-directory tmpdir) + (copy-directory + dirname (file-name-as-directory tmpdir) + keep-date 'parents) + (copy-directory + (expand-file-name (file-name-nondirectory dirname) tmpdir) + newname keep-date parents)) + (delete-directory tmpdir 'recursive)))) + + ;; We can copy recursively. + ;; TODO: Does not work reliably. + (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) + (when (and (file-directory-p newname) + (not (string-equal (file-name-nondirectory dirname) + (file-name-nondirectory newname)))) + (setq newname + (expand-file-name + (file-name-nondirectory dirname) newname)) + (if t2 (setq v (tramp-dissect-file-name newname)))) + (if (not (file-directory-p newname)) + (make-directory newname parents)) + + (let* ((share (tramp-smb-get-share v)) + (localname (file-name-as-directory + (tramp-compat-string-replace + "\\" "/" (tramp-smb-get-localname v)))) + (tmpdir (tramp-compat-make-temp-name)) + (args (list (concat "//" host "/" share) "-E")) + (options tramp-smb-options)) + + (if (not (zerop (length user))) + (setq args (append args (list "-U" user))) + (setq args (append args (list "-N")))) + + (when domain (setq args (append args (list "-W" domain)))) + (when port (setq args (append args (list "-p" port)))) + (when tramp-smb-conf + (setq args (append args (list "-s" tramp-smb-conf)))) + (while options + (setq args + (append args `("--option" ,(format "%s" (car options)))) + options (cdr options))) (setq args - (append args `("--option" ,(format "%s" (car options)))) - options (cdr options))) - (setq args - (if t1 - ;; Source is remote. - (append args + (if t1 + ;; Source is remote. + (append args + (list "-D" (tramp-unquote-shell-quote-argument + localname) + "-c" (tramp-unquote-shell-quote-argument + "tar qc - *") + "|" "tar" "xfC" "-" + (tramp-unquote-shell-quote-argument + tmpdir))) + ;; Target is remote. + (append (list + "tar" "cfC" "-" + (tramp-unquote-shell-quote-argument dirname) + "." "|") + args (list "-D" (tramp-unquote-shell-quote-argument localname) "-c" (tramp-unquote-shell-quote-argument - "tar qc - *") - "|" "tar" "xfC" "-" - (tramp-unquote-shell-quote-argument - tmpdir))) - ;; Target is remote. - (append (list "tar" "cfC" "-" - (tramp-unquote-shell-quote-argument dirname) - "." "|") - args - (list "-D" (tramp-unquote-shell-quote-argument - localname) - "-c" (tramp-unquote-shell-quote-argument - "tar qx -"))))) - - (unwind-protect - (with-temp-buffer - ;; Set the transfer process properties. - (tramp-set-connection-property - v "process-name" (buffer-name (current-buffer))) - (tramp-set-connection-property - v "process-buffer" (current-buffer)) - - (when t1 - ;; The smbclient tar command creates always - ;; complete paths. We must emulate the - ;; directory structure, and symlink to the real - ;; target. - (make-directory - (expand-file-name - ".." (concat tmpdir localname)) - 'parents) - (make-symbolic-link - newname (directory-file-name (concat tmpdir localname)))) - - ;; Use an asynchronous processes. By this, - ;; password can be handled. - (let* ((default-directory tmpdir) - (p (apply - #'start-process - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - tramp-smb-program args))) - - (tramp-message - v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) - (process-put p 'adjust-window-size-function #'ignore) - (set-process-query-on-exit-flag p nil) - (tramp-process-actions p v nil tramp-smb-actions-with-tar) - - (while (process-live-p p) - (sleep-for 0.1)) - (tramp-message v 6 "\n%s" (buffer-string)))) - - ;; Reset the transfer process properties. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") - (when t1 (delete-directory tmpdir 'recursive)))) - - ;; Handle KEEP-DATE argument. - (when keep-date - (tramp-compat-set-file-times - newname - (tramp-compat-file-attribute-modification-time - (file-attributes dirname)) - (unless ok-if-already-exists 'nofollow))) - - ;; Set the mode. - (unless keep-date - (set-file-modes newname (tramp-default-file-modes dirname))) - - ;; When newname did exist, we have wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname nil - (tramp-flush-file-properties v localname)))) - - ;; We must do it file-wise. - (t - (tramp-run-real-handler - #'copy-directory (list dirname newname keep-date parents))))))))) + "tar qx -"))))) + + (unwind-protect + (with-temp-buffer + ;; Set the transfer process properties. + (tramp-set-connection-property + v "process-name" (buffer-name (current-buffer))) + (tramp-set-connection-property + v "process-buffer" (current-buffer)) + + (when t1 + ;; The smbclient tar command creates always + ;; complete paths. We must emulate the + ;; directory structure, and symlink to the + ;; real target. + (make-directory + (expand-file-name + ".." (concat tmpdir localname)) + 'parents) + (make-symbolic-link + newname + (directory-file-name (concat tmpdir localname)))) + + ;; Use an asynchronous processes. By this, + ;; password can be handled. + (let* ((default-directory tmpdir) + (p (apply + #'start-process + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + tramp-smb-program args))) + + (tramp-message + v 6 "%s" (string-join (process-command p) " ")) + (process-put p 'vector v) + (process-put p 'adjust-window-size-function #'ignore) + (set-process-query-on-exit-flag p nil) + (tramp-process-actions + p v nil tramp-smb-actions-with-tar) + + (while (process-live-p p) + (sleep-for 0.1)) + (tramp-message v 6 "\n%s" (buffer-string)))) + + ;; Reset the transfer process properties. + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer") + (when t1 (delete-directory tmpdir 'recursive)))) + + ;; Handle KEEP-DATE argument. + (when keep-date + (tramp-compat-set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes dirname)) + (unless ok-if-already-exists 'nofollow))) + + ;; Set the mode. + (unless keep-date + (set-file-modes newname (tramp-default-file-modes dirname))) + + ;; When newname did exist, we have wrong cached values. + (when t2 + (with-parsed-tramp-file-name newname nil + (tramp-flush-file-properties v localname)))) + + ;; We must do it file-wise. + (t + (tramp-run-real-handler + #'copy-directory (list dirname newname keep-date parents)))))))))) (defun tramp-smb-handle-copy-file (filename newname &optional ok-if-already-exists keep-date diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4e409fcbf0..127a9bee95 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -177,6 +177,19 @@ The temporary file is not created." (make-temp-name "tramp-test") (if local temporary-file-directory tramp-test-temporary-file-directory)))) +;; Method "smb" supports `make-symbolic-link' only if the remote host +;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el +;; and tramp-sshfs.el do not support symbolic links at all. +(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body) + "Run BODY, ignoring \"make-symbolic-link not supported\" file error." + (declare (indent defun) (debug (body))) + `(condition-case err + (progn ,@body) + (file-error + (unless (string-equal (error-message-string err) + "make-symbolic-link not supported") + (signal (car err) (cdr err)))))) + ;; Don't print messages in nested `tramp--test-instrument-test-case' calls. (defvar tramp--test-instrument-test-case-p nil "Whether `tramp--test-instrument-test-case' run. @@ -2926,11 +2939,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (delete-directory tmp-name2 'recursive))) ;; Copy symlink to directory. Implemented since Emacs 28.1. - (when (and (tramp--test-emacs28-p) (tramp--test-sh-p)) + (when (boundp 'copy-directory-create-symlink) (dolist (copy-directory-create-symlink '(nil t)) (unwind-protect - (progn - ;; Copy empty directory. + (tramp--test-ignore-make-symbolic-link-error + ;; Copy to file name. (make-directory tmp-name1) (write-region "foo" nil tmp-name4) (make-symbolic-link tmp-name1 tmp-name7) @@ -2942,7 +2955,23 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should (string-equal (file-symlink-p tmp-name2) (file-symlink-p tmp-name7))) - (should (file-directory-p tmp-name2)))) + (should (file-directory-p tmp-name2))) + ;; Copy to directory name. + (delete-directory tmp-name2 'recursive) + (make-directory tmp-name2) + (should (file-directory-p tmp-name2)) + (copy-directory tmp-name7 (file-name-as-directory tmp-name2)) + (if copy-directory-create-symlink + (should + (string-equal + (file-symlink-p + (expand-file-name + (file-name-nondirectory tmp-name7) tmp-name2)) + (file-symlink-p tmp-name7))) + (should + (file-directory-p + (expand-file-name + (file-name-nondirectory tmp-name7) tmp-name2))))) ;; Cleanup. (ignore-errors @@ -3292,19 +3321,6 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ignore-errors (kill-buffer buffer)) (ignore-errors (delete-directory tmp-name1 'recursive)))))) -;; Method "smb" supports `make-symbolic-link' only if the remote host -;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el -;; and tramp-sshfs.el do not support symbolic links at all. -(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body) - "Run BODY, ignoring \"make-symbolic-link not supported\" file error." - (declare (indent defun) (debug (body))) - `(condition-case err - (progn ,@body) - (file-error - (unless (string-equal (error-message-string err) - "make-symbolic-link not supported") - (signal (car err) (cdr err)))))) - (ert-deftest tramp-test18-file-attributes () "Check `file-attributes'. This tests also `access-file', `file-readable-p', commit 6430c8419c4bd007c45f7cd3abacbdcf4ad01401 Author: Eli Zaretskii Date: Mon Aug 23 14:50:24 2021 +0300 ; * doc/lispref/variables.texi (Local Variables): Fix indexing. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 8a11154b73..3b0331847d 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -194,7 +194,7 @@ default scoping rule in Emacs Lisp is called @dfn{dynamic scoping}, which simply states that the current binding at any given point in the execution of a program is the most recently-created binding for that variable that still exists. For details about dynamic scoping, and an -alternative scoping rule called @dfn{lexical scoping}, @xref{Variable +alternative scoping rule called @dfn{lexical scoping}, @pxref{Variable Scoping}. The special forms @code{let} and @code{let*} exist to create local @@ -286,6 +286,8 @@ being run once: @end lisp @end defspec +@cindex dynamic binding, temporarily +@cindex dynamic let-binding @defspec dlet (bindings@dots{}) forms@dots{} This special form is like @code{let}, but it binds all variables dynamically. This is rarely useful---you usually want to bind normal @@ -294,10 +296,10 @@ defined with @code{defvar}) dynamically, and this is what @code{let} does. @code{dlet} can be useful when interfacing with old code that assumes -that certain variables are dynamically bound, but it's impractical to -@code{defvar} these variables. @code{dlet} will temporarily make the -bound variables special, execute the forms, and then make the -variables non-special again. +that certain variables are dynamically bound (@pxref{Dynamic +Binding}), but it's impractical to @code{defvar} these variables. +@code{dlet} will temporarily make the bound variables special, execute +the forms, and then make the variables non-special again. @end defspec Here is a complete list of the other facilities that create local commit d8e1cca6e52b34f0caf31ffb2b7a5114b91296b0 Author: Eli Zaretskii Date: Mon Aug 23 14:43:35 2021 +0300 ; * etc/NEWS: Fix wording of a recent change. diff --git a/etc/NEWS b/etc/NEWS index 4daeecda78..aefe582ad7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3656,7 +3656,7 @@ optional argument specifying whether to follow symbolic links. +++ ** 'parse-time-string' can now parse ISO 8601 format strings. -These are on the format "2020-01-15T16:12:21-08:00". +These have the format like "2020-01-15T16:12:21-08:00". --- ** The new function 'decoded-time-period' has been added.