commit 42950e9e4647c28f56c72cc27ef96edbafcbe5cd (HEAD, refs/remotes/origin/master) Author: Philipp Stephani Date: Mon May 17 10:00:36 2021 +0200 Fix a few Edebug specifications where code is wrapped in lambdas. As the Info node `(elisp) Specification List' explains, it is not correct to use `body' or t for a piece of code that the macro wraps in a `lambda' form. These should use `def-body' instead. * lisp/info-xref.el (info-xref-with-file): * lisp/subr.el (subr--with-wrapper-hook-no-warnings, track-mouse) (combine-change-calls, with-eval-after-load): * lisp/emacs-lisp/bytecomp.el (displaying-byte-compile-warnings): * lisp/emacs-lisp/cl-macs.el (cl-do-symbols, cl-progv): * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer): * lisp/emacs-lisp/gv.el (gv-letplace): * lisp/emacs-lisp/nadvice.el (define-advice): * lisp/emacs-lisp/thunk.el (thunk-delay): * lisp/vc/vc-dispatcher.el (vc-run-delayed): Use 'def-body' instead of t or 'body' where applicable. * lisp/emacs-lisp/package.el (package--with-response-buffer): Remove evaluation of the body altogether. I have no idea how to write it correctly in this case. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 114c264fee..86c5d32c72 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1758,7 +1758,7 @@ It is too wide if it has any lines longer than the largest of overriding-plist-environment))))) (defmacro displaying-byte-compile-warnings (&rest body) - (declare (debug t)) + (declare (debug (def-body))) `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body)) (warning-series-started (and (markerp warning-series) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index d7e6c307ed..283c5e4a74 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1924,7 +1924,8 @@ from OBARRAY. \(fn (VAR [OBARRAY [RESULT]]) BODY...)" (declare (indent 1) - (debug ((symbolp &optional form form) cl-declarations body))) + (debug ((symbolp &optional form form) cl-declarations + def-body))) ;; Apparently this doesn't have an implicit block. `(cl-block nil (let (,(car spec)) @@ -1964,7 +1965,7 @@ Each symbol in the first list is bound to the corresponding value in the second list (or to nil if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time." - (declare (indent 2) (debug (form form body))) + (declare (indent 2) (debug (form form def-body))) (let ((bodyfun (make-symbol "body")) (binds (make-symbol "binds")) (syms (make-symbol "syms")) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 1191fb8f8d..59ec4d2484 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -98,7 +98,7 @@ To be used in ERT tests. If BODY finishes successfully, the test buffer is killed; if there is an error, the test buffer is kept around on error for further inspection. Its name is derived from the name of the test and the result of NAME-FORM." - (declare (debug ((":name" form) body)) + (declare (debug ((":name" form) def-body)) (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index ce48e578e0..f08f7ac115 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -135,7 +135,7 @@ The returned value will then be an Elisp expression that first evaluates all the parts of PLACE that can be evaluated and then runs E. \(fn (GETTER SETTER) PLACE &rest BODY)" - (declare (indent 2) (debug (sexp form body))) + (declare (indent 2) (debug (sexp form def-body))) `(gv-get ,place (lambda ,vars ,@body))) ;; Different ways to declare a generalized variable. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index bf3e944639..4804e859eb 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -503,7 +503,7 @@ arguments. Note if NAME is nil the advice is anonymous; otherwise it is named `SYMBOL@NAME'. \(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" - (declare (indent 2) (doc-string 3) (debug (sexp sexp body))) + (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) (or (listp args) (signal 'wrong-type-argument (list 'listp args))) (or (<= 2 (length args) 4) (signal 'wrong-number-of-arguments (list 2 4 (length args)))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b68ebfbd88..5df9b53657 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1305,7 +1305,10 @@ is non-nil, don't propagate connection errors (does not apply to errors signaled by ERROR-FORM or by BODY). \(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" - (declare (indent defun) (debug t)) + (declare (indent defun) + ;; FIXME: This should be something like + ;; `form def-body &rest form', but that doesn't work. + (debug (form &rest sexp))) (while (keywordp (car body)) (setq body (cdr (cdr body)))) `(package--with-response-buffer-1 ,url (lambda () ,@body) diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el index 83e0fa75aa..7e349d22a4 100644 --- a/lisp/emacs-lisp/thunk.el +++ b/lisp/emacs-lisp/thunk.el @@ -52,7 +52,7 @@ (defmacro thunk-delay (&rest body) "Delay the evaluation of BODY." - (declare (debug t)) + (declare (debug (def-body))) (cl-assert lexical-binding) `(let (forced (val (lambda () ,@body))) diff --git a/lisp/info-xref.el b/lisp/info-xref.el index be1928d692..538a017f3c 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -95,7 +95,7 @@ about local variables or possible weirdness in a major mode. `lm-with-file' does a similar thing, but it sets `emacs-lisp-mode' which is not wanted here." - (declare (debug t) (indent 1)) + (declare (debug (form def-body)) (indent 1)) `(let* ((info-xref-with-file--filename ,filename) (info-xref-with-file--body (lambda () ,@body)) (info-xref-with-file--existing diff --git a/lisp/subr.el b/lisp/subr.el index 7a055f2ba1..82c2d221a6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2030,7 +2030,7 @@ FUN is then called once." (defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body) "Like (with-wrapper-hook HOOK ARGS BODY), but without warnings." - (declare (debug (form sexp body))) + (declare (debug (form sexp def-body))) ;; We need those two gensyms because CL's lexical scoping is not available ;; for function arguments :-( (let ((funs (make-symbol "funs")) @@ -3951,7 +3951,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." Within a `track-mouse' form, mouse motion generates input events that you can read with `read-event'. Normally, mouse motion is ignored." - (declare (debug t) (indent 0)) + (declare (debug (def-body)) (indent 0)) `(internal--track-mouse (lambda () ,@body))) (defmacro with-current-buffer (buffer-or-name &rest body) @@ -4455,7 +4455,7 @@ change `before-change-functions' or `after-change-functions'. Additionally, the buffer modifications of BODY are recorded on the buffer's undo list as a single \(apply ...) entry containing the function `undo--wrap-and-run-primitive-undo'." - (declare (debug t) (indent 2)) + (declare (debug (form form def-body)) (indent 2)) `(combine-change-calls-1 ,beg ,end (lambda () ,@body))) (defun undo--wrap-and-run-primitive-undo (beg end list) @@ -5046,7 +5046,7 @@ See also `with-eval-after-load'." FILE is normally a feature name, but it can also be a file name, in case that file does not provide any feature. See `eval-after-load' for more details about the different forms of FILE and their semantics." - (declare (indent 1) (debug t)) + (declare (indent 1) (debug (form def-body))) `(eval-after-load ,file (lambda () ,@body))) (defvar after-load-functions nil diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 87ca542f1c..c29458620e 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -254,7 +254,7 @@ CODE should be a function of no arguments." nil) (defmacro vc-run-delayed (&rest body) - (declare (indent 0) (debug t)) + (declare (indent 0) (debug (def-body))) `(vc-exec-after (lambda () ,@body))) (defvar vc-post-command-functions nil commit e761e12498ff108c3b82e9d27843baec6670447c Author: Eric Abrahamsen Date: Sat May 15 09:36:05 2021 -0700 Add a 'silent option for native-comp-async-report-warnings-errors * lisp/emacs-lisp/comp.el (native-comp-async-report-warnings-errors): Set to 'silent to log warnings, but not pop up the *Warnings* buffer. * lisp/emacs-lisp/comp.el (comp-accept-and-process-async-output): Check value. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 3e7f17ef1c..8c638312b0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -148,8 +148,13 @@ As asynchronous native compilation always starts from a pristine environment, it is more sensitive to such omissions, and might be unable to compile such Lisp source files correctly. -Set this variable to nil if these warnings annoy you." - :type 'boolean +Set this variable to nil to suppress warnings altogether, or to +the symbol `silent' to log warnings but not pop up the *Warnings* +buffer." + :type '(choice + (const :tag "Do not report warnings" nil) + (const :tag "Report and display warnings" t) + (const :tag "Report but do not display warnings" 'silent)) :version "28.1") (defcustom native-comp-async-query-on-exit nil @@ -3874,14 +3879,18 @@ processes from `comp-async-compilations'" (defun comp-accept-and-process-async-output (process) "Accept PROCESS output and check for diagnostic messages." (if native-comp-async-report-warnings-errors - (with-current-buffer (process-buffer process) - (save-excursion - (accept-process-output process) - (goto-char (or comp-last-scanned-async-output (point-min))) - (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$" - nil t) - (display-warning 'comp (match-string 0))) - (setq comp-last-scanned-async-output (point-max)))) + (let ((warning-suppress-types + (if (eq native-comp-async-report-warnings-errors 'silent) + (cons '(comp) warning-suppress-types) + warning-suppress-types))) + (with-current-buffer (process-buffer process) + (save-excursion + (accept-process-output process) + (goto-char (or comp-last-scanned-async-output (point-min))) + (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$" + nil t) + (display-warning 'comp (match-string 0))) + (setq comp-last-scanned-async-output (point-max))))) (accept-process-output process))) (defun comp-run-async-workers () commit 0212fb180a118795b4de383cc712e7079c998cef Author: Eric Abrahamsen Date: Sun May 16 10:20:43 2021 -0700 Use condition-case-unless-debug in nnselect-run * lisp/gnus/nnselect.el (nnselect-run): This is confusing for users, make it more yielding to common debugging strategies. diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 5ac4c3a64e..ecec705b32 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -777,7 +777,7 @@ If this variable is nil, or if the provided function returns nil, Return an article list." (let ((func (alist-get 'nnselect-function specs)) (args (alist-get 'nnselect-args specs))) - (condition-case err + (condition-case-unless-debug err (funcall func args) (error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err) [])))) commit 10a14f6ac3f0d2464890bd9a4ef20ff228a9d255 Author: Eric Abrahamsen Date: Sun May 16 10:19:41 2021 -0700 Fix function signature for gnus-search-indexed-parse-output * lisp/gnus/gnus-search.el (gnus-search-indexed-parse-output): Generic function arg list didn't match the method arglist, which made for confusing function help. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 61a1d67524..a59d0e57a7 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1294,8 +1294,8 @@ elements are present." ;; First, some common methods. -(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups) - "Parse the results of ENGINE's query against SERVER in GROUPS. +(cl-defgeneric gnus-search-indexed-parse-output (engine server query &optional groups) + "Parse the results of ENGINE's QUERY against SERVER in GROUPS. Locally-indexed search engines return results as a list of filenames, sometimes with additional information. Returns a list of viable results, in the form of a list of [group article score] commit c14e0da3611b2c82b0f194e2d70af681bfcfeba8 Author: Lars Ingebrigtsen Date: Sun May 16 17:59:54 2021 +0200 mouse-wheel-progressive-speed doc string clarification * lisp/mwheel.el (mouse-wheel-progressive-speed): Doc string improvement (bug#45322). diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 048f50c772..b31805a575 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -131,7 +131,10 @@ scrolling." :version "28.1") (defcustom mouse-wheel-progressive-speed t - "If non-nil, the faster the user moves the wheel, the faster the scrolling. + "If nil, scrolling speed is proportional to the wheel speed. +If non-nil, moving the wheel faster will make scrolling +progressively faster. + Note that this has no effect when `mouse-wheel-scroll-amount' specifies a \"near full screen\" scroll or when the mouse wheel sends key instead of button events." commit 5a82d4ce5add6d5eb3c5071537eef950e583e699 Author: Ingo Lohmar Date: Sun May 16 16:32:10 2021 +0200 prepend newline in sqli buffer (sql-remove-continuation-prompt, sql-send-string): Move newline insertion. Previously, the preoutput filter `sql-remove-continuation-prompt' inserted a leading newline in the interactive SQL buffer if it decided that is has to remove continuation prompts and that it had found all it was looking for. 1) This filter function was a doubtful place to do that (arguably, its name does not suggest any action like this). 2) The behavior worked inconsistently, eg, when sending a single-line "SELECT" statement, because it only ran when the filter function needed to remove any prompts (for example, not when sending a region without newlines). This can lead to misaligned table headers, which explains why emacswiki and stackoverflow both present several fixes to this behavior. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 65a4094d70..83cb77ef78 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3723,8 +3723,7 @@ to avoid deleting non-prompt output." ;; If we've found all the expected prompts, stop looking (if (= sql-output-newline-count 0) - (setq sql-output-newline-count nil - oline (concat "\n" oline)) + (setq sql-output-newline-count nil) ;; Still more possible prompts, leave them for the next pass (setq sql-preoutput-hold oline @@ -3769,6 +3768,8 @@ to avoid deleting non-prompt output." (with-current-buffer sql-buffer (when sql-debug-send (message ">>SQL> %S" s)) + (insert "\n") + (comint-set-process-mark) ;; Send the string (trim the trailing whitespace) (sql-input-sender (get-buffer-process (current-buffer)) s) commit b6d02dc3766f30078fdf7778951e2be78589f446 Author: Tassilo Horn Date: Sun May 16 16:19:57 2021 +0200 Add bug-reference-mode-force-auto-setup * lisp/progmodes/bug-reference.el (bug-reference-try-setup-from-rmail): Match the Rmail mbox filename against GROUP-REGEXP in bug-reference-setup-from-mail-alist. (bug-reference-mode-force-auto-setup): New function which forces auto-setup even if bug-reference-bug-regexp and bug-reference-url-format are already set. diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index bdbe048a93..fc9627c272 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -344,9 +344,11 @@ and set it if applicable." (defun bug-reference-try-setup-from-rmail () "Try setting up `bug-reference-mode' from the current rmail mail. -Looks at the headers List-Id, To, From, and Cc and tries to guess -suitable values for `bug-reference-bug-regexp' and -`bug-reference-url-format'." +Guesses suitable `bug-reference-bug-regexp' and +`bug-reference-url-format' values by matching the current Rmail +file's name against GROUP-REGEXP and the values of List-Id, To, +From, and Cc against HEADER-REGEXP in +`bug-reference-setup-from-mail-alist'." (with-demoted-errors "Error in bug-reference-try-setup-from-rmail: %S" (when (and bug-reference-mode @@ -358,7 +360,8 @@ suitable values for `bug-reference-bug-regexp' and (let ((val (mail-fetch-field field))) (when val (push val header-values))))) - (bug-reference--maybe-setup-from-mail nil header-values))))) + (bug-reference--maybe-setup-from-mail + (buffer-file-name) header-values))))) (defvar bug-reference-setup-from-irc-alist `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc" @@ -482,6 +485,18 @@ guesswork is based on these variables: (widen) (bug-reference-unfontify (point-min) (point-max))))) +(defun bug-reference-mode-force-auto-setup () + "Enable `bug-reference-mode' and force auto-setup. +Enabling `bug-reference-mode' runs its auto-setup only if +`bug-reference-bug-regexp' and `bug-reference-url-format' are not +set already. This function sets the latter to `nil' +buffer-locally, so that the auto-setup will always run. + +This is mostly intended for MUA modes like `rmail-mode' where the +same buffer is re-used for different contexts." + (setq-local bug-reference-url-format nil) + (bug-reference-mode)) + ;;;###autoload (define-minor-mode bug-reference-prog-mode "Like `bug-reference-mode', but only buttonize in comments and strings." commit 069c2fb17a694621cdbedc07e666505928724f14 Author: Dario Gjorgjevski Date: Sun May 16 15:50:41 2021 +0200 Add more completion tests * test/lisp/minibuffer-tests.el (completion--pcm-score) (completion--pcm-first-difference-pos): New helpers. (completion-pcm-test-1, completion-pcm-test-2) (completion-pcm-test-3, completion-pcm-test-4) (completion-pcm-test-5, completion-pcm-test-6) (completion-substring-test-1, completion-substring-test-2) (completion-substring-test-3, completion-substring-test-4) (completion-flex-test-1, completion-flex-test-2) (completion-flex-test-3): New tests (bug#42149) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 6ab5f57eff..c3ba8f9a92 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -188,5 +188,148 @@ '("some/alpha" "base/epsilon" "base/delta")) `("epsilon" "delta" "beta" "alpha" "gamma" . 5)))) +(defun completion--pcm-score (comp) + "Get `completion-score' from COMP." + (get-text-property 0 'completion-score comp)) + +(defun completion--pcm-first-difference-pos (comp) + "Get `completions-first-difference' from COMP." + (cl-loop for pos = (next-single-property-change 0 'face comp) + then (next-single-property-change pos 'face comp) + while pos + when (eq (get-text-property pos 'face comp) + 'completions-first-difference) + return pos)) + +(ert-deftest completion-pcm-test-1 () + ;; Point is at end, this does not match anything + (should (null + (completion-pcm-all-completions + "foo" '("hello" "world" "barfoobar") nil 3)))) + +(ert-deftest completion-pcm-test-2 () + ;; Point is at beginning, this matches "barfoobar" + (should (equal + (car (completion-pcm-all-completions + "foo" '("hello" "world" "barfoobar") nil 0)) + "barfoobar"))) + +(ert-deftest completion-pcm-test-3 () + ;; Full match! + (should (eql + (completion--pcm-score + (car (completion-pcm-all-completions + "R" '("R" "hello") nil 1))) + 1.0))) + +(ert-deftest completion-pcm-test-4 () + ;; One fourth of a match and no match due to point being at the end + (should (eql + (completion--pcm-score + (car (completion-pcm-all-completions + "RO" '("RaOb") nil 1))) + (/ 1.0 4.0))) + (should (null + (completion-pcm-all-completions + "RO" '("RaOb") nil 2)))) + +(ert-deftest completion-pcm-test-5 () + ;; Since point is at the beginning, there is nothing that can really + ;; be typed anymore + (should (null + (completion--pcm-first-difference-pos + (car (completion-pcm-all-completions + "f" '("few" "many") nil 0)))))) + +(ert-deftest completion-pcm-test-6 () + ;; Wildcards and delimiters work + (should (equal + (car (completion-pcm-all-completions + "li-pac*" '("list-packages") nil 7)) + "list-packages")) + (should (null + (car (completion-pcm-all-completions + "li-pac*" '("do-not-list-packages") nil 7))))) + +(ert-deftest completion-substring-test-1 () + ;; One third of a match! + (should (equal + (car (completion-substring-all-completions + "foo" '("hello" "world" "barfoobar") nil 3)) + "barfoobar")) + (should (eql + (completion--pcm-score + (car (completion-substring-all-completions + "foo" '("hello" "world" "barfoobar") nil 3))) + (/ 1.0 3.0)))) + +(ert-deftest completion-substring-test-2 () + ;; Full match! + (should (eql + (completion--pcm-score + (car (completion-substring-all-completions + "R" '("R" "hello") nil 1))) + 1.0))) + +(ert-deftest completion-substring-test-3 () + ;; Substring match + (should (equal + (car (completion-substring-all-completions + "custgroup" '("customize-group") nil 4)) + "customize-group")) + (should (null + (car (completion-substring-all-completions + "custgroup" '("customize-group") nil 5))))) + +(ert-deftest completion-substring-test-4 () + ;; `completions-first-difference' should be at the right place + (should (eql + (completion--pcm-first-difference-pos + (car (completion-substring-all-completions + "jab" '("dabjobstabby" "many") nil 1))) + 4)) + (should (null + (completion--pcm-first-difference-pos + (car (completion-substring-all-completions + "jab" '("dabjabstabby" "many") nil 1))))) + (should (equal + (completion--pcm-first-difference-pos + (car (completion-substring-all-completions + "jab" '("dabjabstabby" "many") nil 3))) + 6))) + +(ert-deftest completion-flex-test-1 () + ;; Fuzzy match + (should (equal + (car (completion-flex-all-completions + "foo" '("hello" "world" "fabrobazo") nil 3)) + "fabrobazo"))) + +(ert-deftest completion-flex-test-2 () + ;; Full match! + (should (eql + (completion--pcm-score + (car (completion-flex-all-completions + "R" '("R" "hello") nil 1))) + 1.0))) + +(ert-deftest completion-flex-test-3 () + ;; Another fuzzy match, but more of a "substring" one + (should (equal + (car (completion-flex-all-completions + "custgroup" '("customize-group-other-window") nil 4)) + "customize-group-other-window")) + ;; `completions-first-difference' should be at the right place + (should (equal + (completion--pcm-first-difference-pos + (car (completion-flex-all-completions + "custgroup" '("customize-group-other-window") nil 4))) + 4)) + (should (equal + (completion--pcm-first-difference-pos + (car (completion-flex-all-completions + "custgroup" '("customize-group-other-window") nil 9))) + 15))) + (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here commit bf8b8cc6c57e051e11306aa9c409dc4ed8c442bc Author: Sebastian Urban Date: Sun May 16 15:29:39 2021 +0200 Improve some quotation quoting in the Emacs manual * doc/emacs/text.texi (Quotation Marks, Quotation Marks): * doc/emacs/display.texi (Text Display): Fix some issues when quoting quote marks and the like (bug#35885). * doc/emacs/emacs.texi: Switch on double-sided printing headings. Copyright-paperwork-exempt: yes diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 4a34fd36c5..666a479582 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -112,7 +112,7 @@ just like digits. Case is ignored. @cindex curly quotes, inserting @cindex curved quotes, inserting A few common Unicode characters can be inserted via a command -starting with @kbd{C-x 8}. For example, @kbd{C-x 8 [} inserts @t{‘} +starting with @w{@kbd{C-x 8}}. For example, @kbd{C-x 8 [} inserts @t{‘} which is Unicode code-point U+2018 @sc{left single quotation mark}, sometimes called a left single ``curved quote'' or ``curly quote''. Similarly, @w{@kbd{C-x 8 ]}}, @kbd{C-x 8 @{} and @kbd{C-x 8 @}} insert the diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 58d08b43c0..5fccdaa834 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1649,10 +1649,10 @@ for details. @cindex curved quotes, and terminal capabilities @cindex @code{homoglyph} face -Emacs tries to determine if the curved quotes @samp{‘} and @samp{’} +Emacs tries to determine if the curved quotes @t{‘} and @t{’} can be displayed on the current display. By default, if this seems to -be so, then Emacs will translate the @acronym{ASCII} quotes (@samp{`} -and @samp{'}), when they appear in messages and help texts, to these +be so, then Emacs will translate the @acronym{ASCII} quotes @w{(@samp{`} +and @samp{'})}, when they appear in messages and help texts, to these curved quotes. You can influence or inhibit this translation by customizing the user option @code{text-quoting-style} (@pxref{Keys in Documentation,,, elisp, The Emacs Lisp Reference Manual}). @@ -1661,7 +1661,7 @@ Documentation,,, elisp, The Emacs Lisp Reference Manual}). known to look just like @acronym{ASCII} characters, they are shown with the @code{homoglyph} face. Curved quotes that are known not to be displayable are shown as their @acronym{ASCII} approximations -@t{`}, @t{'}, and @t{"} with the @code{homoglyph} face. +@samp{`}, @samp{'}, and @samp{"} with the @code{homoglyph} face. @node Cursor Display @section Displaying the Cursor diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 590dc42d15..e0de3bb43a 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -99,6 +99,7 @@ Cover art by Etienne Suvasa; cover design by Matt Lee. @end titlepage +@headings double @summarycontents @contents diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 2c9d486c33..f2fe248015 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -421,13 +421,12 @@ beginning of a line. @cindex curved quotes @cindex guillemets @findex electric-quote-mode -@c The funny quoting below is to make the printed version look -@c correct. FIXME. + One common way to quote is the typewriter convention, which quotes -using straight apostrophes @t{'like this'} or double-quotes @t{"like +using straight apostrophes @samp{'like this'} or double-quotes @samp{"like this"}. Another common way is the curved quote convention, which uses -left and right single or double quotation marks `@t{like this}' or -``@t{like this}''@footnote{ +left and right single or double quotation marks @t{‘like this’} or +@t{“like this”}@footnote{ The curved single quote characters are U+2018 @sc{left single quotation mark} and U+2019 @sc{right single quotation mark}; the curved double quotes are U+201C @sc{left double quotation mark} and U+201D @sc{right double @@ -445,7 +444,7 @@ default quotes listed above, by customizing the variable @code{electric-quote-chars}, a list of four characters, where the items correspond to the left single quote, the right single quote, the left double quote and the right double quote, respectively, whose -default value is @code{'(?@r{`} ?@r{'} ?@r{``} ?@r{''})}. +default value is @w{@code{'(@w{?}‘ ?’ ?“ ?”)}}. @vindex electric-quote-paragraph @vindex electric-quote-comment @@ -461,7 +460,7 @@ variables. @vindex electric-quote-replace-double You can also set the option @code{electric-quote-replace-double} to -a non-@code{nil} value. Then, typing @t{"} insert an appropriate +a non-@code{nil} value. Then, typing @kbd{"} insert an appropriate curved double quote depending on context: @t{“} at the beginning of the buffer or after a line break, whitespace, opening parenthesis, or quote character, and @t{”} otherwise. @@ -473,7 +472,7 @@ To toggle it globally, type type @kbd{C-q `} or @kbd{C-q '} instead of @kbd{`} or @kbd{'}. To insert a curved quote even when Electric Quote is disabled or inactive, you can type @kbd{C-x 8 [} for @t{‘}, @kbd{C-x 8 ]} for -@t{’}, @kbd{C-x 8 @{} for ``, and @kbd{C-x 8 @}} for ''. +@t{’}, @kbd{C-x 8 @{} for @t{“}, and @kbd{C-x 8 @}} for @t{”}. @xref{Inserting Text}. Note that the value of @code{electric-quote-chars} does not affect these keybindings, they are not keybindings of @code{electric-quote-mode} but bound in commit 487498e497f8c6b6303bd5feeac83a5bcc2315af Author: Noam Postavsky Date: Sun May 16 15:19:57 2021 +0200 Remove unreliable test for match data clobbering * src/search.c (Freplace_match): Don't test for change in search_regs start and end, this is unreliable if change hooks modify text earlier in the buffer (bug#35264). diff --git a/src/search.c b/src/search.c index c757bf3d1f..df384e1dcf 100644 --- a/src/search.c +++ b/src/search.c @@ -2723,7 +2723,6 @@ since only regular expressions have distinguished subexpressions. */) } newpoint = sub_start + SCHARS (newtext); - ptrdiff_t newstart = sub_start == sub_end ? newpoint : sub_start; /* Replace the old text with the new in the cleanest possible way. */ replace_range (sub_start, sub_end, newtext, 1, 0, 1, true); @@ -2739,11 +2738,11 @@ since only regular expressions have distinguished subexpressions. */) /* The replace_range etc. functions can trigger modification hooks (see signal_before_change and signal_after_change). Try to error out if these hooks clobber the match data since clobbering can - result in confusing bugs. Although this sanity check does not - catch all possible clobberings, it should catch many of them. */ - if (! (search_regs.num_regs == num_regs - && search_regs.start[sub] == newstart - && search_regs.end[sub] == newpoint)) + result in confusing bugs. We used to check for changes in + search_regs start and end, but that fails if modification hooks + remove or add text earlier in the buffer, so just check num_regs + now. */ + if (search_regs.num_regs != num_regs) error ("Match data clobbered by buffer modification hooks"); /* Put point back where it was in the text, if possible. */ commit 01bd4d1a824816fba34571623a65c9c1541c27e5 Author: Philipp Stephani Date: Thu May 6 19:13:00 2021 +0200 Optimize calls to 'eql', 'memql' and similar for fixnums. It's good practice to compare integers using 'eql' because two bignum objects representing the same integer might not be 'eq'. However, 'eql' is slower and doesn't have its own byte code. Therefore, replace it with 'eq' if one argument is guaranteed to be a fixnum on all platforms. * lisp/emacs-lisp/byte-opt.el (byte-optimize--fixnump): New helper function. (byte-optimize-equal, byte-optimize-member, byte-optimize-assoc): Use it to optimize 'eql' etc. to 'eq' if it will always compare fixnums. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 33b4d4b3c8..28b53d0589 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -951,12 +951,20 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") "Whether EXPR is a constant symbol." (and (macroexp-const-p expr) (symbolp (eval expr)))) +(defun byte-optimize--fixnump (o) + "Return whether O is guaranteed to be a fixnum in all Emacsen. +See Info node `(elisp) Integer Basics'." + (and (fixnump o) (<= -536870912 o 536870911))) + (defun byte-optimize-equal (form) - ;; Replace `equal' or `eql' with `eq' if at least one arg is a symbol. + ;; Replace `equal' or `eql' with `eq' if at least one arg is a + ;; symbol or fixnum. (byte-optimize-binary-predicate (if (= (length (cdr form)) 2) (if (or (byte-optimize--constant-symbol-p (nth 1 form)) - (byte-optimize--constant-symbol-p (nth 2 form))) + (byte-optimize--constant-symbol-p (nth 2 form)) + (byte-optimize--fixnump (nth 1 form)) + (byte-optimize--fixnump (nth 2 form))) (cons 'eq (cdr form)) form) ;; Arity errors reported elsewhere. @@ -964,14 +972,19 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (defun byte-optimize-member (form) ;; Replace `member' or `memql' with `memq' if the first arg is a symbol, - ;; or the second arg is a list of symbols. + ;; or the second arg is a list of symbols. Same with fixnums. (if (= (length (cdr form)) 2) (if (or (byte-optimize--constant-symbol-p (nth 1 form)) + (byte-optimize--fixnump (nth 1 form)) (let ((arg2 (nth 2 form))) (and (macroexp-const-p arg2) (let ((listval (eval arg2))) (and (listp listval) - (not (memq nil (mapcar #'symbolp listval)))))))) + (not (memq nil (mapcar + (lambda (o) + (or (symbolp o) + (byte-optimize--fixnump o))) + listval)))))))) (cons 'memq (cdr form)) form) ;; Arity errors reported elsewhere. @@ -979,11 +992,12 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (defun byte-optimize-assoc (form) ;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq', - ;; if the first arg is a symbol. + ;; if the first arg is a symbol or fixnum. (cond ((/= (length form) 3) form) - ((byte-optimize--constant-symbol-p (nth 1 form)) + ((or (byte-optimize--constant-symbol-p (nth 1 form)) + (byte-optimize--fixnump (nth 1 form))) (cons (if (eq (car form) 'assoc) 'assq 'rassq) (cdr form))) (t (byte-optimize-constant-args form)))) commit 4f510f63a8fc3483eeac7887cb69ddfa6de9b5a6 Author: Michael Albinus Date: Sun May 16 12:08:09 2021 +0200 Fix handling of stderr buffer in Tramp's make-process (Bug#47861) * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Reimplement stderr buffer handling. (Bug#47861) (tramp-maybe-open-connection): Improve traces. * test/lisp/net/tramp-tests.el (tramp-test30-make-process): Rework for stderr buffer. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 60090d31b8..f24d0effe7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2723,13 +2723,12 @@ the result will be a local, non-Tramp, file name." ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. -;; The complete STDERR buffer is available only when the process has -;; terminated. (defun tramp-sh-handle-make-process (&rest args) "Like `make-process' for Tramp files. -STDERR can also be a file name. If method parameter `tramp-direct-async' -and connection property \"direct-async-process\" are non-nil, an -alternative implementation will be used." +STDERR can also be a remote file name. If method parameter +`tramp-direct-async' and connection property +\"direct-async-process\" are non-nil, an alternative +implementation will be used." (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args @@ -2763,7 +2762,7 @@ alternative implementation will be used." (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr) (stringp stderr)) (signal 'wrong-type-argument (list #'bufferp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (when (and (stringp stderr) (not (tramp-equal-remote default-directory stderr))) (signal 'file-error (list "Wrong stderr" stderr))) @@ -2775,9 +2774,9 @@ alternative implementation will be used." ;; STDERR can also be a file name. (tmpstderr (and stderr - (if (and (stringp stderr) (tramp-tramp-file-p stderr)) - (tramp-unquote-file-local-name stderr) - (tramp-make-tramp-temp-file v)))) + (tramp-unquote-file-local-name + (if (stringp stderr) + stderr (tramp-make-tramp-temp-name v))))) (remote-tmpstderr (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) (program (car command)) @@ -2786,7 +2785,8 @@ alternative implementation will be used." ;; "-c", it might be that the arguments exceed the ;; command line length. Therefore, we modify the ;; command. - (heredoc (and (stringp program) + (heredoc (and (not (bufferp stderr)) + (stringp program) (string-match-p "sh$" program) (= (length args) 2) (string-equal "-c" (car args)) @@ -2850,6 +2850,23 @@ alternative implementation will be used." tramp-current-connection p) + ;; Handle error buffer. + (when (bufferp stderr) + (with-current-buffer stderr + (setq buffer-read-only nil)) + ;; Create named pipe. + (tramp-send-command v (format "mknod %s p" tmpstderr)) + ;; Create stderr process. + (make-process + :name (buffer-name stderr) + :buffer stderr + :command `("cat" ,tmpstderr) + :coding coding + :noquery t + :filter nil + :sentinel #'ignore + :file-handler t)) + (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) @@ -2912,38 +2929,16 @@ alternative implementation will be used." (ignore-errors (set-process-query-on-exit-flag p (null noquery)) (set-marker (process-mark p) (point))) - ;; We must flush them here already; otherwise - ;; `rename-file', `delete-file' or - ;; `insert-file-contents' will fail. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") - ;; Copy tmpstderr file. - (when (and (stringp stderr) - (not (tramp-tramp-file-p stderr))) - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (rename-file remote-tmpstderr stderr)))) - ;; Provide error buffer. This shows only - ;; initial error messages; messages arriving - ;; later on will be inserted when the process - ;; is deleted. The temporary file will exist - ;; until the process is deleted. + ;; Kill stderr process delete and named pipe. (when (bufferp stderr) - (with-current-buffer stderr - ;; There's a mysterious error, see - ;; . - (ignore-errors - (insert-file-contents-literally remote-tmpstderr))) - ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (when (file-exists-p remote-tmpstderr) - (with-current-buffer stderr - (ignore-errors - (insert-file-contents-literally - remote-tmpstderr nil nil nil 'replace))) + (ignore-errors + (while (accept-process-output + (get-buffer-process stderr) 0 nil t)) + (delete-process (get-buffer-process stderr))) + (ignore-errors (delete-file remote-tmpstderr))))) ;; Return process. p))) @@ -4834,10 +4829,12 @@ connection if a previous connection has died for some reason." (with-tramp-progress-reporter vec 3 (if (zerop (length (tramp-file-name-user vec))) - (format "Opening connection for %s using %s" + (format "Opening connection %s for %s using %s" + process-name (tramp-file-name-host vec) (tramp-file-name-method vec)) - (format "Opening connection for %s@%s using %s" + (format "Opening connection %s for %s@%s using %s" + process-name (tramp-file-name-user vec) (tramp-file-name-host vec) (tramp-file-name-method vec))) @@ -5937,8 +5934,6 @@ function cell is returned to be applied on a buffer." ;; session could be reused after a connection loss. Use dtach, or ;; screen, or tmux, or mosh. ;; -;; * Implement `:stderr' of `make-process' as pipe process. - ;; * One interesting solution (with other applications as well) would ;; be to stipulate, as a directory or connection-local variable, an ;; additional rc file on the remote machine that is sourced every diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a045b9c62f..5e4626ab41 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4581,8 +4581,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) - (tmp-name1 (tramp--test-make-temp-name nil quoted)) - (tmp-name2 (tramp--test-make-temp-name 'local quoted)) + (tmp-name (tramp--test-make-temp-name nil quoted)) kill-buffer-query-functions proc) (with-no-warnings (should-not (make-process))) @@ -4610,13 +4609,13 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Simple process using a file. (unwind-protect (with-temp-buffer - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) (setq proc (with-no-warnings (make-process :name "test2" :buffer (current-buffer) - :command `("cat" ,(file-name-nondirectory tmp-name1)) + :command `("cat" ,(file-name-nondirectory tmp-name)) :file-handler t))) (should (processp proc)) ;; Read output. @@ -4628,7 +4627,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc) - (delete-file tmp-name1))) + (delete-file tmp-name))) ;; Process filter. (unwind-protect @@ -4692,11 +4691,17 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." :stderr stderr :file-handler t))) (should (processp proc)) - ;; Read stderr. + ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) (while (accept-process-output proc 0 nil t))) - (delete-process proc) + ;; Read stderr. (with-current-buffer stderr + (with-timeout (10 (tramp--test-timeout-handler)) + (while (not (string-match-p + "No such file or directory" (buffer-string))) + (while (accept-process-output + (get-buffer-process stderr) 0 nil t)))) + (delete-process proc) (should (string-match-p "cat:.* No such file or directory" (buffer-string))))) @@ -4707,30 +4712,29 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Process with stderr file. (unless (tramp-direct-async-process-p) - (dolist (tmpfile `(,tmp-name1 ,tmp-name2)) - (unwind-protect + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test6" :buffer (current-buffer) + :command '("cat" "/does-not-exist") + :stderr tmp-name + :file-handler t))) + (should (processp proc)) + ;; Read stderr. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc nil nil t))) + (delete-process proc) (with-temp-buffer - (setq proc - (with-no-warnings - (make-process - :name "test6" :buffer (current-buffer) - :command '("cat" "/does-not-exist") - :stderr tmpfile - :file-handler t))) - (should (processp proc)) - ;; Read stderr. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc nil nil t))) - (delete-process proc) - (with-temp-buffer - (insert-file-contents tmpfile) - (should - (string-match-p - "cat:.* No such file or directory" (buffer-string))))) + (insert-file-contents tmp-name) + (should + (string-match-p + "cat:.* No such file or directory" (buffer-string))))) - ;; Cleanup. - (ignore-errors (delete-process proc)) - (ignore-errors (delete-file tmpfile)))))))) + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (delete-file tmp-name))))))) (tramp--test--deftest-direct-async-process tramp-test30-make-process "Check direct async `make-process'.")