commit 09e07fb008abdd1f546d193bd87ecf61d9b7e809 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Thu Sep 24 23:02:06 2020 -0400 * lisp/progmodes/ruby-mode.el (ruby-use-smie): Declare obsolete (ruby-mode-map, ruby-mode-menu): Don't use ruby-for/backward-sexp any more. (ruby-mode-variables): Always setup SMIE navigation. Still obey `ruby-use-smie` for indentation. (ruby-forward-sexp, ruby-backward-sexp): Mark as obsolete. diff --git a/etc/NEWS b/etc/NEWS index 6bedd0347e..9cd8aaa41c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -218,6 +218,11 @@ trying to be non-destructive. * Changes in Specialized Modes and Packages in Emacs 28.1 +** Ruby mode +*** 'ruby-use-smie' is declared obsolete +SMIE is now always enabled and only 'ruby-use-smie' only controls +whether indentation is done using SMIE or with the old ad-hoc code. + --- ** Specific warnings can now be disabled from the warning buffer. When a warning is displayed to the user, the resulting buffer now has diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 831acf87bf..a11634bc9f 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -142,12 +142,11 @@ This should only be called after matching against `ruby-here-doc-beg-re'." "Regexp to match symbols.") (defvar ruby-use-smie t) +(make-obsolete-variable 'ruby-use-smie nil "28.1") (defvar ruby-mode-map (let ((map (make-sparse-keymap))) (unless ruby-use-smie - (define-key map (kbd "M-C-b") 'ruby-backward-sexp) - (define-key map (kbd "M-C-f") 'ruby-forward-sexp) (define-key map (kbd "M-C-q") 'ruby-indent-exp)) (when ruby-use-smie (define-key map (kbd "M-C-d") 'smie-down-list)) @@ -170,14 +169,8 @@ This should only be called after matching against `ruby-here-doc-beg-re'." "--" ["Toggle String Quotes" ruby-toggle-string-quotes t] "--" - ["Backward Sexp" ruby-backward-sexp - :visible (not ruby-use-smie)] - ["Backward Sexp" backward-sexp - :visible ruby-use-smie] - ["Forward Sexp" ruby-forward-sexp - :visible (not ruby-use-smie)] - ["Forward Sexp" forward-sexp - :visible ruby-use-smie] + ["Backward Sexp" backward-sexp t] + ["Forward Sexp" forward-sexp t] ["Indent Sexp" ruby-indent-exp :visible (not ruby-use-smie)] ["Indent Sexp" prog-indent-sexp @@ -741,10 +734,10 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (defun ruby-mode-variables () "Set up initial buffer-local variables for Ruby mode." (setq indent-tabs-mode ruby-indent-tabs-mode) - (if ruby-use-smie - (smie-setup ruby-smie-grammar #'ruby-smie-rules - :forward-token #'ruby-smie--forward-token - :backward-token #'ruby-smie--backward-token) + (smie-setup ruby-smie-grammar #'ruby-smie-rules + :forward-token #'ruby-smie--forward-token + :backward-token #'ruby-smie--backward-token) + (unless ruby-use-smie (setq-local indent-line-function #'ruby-indent-line)) (setq-local comment-start "# ") (setq-local comment-end "") @@ -1378,7 +1371,8 @@ move forward." The defun begins at or after the point. This function is called by `end-of-defun'." (interactive "p") - (ruby-forward-sexp) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (ruby-forward-sexp)) (let (case-fold-search) (when (looking-back (concat "^\\s *" ruby-block-end-re) (line-beginning-position)) @@ -1467,11 +1461,14 @@ With ARG, move out of multiple blocks." (defun ruby-forward-sexp (&optional arg) "Move forward across one balanced expression (sexp). With ARG, do it many times. Negative ARG means move backward." + (declare (obsolete forward-sexp "28.1")) ;; TODO: Document body (interactive "p") (cond (ruby-use-smie (forward-sexp arg)) - ((and (numberp arg) (< arg 0)) (ruby-backward-sexp (- arg))) + ((and (numberp arg) (< arg 0)) + (with-suppressed-warnings ((obsolete ruby-backward-sexp)) + (ruby-backward-sexp (- arg)))) (t (let ((i (or arg 1))) (condition-case nil @@ -1515,11 +1512,14 @@ With ARG, do it many times. Negative ARG means move backward." (defun ruby-backward-sexp (&optional arg) "Move backward across one balanced expression (sexp). With ARG, do it many times. Negative ARG means move forward." + (declare (obsolete backward-sexp "28.1")) ;; TODO: Document body (interactive "p") (cond (ruby-use-smie (backward-sexp arg)) - ((and (numberp arg) (< arg 0)) (ruby-forward-sexp (- arg))) + ((and (numberp arg) (< arg 0)) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (ruby-forward-sexp (- arg)))) (t (let ((i (or arg 1))) (condition-case nil @@ -1671,7 +1671,8 @@ See `add-log-current-defun-function'." (defun ruby-block-contains-point (pt) (save-excursion (save-match-data - (ruby-forward-sexp) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (ruby-forward-sexp)) (> (point) pt)))) (defun ruby-brace-to-do-end (orig end) @@ -1749,7 +1750,8 @@ If the result is do-end block, it will always be multiline." (progn (goto-char (or (match-beginning 1) (match-beginning 2))) (setq beg (point)) - (save-match-data (ruby-forward-sexp)) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (save-match-data (ruby-forward-sexp))) (setq end (point)) (> end start))) (if (match-beginning 1) commit 040c30295e00bfabd207d917ab7bdfeee5aa0a09 Author: Lars Ingebrigtsen Date: Fri Sep 25 03:46:59 2020 +0200 Remove some XEmacs compat code from prolog.el * lisp/progmodes/prolog.el (prolog-replace-in-string): Remove XEmacs compat code and make obsolete. (prolog-guess-fill-prefix): Adjust callers. (prolog-uncomment-region): Make obsolete. (prolog-mode-syntax-table): syntax-propertize-rules is always defined. (prolog-syntax-propertize-function): Ditto. (prolog-face-name-p): Make into obsolete alias. (prolog-font-lock-keywords): Adjust callers. diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index fa281ddf4e..43c5b8575d 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -776,12 +776,6 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (modify-syntax-entry ?> "." table) (modify-syntax-entry ?| "." table) (modify-syntax-entry ?\' "\"" table) - - ;; Any better way to handle the 0' construct?!? - (when (and prolog-char-quote-workaround - (not (fboundp 'syntax-propertize-rules))) - (modify-syntax-entry ?0 "\\" table)) - (modify-syntax-entry ?% "<" table) (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?* ". 23b" table) @@ -1047,21 +1041,19 @@ VERSION is of the format (Major . Minor)" alist))) (defconst prolog-syntax-propertize-function - (when (fboundp 'syntax-propertize-rules) - (syntax-propertize-rules - ;; GNU Prolog only accepts 0'\' rather than 0'', but the only - ;; possible meaning of 0'' is rather clear. - ("\\<0\\(''?\\)" - (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) - (string-to-syntax "_")))) - ;; We could check that we're not inside an atom, but I don't think - ;; that 'foo 8'z could be a valid syntax anyway, so why bother? - ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_")) - ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal - ;; escape sequences in atoms, so be careful not to let the terminating \ - ;; escape a subsequent quote. - ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_")) - ))) + (syntax-propertize-rules + ;; GNU Prolog only accepts 0'\' rather than 0'', but the only + ;; possible meaning of 0'' is rather clear. + ("\\<0\\(''?\\)" + (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "_")))) + ;; We could check that we're not inside an atom, but I don't think + ;; that 'foo 8'z could be a valid syntax anyway, so why bother? + ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_")) + ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal + ;; escape sequences in atoms, so be careful not to let the terminating \ + ;; escape a subsequent quote. + ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_")))) (defun prolog-mode-variables () "Set some common variables to Prolog code specific values." @@ -1886,14 +1878,7 @@ Argument BOUND is a buffer position limiting searching." bound t))) point)) -(defsubst prolog-face-name-p (facename) - ;; Return t if FACENAME is the name of a face. This method is - ;; necessary since facep in XEmacs only returns t for the actual - ;; face objects (while it's only their names that are used just - ;; about anywhere else) without providing a predicate that tests - ;; face names. This function (including the above commentary) is - ;; borrowed from cc-mode. - (memq facename (face-list))) +(define-obsolete-function-alias 'prolog-face-name-p 'facep "28.1") ;; Set everything up (defun prolog-font-lock-keywords () @@ -1938,12 +1923,12 @@ Argument BOUND is a buffer position limiting searching." "Face name to use for compiler warnings." :group 'prolog-faces) (defvar prolog-warning-face - (if (prolog-face-name-p 'font-lock-warning-face) + (if (facep 'font-lock-warning-face) 'font-lock-warning-face 'prolog-warning-face) "Face name to use for built in predicates.") (defvar prolog-builtin-face - (if (prolog-face-name-p 'font-lock-builtin-face) + (if (facep 'font-lock-builtin-face) 'font-lock-builtin-face 'prolog-builtin-face) "Face name to use for built in predicates.") @@ -2291,12 +2276,12 @@ between them)." (progn (goto-char cbeg) (search-forward-regexp "%+[ \t]*" end t) - (prolog-replace-in-string (buffer-substring beg (point)) - "[^ \t%]" " ")) + (replace-regexp-in-string "[^ \t%]" " " + (buffer-substring beg (point)))) ;(goto-char beg) (if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*" end t) - (prolog-replace-in-string (buffer-substring beg (point)) "/" " ") + (replace-regexp-in-string "/" " " (buffer-substring beg (point))) (beginning-of-line) (when (search-forward-regexp "^[ \t]+" end t) (buffer-substring beg (point))))))))) @@ -2336,11 +2321,10 @@ In effect it sets the `fill-prefix' when inside comments and then calls (do-auto-fill) )) -(defalias 'prolog-replace-in-string - (if (fboundp 'replace-in-string) - #'replace-in-string - (lambda (str regexp newtext &optional literal) - (replace-regexp-in-string regexp newtext str nil literal)))) +(defun prolog-replace-in-string (str regexp newtext &optional literal) + (declare (obsolete replace-regexp-in-string "28.1")) + (replace-regexp-in-string regexp newtext str nil literal)) + ;;------------------------------------------------------------------- ;; Online help @@ -3083,12 +3067,8 @@ The module name should be written manually just before the semi-colon." (insert "%%% -*- Module: ; -*-\n") (backward-char 6)) -(defalias 'prolog-uncomment-region - (if (fboundp 'uncomment-region) #'uncomment-region - (lambda (beg end) - "Uncomment the region between BEG and END." - (interactive "r") - (comment-region beg end -1)))) +(define-obsolete-function-alias 'prolog-uncomment-region + 'uncomment-region "28.1") (defun prolog-indent-predicate () "Indent the current predicate." @@ -3374,7 +3354,7 @@ PREFIX is the prefix of the search regexp." "Commands for Prolog code manipulation." '("Prolog" ["Comment region" comment-region (use-region-p)] - ["Uncomment region" prolog-uncomment-region (use-region-p)] + ["Uncomment region" uncomment-region (use-region-p)] ["Add comment/move to comment" indent-for-comment t] ["Convert variables in region to '_'" prolog-variables-to-anonymous :active (use-region-p) :included (not (eq prolog-system 'mercury))] commit d27b137289567c9b91f93dff8cdbb5748529cdfa Author: Lars Ingebrigtsen Date: Fri Sep 25 02:27:01 2020 +0200 Clean up replace-in-string slightly * lisp/subr.el (replace-in-string): Clean up previous fix slightly. diff --git a/lisp/subr.el b/lisp/subr.el index 0de9ac5d96..33ed0bc936 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4440,8 +4440,9 @@ Unless optional argument INPLACE is non-nil, return a new string." (push (substring instring start pos) result)) (push tostring result) (setq start (+ pos (length fromstring)))) + ;; Get any remaining bit. (unless (= start (length instring)) - (push (substring instring start pos) result)) + (push (substring instring start) result)) (apply #'concat (nreverse result)))) (defun replace-regexp-in-string (regexp rep string &optional commit 09adf92644112dbd09865b9de703868ea50c2d4f Author: Lars Ingebrigtsen Date: Fri Sep 25 02:07:05 2020 +0200 Fix previous replace-in-string rewrite * lisp/subr.el (replace-in-string): Fix logic errors in previous patch. diff --git a/lisp/subr.el b/lisp/subr.el index 0f72b382fe..0de9ac5d96 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4439,8 +4439,8 @@ Unless optional argument INPLACE is non-nil, return a new string." (unless (= start pos) (push (substring instring start pos) result)) (push tostring result) - (setq start (+ start (length fromstring)))) - (unless (= start pos) + (setq start (+ pos (length fromstring)))) + (unless (= start (length instring)) (push (substring instring start pos) result)) (apply #'concat (nreverse result)))) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 14870d4ada..fa728e430f 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -462,9 +462,9 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." "foozotbar")) (should (equal (replace-in-string "\377" "x" "a\377b") - "axxb")) + "axb")) (should (equal (replace-in-string "\377" "x" "a\377ø") - "axxø"))) + "axø"))) (provide 'subr-tests) ;;; subr-tests.el ends here commit 7f9ad5980ce2e998ef57a95c2283d1a87d5613d1 Author: Lars Ingebrigtsen Date: Fri Sep 25 01:53:07 2020 +0200 Fix replace-in-string multibyteness problems with string-search * lisp/subr.el (replace-in-string): Simplify by using the new string-search function (bug#43598). diff --git a/lisp/subr.el b/lisp/subr.el index 377d914718..0f72b382fe 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4430,37 +4430,18 @@ Unless optional argument INPLACE is non-nil, return a new string." newstr)) (defun replace-in-string (fromstring tostring instring) - "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs. -This function returns a freshly created string." - (declare (side-effect-free t)) - (let ((i 0) - (start 0) - (result nil)) - (while (< i (length instring)) - (if (eq (aref instring i) - (aref fromstring 0)) - ;; See if we're in a match. - (let ((ii i) - (if 0)) - (while (and (< ii (length instring)) - (< if (length fromstring)) - (eq (aref instring ii) - (aref fromstring if))) - (setq ii (1+ ii) - if (1+ if))) - (if (not (= if (length fromstring))) - ;; We didn't have a match after all. - (setq i (1+ i)) - ;; We had one, so gather the previous part and the - ;; substitution. - (when (not (= start i)) - (push (substring instring start i) result)) - (push tostring result) - (setq i ii - start ii))) - (setq i (1+ i)))) - (when (not (= start i)) - (push (substring instring start i) result)) + "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs." + (declare (pure t)) + (let ((start 0) + (result nil) + pos) + (while (setq pos (string-search fromstring instring start)) + (unless (= start pos) + (push (substring instring start pos) result)) + (push tostring result) + (setq start (+ start (length fromstring)))) + (unless (= start pos) + (push (substring instring start pos) result)) (apply #'concat (nreverse result)))) (defun replace-regexp-in-string (regexp rep string &optional diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 2adb4a62e8..14870d4ada 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -456,7 +456,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (should (equal (replace-in-string "azot" "bar" "zat") "zat")) (should (equal (replace-in-string "azot" "bar" "azot") - "bar"))) + "bar")) + + (should (equal (replace-in-string "azot" "bar" "foozotbar") + "foozotbar")) + + (should (equal (replace-in-string "\377" "x" "a\377b") + "axxb")) + (should (equal (replace-in-string "\377" "x" "a\377ø") + "axxø"))) (provide 'subr-tests) ;;; subr-tests.el ends here commit e51a98b0c2d35648c2d054486f7ba5869e24e4cf Author: Lars Ingebrigtsen Date: Fri Sep 25 01:52:10 2020 +0200 Add a new function 'string-search' * doc/lispref/strings.texi (Text Comparison): Document it. * src/fns.c (Fstring_search): New function. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 8de6255478..6eb3d6f310 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -656,6 +656,14 @@ optional argument @var{ignore-case} is non-@code{nil}, the comparison ignores case differences. @end defun +@defun string-search needle haystack &optional start-pos +Return the position of the first instance of @var{needle} in +@var{haystack}, both of which are strings. If @var{start-pos} is +non-@code{nil}, start searching from that position in @var{needle}. +This function only considers the characters in the strings when doing +the comparison; text properties are ignored. +@end defun + @defun compare-strings string1 start1 end1 string2 start2 end2 &optional ignore-case This function compares a specified part of @var{string1} with a specified part of @var{string2}. The specified part of @var{string1} diff --git a/etc/NEWS b/etc/NEWS index 13a022d142..6bedd0347e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1415,6 +1415,11 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. * Lisp Changes in Emacs 28.1 ++++ +*** New function 'string-search'. +This function takes two string parameters and returns the position of +the first instance of the first string in the latter. + +++ *** New function 'process-lines-ignore-status'. This is like 'process-lines', but does not signal an error if the diff --git a/src/fns.c b/src/fns.c index a3b8d6ef57..3927e4306e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5454,6 +5454,51 @@ It should not be used for anything security-related. See return make_digest_string (digest, SHA1_DIGEST_SIZE); } +DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0, + doc: /* Search for the string NEEDLE in the string HAYSTACK. +The return value is the position of the first instance of NEEDLE in +HAYSTACK. + +The optional START-POS argument says where to start searching in +HAYSTACK. If not given, start at the beginning. */) + (register Lisp_Object needle, Lisp_Object haystack, Lisp_Object start_pos) +{ + ptrdiff_t start_byte = 0, haybytes; + char *res = NULL, *haystart; + + CHECK_STRING (needle); + CHECK_STRING (haystack); + + if (!NILP (start_pos)) + { + CHECK_FIXNUM (start_pos); + start_byte = string_char_to_byte (haystack, XFIXNUM (start_pos)); + } + + haystart = SSDATA (haystack) + start_byte; + haybytes = SBYTES (haystack) - start_byte; + + if (STRING_MULTIBYTE (haystack) == STRING_MULTIBYTE (needle)) + res = memmem (haystart, haybytes, + SSDATA (needle), SBYTES (needle)); + else if (STRING_MULTIBYTE (haystack) && !STRING_MULTIBYTE (needle)) + { + Lisp_Object multi_needle = string_to_multibyte (needle); + res = memmem (haystart, haybytes, + SSDATA (multi_needle), SBYTES (multi_needle)); + } + else if (!STRING_MULTIBYTE (haystack) && STRING_MULTIBYTE (needle)) + { + Lisp_Object uni_needle = Fstring_as_unibyte (needle); + res = memmem (haystart, haybytes, + SSDATA (uni_needle), SBYTES (uni_needle)); + } + + if (! res) + return Qnil; + + return make_int (string_byte_to_char (haystack, res - SSDATA (haystack))); +} void @@ -5494,6 +5539,7 @@ syms_of_fns (void) defsubr (&Sremhash); defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); + defsubr (&Sstring_search); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index b9a7d29895..8c2b1300dc 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -901,3 +901,26 @@ (should (equal (delete t [nil t]) [nil])) (should (equal (delete 1 v1) (vector))) (should (equal (delete 2 v1) v1)))) + +(ert-deftest string-search () + (should (equal (string-search "zot" "foobarzot") 6)) + (should (equal (string-search "foo" "foobarzot") 0)) + (should (not (string-search "fooz" "foobarzot"))) + (should (not (string-search "zot" "foobarzo"))) + + (should (equal + (string-search (make-string 2 130) + (concat "helló" (make-string 5 130 t) "bár")) + 5)) + (should (equal + (string-search (make-string 2 127) + (concat "helló" (make-string 5 127 t) "bár")) + 5)) + + (should (equal (string-search "\377" "a\377ø") 1)) + (should (equal (string-search "\377" "a\377a") 1)) + + (should (not (string-search (make-string 1 255) "a\377ø"))) + (should (not (string-search (make-string 1 255) "a\377a"))) + + (should (equal (string-search "fóo" "zotfóo") 3))) commit e7a69c9204a2b208401b9368a70acad21022c7a3 Author: Stefan Monnier Date: Thu Sep 24 18:15:39 2020 -0400 * lisp/help-fns.el (help-fns--first-release): Use etc/NEWS as well diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a9943ccd7f..24fb09137c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -622,7 +622,7 @@ FILE is the file where FUNCTION was probably defined." ;; of the *packages* in which the function is defined. (let* ((name (symbol-name symbol)) (re (concat "\\_<" (regexp-quote name) "\\_>")) - (news (directory-files data-directory t "\\`NEWS\\.[1-9]")) + (news (directory-files data-directory t "\\`NEWS\\($\\|\\.\\)")) (place nil) (first nil)) (with-temp-buffer commit 976b8464fb3d33a83432053d7f907cb763580cea Author: Glenn Morris Date: Thu Sep 24 11:56:09 2020 -0700 Update a failing lisp test * test/lisp/emacs-lisp/lisp-tests.el (up-list-no-cross-string): Update for recent "Don't signal scan-error" change. diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 1476574552..437b907ba1 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -295,7 +295,7 @@ (lambda () (up-list 1 t t)) (or "(1 '2 ( 2' 1 '2 ) 2' 1)") ;; abcdefghijklmnopqrstuvwxy - i k x scan-error) + i k x user-error) (define-lisp-up-list-test backward-up-list-basic (lambda () (backward-up-list)) commit 1e7f6365766db188e8cbcee5a9cdad8e2b4f5849 Author: Juri Linkov Date: Thu Sep 24 22:25:03 2020 +0300 Horizontal scrolling for mouse wheel with Shift modifier (bug#43568) * lisp/mwheel.el (mouse-wheel-scroll-amount): Change 'shift' default value from 5 to 'hscroll'. Add new option "Scroll horizontally" for 'hscroll'. (mwheel-scroll): Handle value 'hscroll' and call mwheel-scroll-left-function or mwheel-scroll-right-function. * doc/emacs/frames.texi (Mouse Commands): Update for horizontal scrolling with Shift modifier. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index b74887612b..1a44d8dc62 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -214,22 +214,24 @@ speed is linked to how fast you move the wheel. This mode also supports increasing or decreasing the height of the default face, by default bound to scrolling with the @key{Ctrl} modifier. +Emacs also supports horizontal scrolling with the @key{Shift} modifier. + @vindex mouse-wheel-tilt-scroll @vindex mouse-wheel-flip-direction -Emacs can also support horizontal scrolling if your mouse's wheel can -be tilted, or if your touchpad supports it. This feature is off by -default; the variable @code{mouse-wheel-tilt-scroll} turns it on, if -you customize it to a non-@code{nil} value. By default, tilting the -mouse wheel scrolls the window's view horizontally in the direction of -the tilt: e.g., tilting to the right scrolls the window to the right, -so that the text displayed in the window moves horizontally to the -left. If you'd like to reverse the direction of horizontal scrolling, -customize the variable @code{mouse-wheel-flip-direction} to a -non-@code{nil} value. +If your mouse's wheel can be tilted, or if your touchpad supports it, +then you can also enable horizontal scrolling by customizing the +variable @code{mouse-wheel-tilt-scroll} to a non-@code{nil} value. +By default, tilting the mouse wheel scrolls the window's view +horizontally in the direction of the tilt: e.g., tilting to the right +scrolls the window to the right, so that the text displayed in the +window moves horizontally to the left. If you'd like to reverse the +direction of horizontal scrolling, customize the variable +@code{mouse-wheel-flip-direction} to a non-@code{nil} value. When the mouse pointer is over an image in Image mode, @pxref{Image Mode}, scrolling the mouse wheel with the @key{Ctrl} modifier scales the image -under the mouse pointer. +under the mouse pointer, and scrolling the mouse wheel with the +@key{Shift} modifier scrolls the image horizontally. @node Word and Line Mouse diff --git a/etc/NEWS b/etc/NEWS index 6a7c99f48d..13a022d142 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -136,7 +136,10 @@ displays.) --- ** Mouse wheel scrolling now defaults to one line at a time. -Old default of five lines at a time is now bound to Shift modifier. + ++++ +** Mouse wheel scrolling with Shift modifier now scrolls horizontally. +This works in text buffers and over images. --- ** The default value of 'frame-title-format' and 'icon-title-format' has changed. diff --git a/etc/TODO b/etc/TODO index b445b67360..467b08e0bf 100644 --- a/etc/TODO +++ b/etc/TODO @@ -924,7 +924,7 @@ features of that interface could be implemented NS. **** Smooth scrolling -- maybe not a good idea Today, by default, scrolling with a trackpad makes the text move in -steps of one line. (Scrolling with SHIFT scrolls five lines at a time.) +steps of one line. (Scrolling with SHIFT scrolls horizontally.) The "mac" port provides smooth, pixel-based, scrolling. This is a very popular feature. However, there are drawbacks to this method: what diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 0100b8de81..c6a7391df1 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -85,7 +85,7 @@ set to the event sent when clicking on the mouse wheel button." :type 'number) (defcustom mouse-wheel-scroll-amount - '(1 ((shift) . 5) ((meta) . nil) ((control) . text-scale)) + '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale)) "Amount to scroll windows by when spinning the mouse wheel. This is an alist mapping the modifier key to the amount to scroll when the wheel is moved with the modifier key depressed. @@ -97,6 +97,9 @@ screen. It can also be a floating point number, specifying the fraction of a full screen to scroll. A near full screen is `next-screen-context-lines' less than a full screen. +If AMOUNT is the symbol 'hscroll', this means that with MODIFIER, +the mouse wheel will scroll horizontally instead of vertically. + If AMOUNT is the symbol text-scale, this means that with MODIFIER, the mouse wheel will change the face height instead of scrolling." @@ -123,6 +126,7 @@ scrolling." (const :tag "Scroll full screen" :value nil) (integer :tag "Scroll specific # of lines") (float :tag "Scroll fraction of window") + (const :tag "Scroll horizontally" :value hscroll) (const :tag "Change face size" :value text-scale))))) :set 'mouse-wheel-change-button :version "28.1") @@ -270,7 +274,11 @@ non-Windows systems." (condition-case nil (unwind-protect (let ((button (mwheel-event-button event))) - (cond ((eq button mouse-wheel-down-event) + (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event)) + (funcall (if mouse-wheel-flip-direction + mwheel-scroll-left-function + mwheel-scroll-right-function) 1)) + ((eq button mouse-wheel-down-event) (condition-case nil (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. @@ -285,7 +293,11 @@ non-Windows systems." ;; for a reason that escapes me. This problem seems ;; to only affect scroll-down. --Stef (set-window-start (selected-window) (point-min)))))) - ((eq button mouse-wheel-up-event) + ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event)) + (funcall (if mouse-wheel-flip-direction + mwheel-scroll-right-function + mwheel-scroll-left-function) 1)) + ((eq button mouse-wheel-up-event) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) commit 89dd8cd215148da4c6dffc15dc6c35df5122247b Author: Theodor Thornhill Date: Thu Sep 24 21:59:30 2020 +0300 Set mwheel default scroll value to 1 (bug#43380) * lisp/mwheel.el (mouse-wheel-scroll-amount): Change default value 5 to 1 and shift default value from 1 to 5. Default value is changed as discussed in etc/TODO. diff --git a/etc/NEWS b/etc/NEWS index 5cb31256ff..6a7c99f48d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -134,6 +134,10 @@ the mouse cursor is on the scroll bars, fringes, margins, header line, and mode line. ('mwheel-mode' is enabled by default on most graphical displays.) +--- +** Mouse wheel scrolling now defaults to one line at a time. +Old default of five lines at a time is now bound to Shift modifier. + --- ** The default value of 'frame-title-format' and 'icon-title-format' has changed. These variables are used to display the title bar of visible frames diff --git a/etc/TODO b/etc/TODO index 152a29964f..b445b67360 100644 --- a/etc/TODO +++ b/etc/TODO @@ -924,17 +924,14 @@ features of that interface could be implemented NS. **** Smooth scrolling -- maybe not a good idea Today, by default, scrolling with a trackpad makes the text move in -steps of five lines. (Scrolling with SHIFT scrolls one line at a time.) +steps of one line. (Scrolling with SHIFT scrolls five lines at a time.) The "mac" port provides smooth, pixel-based, scrolling. This is a very -popular features. However, there are drawbacks to this method: what +popular feature. However, there are drawbacks to this method: what happens if only a fraction of a line is visible at the top of a window, is the partially visible text considered part of the window or not? (Technically, what should 'window-start' return.) -An alternative would be to make one-line scrolling the default on NS -(or in Emacs in general). - Note: This feature might not be allowed to be implemented until also implemented in Emacs for a free system. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 32fde0dd05..0100b8de81 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -85,7 +85,7 @@ set to the event sent when clicking on the mouse wheel button." :type 'number) (defcustom mouse-wheel-scroll-amount - '(5 ((shift) . 1) ((meta) . nil) ((control) . text-scale)) + '(1 ((shift) . 5) ((meta) . nil) ((control) . text-scale)) "Amount to scroll windows by when spinning the mouse wheel. This is an alist mapping the modifier key to the amount to scroll when the wheel is moved with the modifier key depressed. @@ -125,7 +125,7 @@ scrolling." (float :tag "Scroll fraction of window") (const :tag "Change face size" :value text-scale))))) :set 'mouse-wheel-change-button - :version "27.1") + :version "28.1") (defcustom mouse-wheel-progressive-speed t "If non-nil, the faster the user moves the wheel, the faster the scrolling. commit 4bc4d19bd16735f9ee79b2e736eeab59d57070d7 Author: Juri Linkov Date: Thu Sep 24 21:52:22 2020 +0300 * lisp/simple.el (goto-line-read-args): More relevant default line number. diff --git a/lisp/simple.el b/lisp/simple.el index 7cb71530b3..6bc41961eb 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1259,7 +1259,11 @@ that uses or sets the mark." ;; In a narrowed buffer. (if relative " relative" " absolute")) buffer-prompt) - (list default (line-number-at-pos)) + (list default (if (or relative (= (point-min) 1)) + (line-number-at-pos) + (save-restriction + (widen) + (line-number-at-pos)))) 'goto-line-history) buffer)))) commit 9bf9f699b130e35e4ca57301db1f614682b4f762 Author: Glenn Morris Date: Thu Sep 24 11:47:11 2020 -0700 Add skip condition for some dbus tests * test/lisp/net/dbus-tests.el (dbus-test01-type-conversion) (dbus-test01-basic-types): Add skip for hydra.nixos.org failures. ; Standardize license notice diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 2f20fcc1e6..0f5582bfc9 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see . ;;; Code: @@ -63,6 +65,7 @@ (ert-deftest dbus-test01-type-conversion () "Check type conversion functions." + (skip-unless dbus--test-enabled-session-bus) (let ((ustr "0123abc_xyz\x01\xff") (mstr "Grüß Göttin")) (should @@ -93,6 +96,7 @@ (ert-deftest dbus-test01-basic-types () "Check basic D-Bus type arguments." + (skip-unless dbus--test-enabled-session-bus) ;; Unknown keyword. (should-error (dbus-check-arguments :session dbus--test-service :keyword) commit 7b3e94b6648ed00c6948c09267894b548b2868e7 Author: Lars Ingebrigtsen Date: Thu Sep 24 17:14:25 2020 +0200 Make set-process-buffer also update the process mark * src/process.c (Fset_process_buffer): Update the process mark (bug#43573). diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 4556f8aeb5..855df4b926 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1576,7 +1576,8 @@ from previous output. @defun set-process-buffer process buffer This function sets the buffer associated with @var{process} to @var{buffer}. If @var{buffer} is @code{nil}, the process becomes -associated with no buffer. +associated with no buffer; if non-@code{nil}, the process mark will be +set to point to the end of @var{buffer}. @end defun @defun get-buffer-process buffer-or-name diff --git a/etc/NEWS b/etc/NEWS index fe2f5c3782..5cb31256ff 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1277,6 +1277,10 @@ directory instead of the default directory. * Incompatible Lisp Changes in Emacs 28.1 + +** 'set-process-buffer' now updates the process mark. +The mark will be set to point to the end of the new buffer. + +++ ** Some properties from completion tables are now preserved. If 'minibuffer-allow-text-properties' is non-nil, doing completion diff --git a/src/process.c b/src/process.c index 948d133646..ee8dcbbf74 100644 --- a/src/process.c +++ b/src/process.c @@ -1205,6 +1205,16 @@ not the name of the pty that Emacs uses to talk with that terminal. */) return XPROCESS (process)->tty_name; } +static void +update_process_mark (struct Lisp_Process *p) +{ + Lisp_Object buffer = p->buffer; + if (BUFFERP (buffer)) + set_marker_both (p->mark, buffer, + BUF_ZV (XBUFFER (buffer)), + BUF_ZV_BYTE (XBUFFER (buffer))); +} + DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 2, 2, 0, doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). @@ -1221,6 +1231,7 @@ Return BUFFER. */) if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer)); setup_process_coding_systems (process); + update_process_mark (p); return buffer; } @@ -1637,15 +1648,6 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, return Fmapcar (Qcdr, Vprocess_alist); } -static void -update_process_mark (struct Lisp_Process *p) -{ - Lisp_Object buffer = p->buffer; - if (BUFFERP (buffer)) - set_marker_both (p->mark, buffer, - BUF_ZV (XBUFFER (buffer)), - BUF_ZV_BYTE (XBUFFER (buffer))); -} /* Starting asynchronous inferior processes. */ commit 8463687b5d245a667ba2ad5803a1c900476aec39 Author: Lars Ingebrigtsen Date: Thu Sep 24 17:08:30 2020 +0200 Refactor process mark setting * src/process.c (update_process_mark): Make into its own function. (Fmake_process, Fmake_pipe_process, Fmake_serial_process) (connect_network_socket): Use it. diff --git a/src/process.c b/src/process.c index 53f4a1d853..948d133646 100644 --- a/src/process.c +++ b/src/process.c @@ -1637,6 +1637,16 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, return Fmapcar (Qcdr, Vprocess_alist); } +static void +update_process_mark (struct Lisp_Process *p) +{ + Lisp_Object buffer = p->buffer; + if (BUFFERP (buffer)) + set_marker_both (p->mark, buffer, + BUF_ZV (XBUFFER (buffer)), + BUF_ZV_BYTE (XBUFFER (buffer))); +} + /* Starting asynchronous inferior processes. */ DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0, @@ -1805,10 +1815,7 @@ usage: (make-process &rest ARGS) */) : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); /* Make the process marker point into the process buffer (if any). */ - if (BUFFERP (buffer)) - set_marker_both (XPROCESS (proc)->mark, buffer, - BUF_ZV (XBUFFER (buffer)), - BUF_ZV_BYTE (XBUFFER (buffer))); + update_process_mark (XPROCESS (proc)); USE_SAFE_ALLOCA; @@ -2453,10 +2460,7 @@ usage: (make-pipe-process &rest ARGS) */) : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); /* Make the process marker point into the process buffer (if any). */ - if (BUFFERP (buffer)) - set_marker_both (p->mark, buffer, - BUF_ZV (XBUFFER (buffer)), - BUF_ZV_BYTE (XBUFFER (buffer))); + update_process_mark (p); { /* Setup coding systems for communicating with the network stream. */ @@ -3182,12 +3186,7 @@ usage: (make-serial-process &rest ARGS) */) if (!EQ (p->command, Qt)) add_process_read_fd (fd); - if (BUFFERP (buffer)) - { - set_marker_both (p->mark, buffer, - BUF_ZV (XBUFFER (buffer)), - BUF_ZV_BYTE (XBUFFER (buffer))); - } + update_process_mark (p); tem = Fplist_get (contact, QCcoding); @@ -3664,10 +3663,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, pset_status (p, Qlisten); /* Make the process marker point into the process buffer (if any). */ - if (BUFFERP (p->buffer)) - set_marker_both (p->mark, p->buffer, - BUF_ZV (XBUFFER (p->buffer)), - BUF_ZV_BYTE (XBUFFER (p->buffer))); + update_process_mark (p); if (p->is_non_blocking_client) { commit 5df652d6144c82e1a0321d0feaf93e20467f635b Author: dickmao Date: Thu Sep 24 16:48:11 2020 +0200 Add sanity check for Gnus groups that belong to no topic * lisp/gnus/gnus-topic.el (gnus-topic-change-level): Do not change gnus-topic-alist when group is outside "topology" (bug#43582). diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index ffd26bb30f..c913002f70 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -897,9 +897,7 @@ articles in the topic and its subtopics." (let ((inhibit-read-only t)) (unless gnus-topic-inhibit-change-level (gnus-group-goto-group (or (car (nth 1 previous)) group)) - (when (and gnus-topic-mode - gnus-topic-alist - (not gnus-topic-inhibit-change-level)) + (when (and gnus-topic-mode gnus-topic-alist (gnus-current-topic)) ;; Remove the group from the topics. (if (and (< oldlevel gnus-level-zombie) (>= level gnus-level-zombie)) commit 897ea41d394cffe75ece0450d1628d6c4855d37a Author: Eli Zaretskii Date: Thu Sep 24 17:13:43 2020 +0300 Fix last change in resize_mini_window * src/xdisp.c (resize_mini_window): Prevent recentering the mini-window once its start position is computed. (Bug#43572) diff --git a/src/xdisp.c b/src/xdisp.c index 8fadff972f..3d40878be6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -11820,6 +11820,9 @@ resize_mini_window (struct window *w, bool exact_p) such as user prompt, will be hidden from view. */ move_it_by_lines (&it, 0); start = it.current.pos; + /* Prevent redisplay_window from recentering, and thus from + overriding the window-start point we computed here. */ + w->start_at_line_beg = false; } else SET_TEXT_POS (start, BEGV, BEGV_BYTE); commit 7e7a010d85f2eb037c4c8109f5bc0fdf7a4dcaac Author: Lars Ingebrigtsen Date: Thu Sep 24 15:50:25 2020 +0200 Fix recent simple.el compilation warning * lisp/simple.el (goto-line-relative): Suppress byte compilation warning about goto-line. diff --git a/lisp/simple.el b/lisp/simple.el index 825fec380c..7cb71530b3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1319,7 +1319,8 @@ The line number is relative to the accessible portion of the narrowed buffer. The argument BUFFER is the same as in the function `goto-line'." (declare (interactive-only forward-line)) (interactive (goto-line-read-args t)) - (goto-line line buffer t)) + (with-suppressed-warnings ((interactive-only goto-line)) + (goto-line line buffer t))) (defun count-words-region (start end &optional arg) "Count the number of words in the region.