commit c0e9785c7c788a591cbc67ba875c5bc2bd76f4df (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Dec 21 15:02:37 2021 +0800 ; * src/xterm.c (handle_one_xevent): Fix typo in last change. diff --git a/src/xterm.c b/src/xterm.c index 57c5616f95..8618a98679 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10899,7 +10899,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (f && FRAME_X_OUTPUT (f)->toolbar_widget) { test_rect.x = xev->event_x; - test_rect.y = xev->event_x; + test_rect.y = xev->event_y; test_rect.width = 1; test_rect.height = 1; commit e70373538328dd071a73532878492ecb2fd1ee88 Author: Po Lu Date: Tue Dec 21 14:58:44 2021 +0800 Ignore XI_TouchBegin events on the GTK tool bar * src/xterm.c (handle_one_xevent): Ignore TouchBegin events that target the tool bar. diff --git a/src/xterm.c b/src/xterm.c index 1dc68220f0..57c5616f95 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10878,7 +10878,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_TouchBegin: { struct xi_device_t *device; - bool menu_bar_p = false; + bool menu_bar_p = false, tool_bar_p = false; +#ifdef HAVE_GTK3 + GdkRectangle test_rect; +#endif device = xi_device_from_id (dpyinfo, xev->deviceid); x_display_set_last_user_time (dpyinfo, xev->time); @@ -10893,9 +10896,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_GTK3 menu_bar_p = (f && FRAME_X_OUTPUT (f)->menubar_widget && xg_event_is_for_menubar (f, event)); + if (f && FRAME_X_OUTPUT (f)->toolbar_widget) + { + test_rect.x = xev->event_x; + test_rect.y = xev->event_x; + test_rect.width = 1; + test_rect.height = 1; + + tool_bar_p = gtk_widget_intersect (FRAME_X_OUTPUT (f)->toolbar_widget, + &test_rect, NULL); + } #endif - if (!menu_bar_p) + if (!menu_bar_p && !tool_bar_p) { if (f && device->direct_p) { commit 6d4c367f3f1f75372022afcef0ce6e200907ba3d Author: Andrew G Cohen Date: Tue Dec 21 13:47:44 2021 +0800 Fix gnus subject matching when subject is empty * lisp/gnus/gnus-sum.el (gnus-summary-limit-include-thread): Don't try to limit to a matching subject when the simplified subject is empty. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 1bd0e8847e..adcc0dbd7b 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -8658,20 +8658,20 @@ these articles." (gnus-fetch-old-headers nil) (gnus-build-sparse-threads nil)) (prog1 - (gnus-summary-limit (if thread-only articles - (nconc articles gnus-newsgroup-limit))) - (gnus-summary-limit-include-matching-articles - "subject" - (regexp-quote (gnus-general-simplify-subject - (mail-header-subject (gnus-id-to-header id))))) - ;; the previous two calls each push a limit onto the limit - ;; stack. the first pop remove the articles that match the - ;; subject, while the second pop gets us back to the state - ;; before we started to deal with the thread. presumably we want - ;; to think of the thread and its associated subject matches as - ;; a single thing so that we need to pop only once to get back - ;; to the original view. - (pop gnus-newsgroup-limits) + (gnus-summary-limit (if thread-only articles + (nconc articles gnus-newsgroup-limit))) + (let ((matching-subject (gnus-general-simplify-subject + (mail-header-subject (gnus-id-to-header id))))) + (when matching-subject + (gnus-summary-limit-include-matching-articles + "subject" + matching-subject) + ;; Each of the previous two limit calls push a limit onto + ;; the limit stack. Presumably we want to think of the + ;; thread and its associated subject matches as a single + ;; thing so we probably want a single pop to restore the + ;; original view. Hence we pop this last limit off. + (pop gnus-newsgroup-limits))) (gnus-summary-position-point)))) (defun gnus-summary-limit-include-matching-articles (header regexp) commit cf2597da0ddf81c3b7a3894449d7e416c1be8200 Author: Lars Ingebrigtsen Date: Tue Dec 21 05:25:50 2021 +0100 Revert "Speed up find_field when called from outside a field" This reverts commit 4d8af56c76ee20bc8e1ebdeef5c4100cea005974. This leads to lisp-mode-tests failures diff --git a/src/editfns.c b/src/editfns.c index 355a7a3e29..5c9c34dc35 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -437,27 +437,6 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, after_field = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); - - /* We're not in a field, so find the prev/next area with a field - property. */ - if (NILP (after_field)) - { - if (beg) - { - Lisp_Object p = Fprevious_single_char_property_change (pos, Qfield, - Qnil, - beg_limit); - *beg = NILP (p) ? BEGV : XFIXNAT (p); - } - if (end) - { - Lisp_Object p = Fnext_single_char_property_change (pos, Qfield, Qnil, - end_limit); - *end = NILP (p) ? ZV : XFIXNAT (p); - } - return; - } - before_field = (XFIXNAT (pos) > BEGV ? get_char_property_and_overlay (make_fixnum (XFIXNUM (pos) - 1), commit 18ce031f9b21942586255fca86a5acf364742600 Author: Lars Ingebrigtsen Date: Mon Dec 20 13:37:15 2021 +0100 Remove the `mode-line-percent-position' min width hack * lisp/bindings.el (mode-line-position): Remove hack to get min-width to work on the `mode-line-percent-position' bit. * src/xdisp.c (display_string): Respect min-width in the non-Lisp string case (bug#52332). diff --git a/lisp/bindings.el b/lisp/bindings.el index ba3bf81b3e..98a12a252a 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -501,7 +501,7 @@ mouse-1: Display Line and Column Mode Menu")) (defvar mode-line-position `((:propertize - (" " mode-line-percent-position) + ("" mode-line-percent-position) local-map ,mode-line-column-line-number-mode-map display (min-width (5.0)) mouse-face mode-line-highlight diff --git a/src/xdisp.c b/src/xdisp.c index 0c35d24c26..35675a6a36 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -27640,6 +27640,21 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st 0, &endptr, it->base_face_id, false, 0); face = FACE_FROM_ID (it->f, it->face_id); it->face_box_p = face->box != FACE_NO_BOX; + + /* If we have a display spec, but there's no Lisp being + displayed, then check whether we've got one from the + :propertize being passed in and use that. */ + if (NILP (lisp_string)) + { + Lisp_Object display = Fget_text_property (make_fixnum (0), Qdisplay, + face_string); + if (!NILP (display)) + { + Lisp_Object min_width = Fplist_get (display, Qmin_width); + if (!NILP (min_width)) + display_min_width (it, 0, face_string, min_width); + } + } } /* Set max_x to the maximum allowed X position. Don't let it go commit c9636727363a0f0ecd8b2dd2cc6eebf9470e71f2 Author: Lars Ingebrigtsen Date: Mon Dec 20 10:45:51 2021 +0100 Allow @ characters in heredoc in shell-script-mode * lisp/progmodes/sh-script.el (defconst): Also allow @ in heredoc (bug#52496). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 92326d0dcf..0ff6aec8d9 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -864,7 +864,7 @@ See `sh-feature'.") "\\(?:\\(?:.*[^\\\n]\\)?\\(?:\\\\\\\\\\)*\\\\\n\\)*.*") (defconst sh-here-doc-open-re - (concat "[^<]<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._]\\)+\\)" + (concat "[^<]<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._@]\\)+\\)" sh-escaped-line-re "\\(\n\\)"))) (defun sh--inside-noncommand-expression (pos) commit 6def36f2160b0333343b0fb316b36c159e1e9c72 Author: Lars Ingebrigtsen Date: Mon Dec 20 10:29:50 2021 +0100 Use the new `permission-denied' error to catch multisession errors * lisp/emacs-lisp/multisession.el (multisession--read-file-value): Use the new `permission-denied' error to catch file errors on Windows. diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index 6ef0da10f7..4bd7886d35 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -269,7 +269,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to ;; Windows uses OS-level file locking that may preclude ;; reading the file in some circumstances. So when that ;; happens, wait a bit and try again. - (file-error + (permission-denied (setq i (1+ i) last-error err) (sleep-for (+ 0.1 (/ (float (random 10)) 10)))))) commit 4d8af56c76ee20bc8e1ebdeef5c4100cea005974 Author: Lars Ingebrigtsen Date: Mon Dec 20 10:26:25 2021 +0100 Speed up find_field when called from outside a field * src/editfns.c (find_field): Speed up the field functions when called from outside a field (bug#52593). (In some cursory tests, this makes the called-from-outside-a-field case about 3x faster.) diff --git a/src/editfns.c b/src/editfns.c index 5c9c34dc35..355a7a3e29 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -437,6 +437,27 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, after_field = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); + + /* We're not in a field, so find the prev/next area with a field + property. */ + if (NILP (after_field)) + { + if (beg) + { + Lisp_Object p = Fprevious_single_char_property_change (pos, Qfield, + Qnil, + beg_limit); + *beg = NILP (p) ? BEGV : XFIXNAT (p); + } + if (end) + { + Lisp_Object p = Fnext_single_char_property_change (pos, Qfield, Qnil, + end_limit); + *end = NILP (p) ? ZV : XFIXNAT (p); + } + return; + } + before_field = (XFIXNAT (pos) > BEGV ? get_char_property_and_overlay (make_fixnum (XFIXNUM (pos) - 1), commit 0c4fc7032ab32fb639c188d9647eb132d55adfa5 Author: Stefan Monnier Date: Mon Dec 20 11:04:37 2021 -0500 Fix bug#28557 * test/lisp/emacs-lisp/cconv-tests.el: Remove `:expected-result :failed` from the bug#28557 tests. (cconv-tests-cl-function-:documentation): Account for the presence of the arglist (aka "usage") in the docstring. * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Handle non-constant `:documentation`. * lisp/emacs-lisp/generator.el (iter-lambda): * lisp/emacs-lisp/cconv.el (cconv--convert-funcbody): Use `macroexp-parse-body`. diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 7cec91bfa8..d8f463e9d6 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -293,15 +293,10 @@ of converted forms." (cconv-convert form env nil)) funcbody)) (if wrappers - (let ((special-forms '())) - ;; Keep special forms at the beginning of the body. - (while (or (and (cdr funcbody) (stringp (car funcbody))) ;docstring. - (memq (car-safe (car funcbody)) - '(interactive declare :documentation))) - (push (pop funcbody) special-forms)) - (let ((body (macroexp-progn funcbody))) + (pcase-let ((`(,decls . ,body) (macroexp-parse-body funcbody))) + (let ((body (macroexp-progn body))) (dolist (wrapper wrappers) (setq body (funcall wrapper body))) - `(,@(nreverse special-forms) ,@(macroexp-unprogn body)))) + `(,@decls ,@(macroexp-unprogn body)))) funcbody))) (defun cconv--lifted-arg (var env) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 9de47e4987..d162dfbbeb 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -286,7 +286,9 @@ DEFAULT-BODY, if present, is used as the body of a default method. (progn (defalias ',name (cl-generic-define ',name ',args ',(nreverse options)) - ,(help-add-fundoc-usage doc args)) + ,(if (consp doc) ;An expression rather than a constant. + `(help-add-fundoc-usage ,doc ',args) + (help-add-fundoc-usage doc args))) :autoload-end ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) (nreverse methods))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 87f7e07851..a8f046b148 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -301,24 +301,31 @@ FORM is of the form (ARGS . BODY)." (t ;; `simple-args' doesn't handle all the parsing that we need, ;; so we pass the rest to cl--do-arglist which will do ;; "manual" parsing. - (let ((slen (length simple-args))) - (when (memq '&optional simple-args) - (cl-decf slen)) - (setq header + (let ((slen (length simple-args)) + (usage-str ;; Macro expansion can take place in the middle of ;; apparently harmless computation, so it should not ;; touch the match-data. (save-match-data - (cons (help-add-fundoc-usage - (if (stringp (car header)) (pop header)) - ;; Be careful with make-symbol and (back)quote, - ;; see bug#12884. - (help--docstring-quote - (let ((print-gensym nil) (print-quoted t) - (print-escape-newlines t)) - (format "%S" (cons 'fn (cl--make-usage-args - orig-args)))))) - header))) + (help--docstring-quote + (let ((print-gensym nil) (print-quoted t) + (print-escape-newlines t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args)))))))) + (when (memq '&optional simple-args) + (cl-decf slen)) + (setq header + (cons + (if (eq :documentation (car-safe (car header))) + `(:documentation (help-add-fundoc-usage + ,(cadr (pop header)) + ,usage-str)) + (help-add-fundoc-usage + (if (stringp (car header)) (pop header)) + ;; Be careful with make-symbol and (back)quote, + ;; see bug#12884. + usage-str)) + header)) ;; FIXME: we'd want to choose an arg name for the &rest param ;; and pass that as `expr' to cl--do-arglist, but that ends up ;; generating code with a redundant let-binding, so we instead diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index ac1412704b..86119d3e3e 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -690,8 +690,10 @@ of values. Callers can retrieve each value using `iter-next'." (declare (indent defun) (debug (&define lambda-list lambda-doc &rest sexp))) (cl-assert lexical-binding) - `(lambda ,arglist - ,(cps-generate-evaluator body))) + (pcase-let* ((`(,declarations . ,exps) (macroexp-parse-body body))) + `(lambda ,arglist + ,@declarations + ,(cps-generate-evaluator exps)))) (defmacro iter-make (&rest body) "Return a new iterator." diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 8fc2986ab4..27c289e385 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -480,6 +480,8 @@ is defined as a macro, alias, command, ..." (get symbol 'advice--pending)) (t (symbol-function symbol))) function props) + ;; FIXME: We could use a defmethod on `function-docstring' instead, + ;; except when (or (not nf) (autoloadp nf))! (put symbol 'function-documentation `(advice--make-docstring ',symbol)) (add-function :around (get symbol 'defalias-fset-function) #'advice--defalias-fset)) diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el index 94bc759fa0..479afe12c0 100644 --- a/test/lisp/emacs-lisp/cconv-tests.el +++ b/test/lisp/emacs-lisp/cconv-tests.el @@ -23,6 +23,7 @@ (require 'ert) (require 'cl-lib) +(require 'generator) (ert-deftest cconv-tests-lambda-:documentation () "Docstring for lambda can be specified with :documentation." @@ -83,9 +84,6 @@ (iter-yield 'cl-iter-defun-result)) (ert-deftest cconv-tests-cl-iter-defun-:documentation () "Docstring for cl-iter-defun can be specified with :documentation." - ;; FIXME: See Bug#28557. - :tags '(:unstable) - :expected-result :failed (should (string= (documentation 'cconv-tests-cl-iter-defun) "cl-iter-defun documentation")) (should (eq (iter-next (cconv-tests-cl-iter-defun)) @@ -96,36 +94,27 @@ (iter-yield 'iter-defun-result)) (ert-deftest cconv-tests-iter-defun-:documentation () "Docstring for iter-defun can be specified with :documentation." - ;; FIXME: See Bug#28557. - :tags '(:unstable) - :expected-result :failed (should (string= (documentation 'cconv-tests-iter-defun) "iter-defun documentation")) (should (eq (iter-next (cconv-tests-iter-defun)) 'iter-defun-result))) (ert-deftest cconv-tests-iter-lambda-:documentation () "Docstring for iter-lambda can be specified with :documentation." - ;; FIXME: See Bug#28557. - :expected-result :failed - (with-no-warnings ; disable warnings for now as test is expected to fail - (let ((iter-fun - (iter-lambda () - (:documentation (concat "iter-lambda" " documentation")) - (iter-yield 'iter-lambda-result)))) - (should (string= (documentation iter-fun) "iter-lambda documentation")) - (should (eq (iter-next (funcall iter-fun)) 'iter-lambda-result))))) + (let ((iter-fun + (iter-lambda () + (:documentation (concat "iter-lambda" " documentation")) + (iter-yield 'iter-lambda-result)))) + (should (string= (documentation iter-fun) "iter-lambda documentation")) + (should (eq (iter-next (funcall iter-fun)) 'iter-lambda-result)))) (ert-deftest cconv-tests-cl-function-:documentation () "Docstring for cl-function can be specified with :documentation." - ;; FIXME: See Bug#28557. - :expected-result :failed - (with-no-warnings ; disable warnings for now as test is expected to fail - (let ((fun (cl-function (lambda (&key arg) - (:documentation (concat "cl-function" - " documentation")) - (list arg 'cl-function-result))))) - (should (string= (documentation fun) "cl-function documentation")) - (should (equal (funcall fun :arg t) '(t cl-function-result)))))) + (let ((fun (cl-function (lambda (&key arg) + (:documentation (concat "cl-function" + " documentation")) + (list arg 'cl-function-result))))) + (should (string-match "\\`cl-function documentation$" (documentation fun))) + (should (equal (funcall fun :arg t) '(t cl-function-result))))) (ert-deftest cconv-tests-function-:documentation () "Docstring for lambda inside function can be specified with :documentation." @@ -144,8 +133,6 @@ (+ 1 n)) (ert-deftest cconv-tests-cl-defgeneric-:documentation () "Docstring for cl-defgeneric can be specified with :documentation." - ;; FIXME: See Bug#28557. - :expected-result :failed (let ((descr (describe-function 'cconv-tests-cl-defgeneric))) (set-text-properties 0 (length descr) nil descr) (should (string-match-p "cl-defgeneric documentation" descr)) commit 43356423a285d41ce3edc00c3ed115b184e2c720 Author: Po Lu Date: Tue Dec 21 10:01:37 2021 +0800 Don't drop touch events we're not interested in on GTK3 * src/xterm.c (handle_one_xevent): Allow GTK to handle unwanted TouchBegin events. diff --git a/src/xterm.c b/src/xterm.c index cd135056a2..1dc68220f0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10891,7 +10891,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = x_any_window_to_frame (dpyinfo, xev->event); #ifdef HAVE_GTK3 - menu_bar_p = (FRAME_X_OUTPUT (f)->menubar_widget + menu_bar_p = (f && FRAME_X_OUTPUT (f)->menubar_widget && xg_event_is_for_menubar (f, event)); #endif @@ -10917,6 +10917,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } x_uncatch_errors_after_check (); } +#ifndef HAVE_GTK3 else { x_catch_errors (dpyinfo->display); @@ -10924,7 +10925,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, xev->detail, xev->event, XIRejectTouch); x_uncatch_errors (); } - +#endif } else { commit 513fe2d6ff9808d54e9a9ff6eb82ef1518d4d6ad Author: Po Lu Date: Tue Dec 21 09:58:14 2021 +0800 Fix touch event menu bar detection * src/xterm.c (handle_one_event): Don't drop menu bar touch events. diff --git a/src/xterm.c b/src/xterm.c index 1691db1965..cd135056a2 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10878,6 +10878,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_TouchBegin: { struct xi_device_t *device; + bool menu_bar_p = false; device = xi_device_from_id (dpyinfo, xev->deviceid); x_display_set_last_user_time (dpyinfo, xev->time); @@ -10889,47 +10890,54 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = x_any_window_to_frame (dpyinfo, xev->event); - if (f && device->direct_p) +#ifdef HAVE_GTK3 + menu_bar_p = (FRAME_X_OUTPUT (f)->menubar_widget + && xg_event_is_for_menubar (f, event)); +#endif + + if (!menu_bar_p) { - *finish = X_EVENT_DROP; - x_catch_errors (dpyinfo->display); - XIAllowTouchEvents (dpyinfo->display, xev->deviceid, - xev->detail, xev->event, XIAcceptTouch); - if (!x_had_errors_p (dpyinfo->display)) + if (f && device->direct_p) { - xi_link_touch_point (device, xev->detail, xev->event_x, - xev->event_y); - -#ifdef HAVE_GTK3 - if (FRAME_X_OUTPUT (f)->menubar_widget - && xg_event_is_for_menubar (f, event)) + *finish = X_EVENT_DROP; + x_catch_errors (dpyinfo->display); + XIAllowTouchEvents (dpyinfo->display, xev->deviceid, + xev->detail, xev->event, XIAcceptTouch); + if (!x_had_errors_p (dpyinfo->display)) { - bool was_waiting_for_input = waiting_for_input; - /* This hack was adopted from the NS port. Whether - or not it is actually safe is a different story - altogether. */ - if (waiting_for_input) - waiting_for_input = 0; - set_frame_menubar (f, true); - waiting_for_input = was_waiting_for_input; - } -#endif + xi_link_touch_point (device, xev->detail, xev->event_x, + xev->event_y); - inev.ie.kind = TOUCHSCREEN_BEGIN_EVENT; - inev.ie.timestamp = xev->time; - XSETFRAME (inev.ie.frame_or_window, f); - XSETINT (inev.ie.x, lrint (xev->event_x)); - XSETINT (inev.ie.y, lrint (xev->event_y)); - XSETINT (inev.ie.arg, xev->detail); + inev.ie.kind = TOUCHSCREEN_BEGIN_EVENT; + inev.ie.timestamp = xev->time; + XSETFRAME (inev.ie.frame_or_window, f); + XSETINT (inev.ie.x, lrint (xev->event_x)); + XSETINT (inev.ie.y, lrint (xev->event_y)); + XSETINT (inev.ie.arg, xev->detail); + } + x_uncatch_errors_after_check (); } - x_uncatch_errors_after_check (); + else + { + x_catch_errors (dpyinfo->display); + XIAllowTouchEvents (dpyinfo->display, xev->deviceid, + xev->detail, xev->event, XIRejectTouch); + x_uncatch_errors (); + } + } else { - x_catch_errors (dpyinfo->display); - XIAllowTouchEvents (dpyinfo->display, xev->deviceid, - xev->detail, xev->event, XIRejectTouch); - x_uncatch_errors (); +#ifdef HAVE_GTK3 + bool was_waiting_for_input = waiting_for_input; + /* This hack was adopted from the NS port. Whether + or not it is actually safe is a different story + altogether. */ + if (waiting_for_input) + waiting_for_input = 0; + set_frame_menubar (f, true); + waiting_for_input = was_waiting_for_input; +#endif } goto XI_OTHER; commit a5509a2a5e4bb356fc800c4d3a2c7e8c83710a70 Author: Po Lu Date: Tue Dec 21 09:52:05 2021 +0800 Fix xg_event_is_for_menubar for XI2 events * src/gtkutil.c (xg_event_is_for_menubar): Use correct fields for XI2 events. * src/xterm.c (handle_one_event): Drop TouchBegin events we know about. diff --git a/src/gtkutil.c b/src/gtkutil.c index 62a9c05a97..7370a795c0 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -4038,7 +4038,7 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) #ifdef HAVE_XINPUT2 XIDeviceEvent *xev = (XIDeviceEvent *) event->xcookie.data; - if (event->type == GenericEvent) /* XI_ButtonPress or XI_ButtonRelease */ + if (event->type == GenericEvent) /* XI_ButtonPress or XI_ButtonRelease or a touch event. */ { if (! (xev->event_x >= 0 && xev->event_x < FRAME_PIXEL_WIDTH (f) @@ -4075,8 +4075,21 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) list = gtk_container_get_children (GTK_CONTAINER (x->menubar_widget)); if (! list) return 0; int scale = xg_get_scale (f); - rec.x = event->xbutton.x / scale; - rec.y = event->xbutton.y / scale; +#ifdef HAVE_XINPUT2 + if (event->type == GenericEvent) + { + rec.x = xev->event_x / scale; + rec.y = xev->event_y / scale; + } + else + { +#else + rec.x = event->xbutton.x / scale; + rec.y = event->xbutton.y / scale; +#endif +#ifdef HAVE_XINPUT2 + } +#endif rec.width = 1; rec.height = 1; diff --git a/src/xterm.c b/src/xterm.c index 0cc093dc75..1691db1965 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10891,6 +10891,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (f && device->direct_p) { + *finish = X_EVENT_DROP; x_catch_errors (dpyinfo->display); XIAllowTouchEvents (dpyinfo->display, xev->deviceid, xev->detail, xev->event, XIAcceptTouch); commit bfcff4619982f9bf8c9b4a656aae454968b83db5 Author: Stefan Monnier Date: Mon Dec 20 20:45:39 2021 -0500 eieio-tests.el: Silence last warnings * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-tests--dummy): New class. (eieio-test-22-init-forms-dont-match-runnable): Tweak to silence warning. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index c13d3ee6ef..3ed00f49d1 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -55,6 +55,9 @@ ) "Class A.") +;; Silence compiler warning about `water' not being a class-allocated slot. +(defclass eieio-tests--dummy () ((water :allocation :class))) + (defclass class-b () ((land :initform "Sc" :type string @@ -555,7 +558,7 @@ METHOD is the method that was attempting to be called." "Test class that will be a calculated value.") (defclass eitest-superior nil - ((sub :initform (eitest-subordinate) + ((sub :initform (funcall #'eitest-subordinate) :type eitest-subordinate)) "A class with an initform that creates a class.") commit 4234995d428f53ffa9dbf2d4817e2cdfe613a5f4 Author: Po Lu Date: Tue Dec 21 09:43:23 2021 +0800 * src/xterm.c (handle_one_xevent): Set user time on touch events. diff --git a/src/xterm.c b/src/xterm.c index 47539fdef5..0cc093dc75 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10879,6 +10879,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { struct xi_device_t *device; device = xi_device_from_id (dpyinfo, xev->deviceid); + x_display_set_last_user_time (dpyinfo, xev->time); if (!device) goto XI_OTHER; @@ -10939,6 +10940,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, Lisp_Object arg = Qnil; device = xi_device_from_id (dpyinfo, xev->deviceid); + x_display_set_last_user_time (dpyinfo, xev->time); if (!device) goto XI_OTHER; @@ -10979,6 +10981,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, bool unlinked_p; device = xi_device_from_id (dpyinfo, xev->deviceid); + x_display_set_last_user_time (dpyinfo, xev->time); if (!device) goto XI_OTHER; commit 2bcd299431495e2107df16febf9b207c75fb29fd Author: Po Lu Date: Tue Dec 21 09:41:40 2021 +0800 Ignore all emulated button events (i.e. those from touchscreens) * src/xterm.c (handle_one_xevent): Ignore all XIPointerEmulated events if the display supports XI 2.2 or later. diff --git a/src/xterm.c b/src/xterm.c index 7456b3b6be..47539fdef5 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10329,9 +10329,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef XIPointerEmulated /* Ignore emulated scroll events when XI2 native scroll events are present. */ - if (dpyinfo->xi2_version >= 1 - && xev->detail >= 4 - && xev->detail <= 8 + if (((dpyinfo->xi2_version == 1 + && xev->detail >= 4 + && xev->detail <= 8) + || (dpyinfo->xi2_version >= 2)) && xev->flags & XIPointerEmulated) { *finish = X_EVENT_DROP; commit aa1fdb3f6fe08169143a3062ca257be487713531 Author: Paul Eggert Date: Mon Dec 20 15:03:33 2021 -0800 Put AM_V_GEN etc. first With the recent changes to src/verbose.mk.in, it’s more important to be consistent about putting AM_V_GEN and similar macros at the start of a rule’s recipe, since ‘make’ now outputs the diagnostic before it executes the recipe rather than the shell outputting it. Most of the uses were already this way, but there were a few outliers. Problem reported by Pip Cet. * Makefile.in (${srcdir}/info/dir): * admin/unidata/Makefile.in (${unidir}/charprop.el, ${unifiles}) (${unidir}/emoji-labels.el): * lib/Makefile.in (libgnu.a, libegnu.a): * lisp/Makefile.in (TAGS): * src/Makefile.in (lisp.mk, Emacs): * test/Makefile.in (%.log, $(test_module)): Put AM_V_GEN and similar macros first. diff --git a/Makefile.in b/Makefile.in index 202665ea9d..e68658272f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1074,8 +1074,8 @@ info_dir_deps = \ ## but then we would need to depend on ${INFOS}, which would ## slow down parallelization. ${srcdir}/info/dir: ${info_dir_deps} - $(AM_V_at)${MKDIR_P} ${srcdir}/info - $(AM_V_GEN)(cd ${srcdir}/doc && \ + $(AM_V_GEN)${MKDIR_P} ${srcdir}/info + $(AM_V_at)(cd ${srcdir}/doc && \ AWK='${AWK}' ../build-aux/make-info-dir ${info_dir_inputs} \ ) >$@.tmp && mv $@.tmp $@ diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 701fb92b81..011e97b3d1 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -63,21 +63,21 @@ unidata.txt: ${srcdir}/UnicodeData.txt ## pretend that it does since other Makefiles assume that if charprop ## is up-to-date, the unifiles are too. ${unidir}/charprop.el: ${unifiles} ${srcdir}/unidata-gen.el | ${srcdir}/unidata-gen.elc - $(AM_V_at)[ ! -f $@ ] || chmod +w $@ - $(AM_V_GEN)${emacs} -L ${srcdir} -l unidata-gen \ + $(AM_V_GEN)[ ! -f $@ ] || chmod +w $@ + $(AM_V_at)${emacs} -L ${srcdir} -l unidata-gen \ -f unidata-gen-charprop $@ ${unifiles}: ${srcdir}/unidata-gen.el \ ${srcdir}/UnicodeData.txt ${srcdir}/BidiMirroring.txt \ ${srcdir}/BidiBrackets.txt | \ ${srcdir}/unidata-gen.elc unidata.txt - $(AM_V_at)[ ! -f $@ ] || chmod +w $@ + $(AM_V_GEN)[ ! -f $@ ] || chmod +w $@ $(AM_V_at)${emacs} -L ${srcdir} -l unidata-gen \ -f unidata-gen-file $@ ${srcdir} ${unidir}/emoji-labels.el: ${unidir}/../international/emoji.el \ ${srcdir}/emoji-test.txt - $(AM_V_at)${emacs} -l emoji.el -f emoji--generate-file $@ + $(AM_V_GEN)${emacs} -l emoji.el -f emoji--generate-file $@ .PHONY: charscript.el charscript.el: ${unidir}/charscript.el @@ -120,4 +120,3 @@ gen-clean: ## ref: https://lists.gnu.org/r/emacs-devel/2013-11/msg01029.html maintainer-clean: gen-clean distclean - diff --git a/lib/Makefile.in b/lib/Makefile.in index ccb90c3d1b..7fdbf19268 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -88,13 +88,13 @@ e-%.o: %.c all: libgnu.a $(if $(HYBRID_MALLOC),libegnu.a) libgnu.a: $(libgnu_a_OBJECTS) - $(AM_V_at)rm -f $@ - $(AM_V_AR)$(AR) $(ARFLAGS) $@ $(libgnu_a_OBJECTS) + $(AM_V_AR)rm -f $@ + $(AM_V_at)$(AR) $(ARFLAGS) $@ $(libgnu_a_OBJECTS) $(AM_V_at)$(RANLIB) $@ libegnu.a: $(libegnu_a_OBJECTS) - $(AM_V_at)rm -f $@ - $(AM_V_AR)$(AR) $(ARFLAGS) $@ $(libegnu_a_OBJECTS) + $(AM_V_AR)rm -f $@ + $(AM_V_at)$(AR) $(ARFLAGS) $@ $(libegnu_a_OBJECTS) $(AM_V_at)$(RANLIB) $@ ETAGS = ../lib-src/etags$(EXEEXT) diff --git a/lisp/Makefile.in b/lisp/Makefile.in index df9e5c36ee..0c0c3f12ac 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -255,9 +255,9 @@ ${ETAGS}: FORCE ## compile-main. But maybe this is not even necessary any more now ## that this uses relative filenames. TAGS: ${ETAGS} ${tagsfiles} - $(AM_V_at)rm -f $@ + $(AM_V_GEN)rm -f $@ $(AM_V_at)touch $@ - $(AM_V_GEN)ls ${tagsfiles} | xargs $(XARGS_LIMIT) "${ETAGS}" -a -o $@ + $(AM_V_at)ls ${tagsfiles} | xargs $(XARGS_LIMIT) "${ETAGS}" -a -o $@ # The src/Makefile.in has its own set of dependencies and when they decide diff --git a/src/Makefile.in b/src/Makefile.in index ee9a22469e..ea4a7207ff 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -525,11 +525,11 @@ endif ## but the second one seems like it could be more future-proof. shortlisp = lisp.mk: $(lispsource)/loadup.el - @rm -f $@ ${AM_V_GEN}( printf 'shortlisp = \\\n'; \ sed -n 's/^[ \t]*(load "\([^"]*\)".*/\1/p' $< | \ sed -e 's/$$/.elc \\/' -e 's/\.el\.elc/.el/'; \ - echo "" ) > $@ + echo "" ) > $@.tmp + $(AM_V_at)mv -f $@.tmp $@ -include lisp.mk shortlisp_filter = leim/leim-list.el site-load.elc site-init.elc @@ -617,8 +617,8 @@ endif ifeq ($(HAVE_BE_APP),yes) Emacs: emacs$(EXEEXT) - cp -f emacs$(EXEEXT) $@ - $(AM_V_GEN) $(libsrc)/be-resources \ + $(AM_V_GEN) cp -f emacs$(EXEEXT) $@ + $(AM_V_at) $(libsrc)/be-resources \ $(etc)/images/icons/hicolor/32x32/apps/emacs.png $@ Emacs.pdmp: $(pdmp) $(AM_V_GEN) cp -f $(pdmp) $@ diff --git a/test/Makefile.in b/test/Makefile.in index 0bb35581d1..378a8fde7e 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -183,8 +183,8 @@ testloadfile = $* endif %.log: %.elc - $(AM_V_at)${MKDIR_P} $(dir $@) - $(AM_V_GEN)HOME=$(TEST_HOME) $(emacs) \ + $(AM_V_GEN)${MKDIR_P} $(dir $@) + $(AM_V_at)HOME=$(TEST_HOME) $(emacs) \ -l ert ${ert_opts} -l $(testloadfile) \ $(TEST_RUN_ERT) @@ -291,8 +291,8 @@ FREE_SOURCE_1 = $(srcdir)/../lib/free.c # as source because those are not compiled with -fPIC. Therefore we # use only source files. $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h - $(AM_V_at)${MKDIR_P} $(dir $@) - $(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \ + $(AM_V_CCLD)${MKDIR_P} $(dir $@) + $(AM_V_at)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \ -o $@ $< $(LIBGMP) \ $(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \ $(FREE_SOURCE_$(REPLACE_FREE)) \ commit 5f57b41aa612e5f190f5a3c1ea013be114493a03 Author: Stefan Kangas Date: Mon Dec 20 22:27:54 2021 +0100 ; Minor license statement fixes diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index 5a73e655f3..109e45df2e 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -10,18 +10,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; 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. +;; 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. +;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index f7d38ac2de..48a572af88 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -11,18 +11,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; 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. +;; 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. +;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 6dffbf07e9..ebbc743a59 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -10,18 +10,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; 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. +;; 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. +;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index 0d9ac7c8c7..e6b0105fdc 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -8,12 +8,12 @@ ;; ;; This file is part of GNU Emacs. ;; -;; This program is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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, +;; 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. diff --git a/test/lisp/emacs-lisp/macroexp-resources/m1.el b/test/lisp/emacs-lisp/macroexp-resources/m1.el index 96b5f7091a..3c0594fb16 100644 --- a/test/lisp/emacs-lisp/macroexp-resources/m1.el +++ b/test/lisp/emacs-lisp/macroexp-resources/m1.el @@ -5,23 +5,23 @@ ;; Author: Stefan Monnier ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: -;; - ;;; Code: (defconst macroexp--m1-tests-filename (macroexp-file-name)) diff --git a/test/lisp/emacs-lisp/macroexp-resources/m2.el b/test/lisp/emacs-lisp/macroexp-resources/m2.el index 4f2b96d8ca..85eae3b9dc 100644 --- a/test/lisp/emacs-lisp/macroexp-resources/m2.el +++ b/test/lisp/emacs-lisp/macroexp-resources/m2.el @@ -5,23 +5,23 @@ ;; Author: Stefan Monnier ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: -;; - ;;; Code: (defconst macroexp--m2-tests-filename (macroexp-file-name)) diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el index 8bbd94ac66..2dee1306a2 100644 --- a/test/lisp/emacs-lisp/macroexp-resources/vk.el +++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el @@ -2,18 +2,22 @@ ;; Copyright (C) 2021 Free Software Foundation, Inc. -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 . +;; along with GNU Emacs. If not, see . + +;;; Code: (require 'macroexp) diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el index 292c11ac6c..fb2211b177 100644 --- a/test/lisp/emacs-lisp/macroexp-tests.el +++ b/test/lisp/emacs-lisp/macroexp-tests.el @@ -5,23 +5,23 @@ ;; Author: Stefan Monnier ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: -;; - ;;; Code: (require 'macroexp) commit c167009400f62149a6ab1568ababcfa6ce422467 Author: Stefan Kangas Date: Mon Dec 20 22:12:25 2021 +0100 Make some variable aliases obsolete * lisp/progmodes/make-mode.el (makefile-query-one-target-method): * lisp/skeleton.el (skeleton-transformation, skeleton-filter): * lisp/textmodes/artist.el (artist-text-renderer): * lisp/textmodes/bibtex.el (bibtex-autokey-name-case-convert): (bibtex-autokey-titleword-case-convert): * lisp/textmodes/ispell.el (ispell-format-word): * lisp/textmodes/sgml-mode.el (sgml-transformation): * lisp/vc/add-log.el (change-log-time-zone-rule): Make variable aliases obsolete. diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index df17b87c01..caf8f1ea6d 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -542,8 +542,8 @@ not be enclosed in { } or ( )." This should identify a `make' command that can handle the `-q' option." :type 'string) -(defvaralias 'makefile-query-one-target-method - 'makefile-query-one-target-method-function) +(define-obsolete-variable-alias 'makefile-query-one-target-method + 'makefile-query-one-target-method-function "29.1") (defcustom makefile-query-one-target-method-function 'makefile-query-by-make-minus-q diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 2b183996d8..36cc4239d4 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -37,7 +37,8 @@ ;; page 2: paired insertion ;; page 3: mirror-mode, an example for setting up paired insertion -(defvaralias 'skeleton-transformation 'skeleton-transformation-function) +(define-obsolete-variable-alias 'skeleton-transformation + 'skeleton-transformation-function "29.1") (defvar skeleton-transformation-function 'identity "If non-nil, function applied to literal strings before they are inserted. @@ -65,7 +66,8 @@ region.") "Hook called at end of skeleton but before going to point of interest. The variables `v1' and `v2' are still set when calling this.") -(defvaralias 'skeleton-filter 'skeleton-filter-function) +(define-obsolete-variable-alias 'skeleton-filter + 'skeleton-filter-function "29.1") ;;;###autoload (defvar skeleton-filter-function 'identity diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 25f0c35aa5..9c9ef9fb63 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -338,7 +338,8 @@ Example: (defvar artist-pointer-shape (if (eq window-system 'x) x-pointer-crosshair nil) "If in X Windows, use this pointer shape while drawing with the mouse.") -(defvaralias 'artist-text-renderer 'artist-text-renderer-function) +(define-obsolete-variable-alias 'artist-text-renderer + 'artist-text-renderer-function "29.1") (defcustom artist-text-renderer-function 'artist-figlet "Function for doing text rendering." diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 2dd4e8e7af..c721c035d7 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1211,8 +1211,8 @@ See `bibtex-generate-autokey' for details." :type '(repeat (cons (regexp :tag "Old") (string :tag "New")))) -(defvaralias 'bibtex-autokey-name-case-convert - 'bibtex-autokey-name-case-convert-function) +(define-obsolete-variable-alias 'bibtex-autokey-name-case-convert + 'bibtex-autokey-name-case-convert-function "29.1") (defcustom bibtex-autokey-name-case-convert-function #'downcase "Function called for each name to perform case conversion. @@ -1286,8 +1286,8 @@ Case is significant. See `bibtex-generate-autokey' for details." :group 'bibtex-autokey :type '(repeat regexp)) -(defvaralias 'bibtex-autokey-titleword-case-convert - 'bibtex-autokey-titleword-case-convert-function) +(define-obsolete-variable-alias 'bibtex-autokey-titleword-case-convert + 'bibtex-autokey-titleword-case-convert-function "29.1") (defcustom bibtex-autokey-titleword-case-convert-function #'downcase "Function called for each titleword to perform case conversion. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 754ecb3a1d..c4dd452c0d 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -296,7 +296,8 @@ The following values are supported: "Non-nil means suppress messages in `ispell-word'." :type 'boolean) -(defvaralias 'ispell-format-word 'ispell-format-word-function) +(define-obsolete-variable-alias 'ispell-format-word + 'ispell-format-word-function "29.1") (defcustom ispell-format-word-function (function upcase) "Formatting function for displaying word being spell checked. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index dedc388219..cae1fecebc 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -75,7 +75,8 @@ a DOCTYPE or an XML declaration." :type 'boolean :version "22.1") -(defvaralias 'sgml-transformation 'sgml-transformation-function) +(define-obsolete-variable-alias 'sgml-transformation + 'sgml-transformation-function "29.1") (defcustom sgml-transformation-function 'identity "Default value for `skeleton-transformation-function' in SGML mode." diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 1290d7e03a..6f45186837 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -590,9 +590,8 @@ Compatibility function for \\[next-error] invocations." ["Go To Source" change-log-goto-source :help "Go to source location of ChangeLog tag near point"])) -;; It used to be called change-log-time-zone-rule but really should be -;; called add-log-time-zone-rule since it's only used from add-log-* code. -(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule) +(define-obsolete-variable-alias 'change-log-time-zone-rule + 'add-log-time-zone-rule "29.1") (defvar add-log-time-zone-rule nil "Time zone rule used for calculating change log time stamps. If nil, use local time. If t, use Universal Time. commit eaa44ca40e8da9ba86e6e03b76b41fd6843661d6 Author: Paul Eggert Date: Mon Dec 20 12:14:07 2021 -0800 Prefer $(info) to @echo Have GNU Make output some diagnostics directly, instead of forking and execing a shell to do it. * GNUmakefile (help): * doc/lispref/two-volume.make (vol2.pdf, elisp2med-init) (elisp2-init): * doc/misc/Makefile.in (echo-info, echo-sources): * lib-src/Makefile.in (archlibdir, install, check): * src/verbose.mk.in (AM_V_AR, AM_V_CC, AM_V_CXX, AM_V_CCLD) (AM_V_CXXLD, AM_V_ELC, AM_V_ELN, AM_V_GEN, AM_V_GLOBALS) (AM_V_RC): * test/Makefile.in (subdirs, subdir-targets): Prefer $(info) to @echo. * GNUmakefile (MAKECMDGOALS, configure, Makefile): Prefer $(warning) to @echo >&2. * src/verbose.mk.in (AM_V_ELN): Output target, like the others. diff --git a/GNUmakefile b/GNUmakefile index 76fd77ba1b..1442cf0a4e 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -36,31 +36,31 @@ ifeq (help,$(filter help,$(MAKECMDGOALS))) help: - @echo "NOTE: This is a brief summary of some common make targets." - @echo "For more detailed information, please read the files INSTALL," - @echo "INSTALL.REPO, Makefile or visit this URL:" - @echo "https://www.gnu.org/prep/standards/html_node/Standard-Targets.html" - @echo "" - @echo "make all -- compile and build Emacs" - @echo "make install -- install Emacs" - @echo "make TAGS -- update tags tables" - @echo "make clean -- delete built files but preserve configuration" - @echo "make mostlyclean -- like 'make clean', but leave those files that" - @echo " usually do not need to be recompiled" - @echo "make distclean -- delete all build and configuration files," - @echo " leave only files included in source distribution" - @echo "make maintainer-clean -- delete almost everything that can be regenerated" - @echo "make extraclean -- like maintainer-clean, and also delete" - @echo " backup and autosave files" - @echo "make bootstrap -- delete all compiled files to force a new bootstrap" - @echo " from a clean slate, then build in the normal way" - @echo "make uninstall -- remove files installed by 'make install'" - @echo "make check -- run the Emacs test suite" - @echo "make docs -- generate Emacs documentation in info format" - @echo "make html -- generate documentation in html format" - @echo "make ps -- generate documentation in ps format" - @echo "make pdf -- generate documentation in pdf format " - @exit + $(info $ NOTE: This is a brief summary of some common make targets.) + $(info $ For more detailed information, please read the files INSTALL,) + $(info $ INSTALL.REPO, Makefile or visit this URL:) + $(info $ https://www.gnu.org/prep/standards/html_node/Standard-Targets.html) + $(info $ ) + $(info $ make all -- compile and build Emacs) + $(info $ make install -- install Emacs) + $(info $ make TAGS -- update tags tables) + $(info $ make clean -- delete built files but preserve configuration) + $(info $ make mostlyclean -- like 'make clean', but leave those files that) + $(info $ usually do not need to be recompiled) + $(info $ make distclean -- delete all build and configuration files,) + $(info $ leave only files included in source distribution) + $(info $ make maintainer-clean -- delete almost everything that can be regenerated) + $(info $ make extraclean -- like maintainer-clean, and also delete) + $(info $ backup and autosave files) + $(info $ make bootstrap -- delete all compiled files to force a new bootstrap) + $(info $ from a clean slate, then build in the normal way) + $(info $ make uninstall -- remove files installed by 'make install') + $(info $ make check -- run the Emacs test suite) + $(info $ make docs -- generate Emacs documentation in info format) + $(info $ make html -- generate documentation in html format) + $(info $ make ps -- generate documentation in ps format) + $(info $ make pdf -- generate documentation in pdf format ) + @: .PHONY: help @@ -79,7 +79,7 @@ else ifeq ($(filter-out %clean,$(or $(MAKECMDGOALS),default)),) $(MAKECMDGOALS): - @echo >&2 'No Makefile; skipping $@.' + $(warning No Makefile; skipping $@.) else @@ -97,18 +97,18 @@ default $(ORDINARY_GOALS): Makefile .NOTPARALLEL: configure: - @echo >&2 'There seems to be no "configure" file in this directory.' - @echo >&2 Running ./autogen.sh ... + $(warning There seems to be no "configure" file in this directory.) + $(warning Running ./autogen.sh ...) ./autogen.sh @echo >&2 '"configure" file built.' Makefile: configure - @echo >&2 'There seems to be no Makefile in this directory.' + $(warning There seems to be no Makefile in this directory.) ifeq ($(configure),default) - @echo >&2 'Running ./configure ...' + $(warning Running ./configure ...) ./configure else - @echo >&2 'Running ./configure '$(configure)'...' + $(warning Running ./configure $(configure)...) ./configure $(configure) endif @echo >&2 'Makefile built.' diff --git a/doc/lispref/two-volume.make b/doc/lispref/two-volume.make index cf612b1257..c791e2522f 100644 --- a/doc/lispref/two-volume.make +++ b/doc/lispref/two-volume.make @@ -35,7 +35,7 @@ vol1.pdf: elisp1med-fns-ready elisp1med-aux-ready elisp1med-toc-ready $(tex1) # vol2.pdf: elisp2med-fns-ready elisp2med-aux-ready elisp2med-toc-ready - @echo "Final TeX run for volume 2..." + $(info Final TeX run for volume 2...) cp elisp2med-toc-ready elisp2-toc-ready.toc cp elisp2med-fns-ready vol2.fns cp elisp2med-aux-ready vol2.aux @@ -123,7 +123,7 @@ elisp1med-init: elisp1-fns-ready elisp1-aux-ready elisp1init-toc-ready $(texinfo mv vol1.toc elisp1med-toc # elisp2med-init: elisp2-fns-ready elisp2-aux-ready elisp2init-toc-ready $(texinfodir)/texinfo.tex - @echo "Final TeX run for volume 2..." + $(info Final TeX run for volume 2...) cp elisp2init-toc-ready elisp2-toc-ready.toc cp elisp2-fns-ready vol2.fns cp elisp2-aux-ready vol2.aux @@ -211,7 +211,7 @@ elisp1-init: elisp.texi touch $@ # elisp2-init: elisp.texi - @echo "Initial TeX run for volume 2..." + $(info Initial TeX run for volume 2...) rm -f vol2.aux vol2.toc $(tex2) texindex vol2.?? diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 7982c0dc5a..8be84e3fad 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -130,12 +130,12 @@ info: $(INFO_TARGETS) ## Used by top-level Makefile. ## Base file names of output info files. +INFO_BASES = $(patsubst %.info,%,$(notdir $(INFO_INSTALL))) echo-info: - @echo "$(INFO_INSTALL) " | \ - sed -e 's|[^ ]*/||g' -e 's/\.info//g' -e "s/ */.info /g" + @: $(info $(addsuffix .info,$(INFO_BASES))) echo-sources: - @echo ${SOURCES} + @: $(info $(SOURCES)) dvi: $(DVI_TARGETS) diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index c07b678839..835b601654 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -297,8 +297,8 @@ maybe-blessmail: $(BLESSMAIL_TARGET) ## up if chown or chgrp fails, as the package responsible for ## installing Emacs can fix this problem later. $(DESTDIR)${archlibdir}: all - @echo - @echo "Installing utilities run internally by Emacs." + $(info $ ) + $(info Installing utilities run internally by Emacs.) umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}" exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && /bin/pwd` && \ if [ "$$exp_archlibdir" != "`/bin/pwd`" ]; then \ @@ -339,8 +339,8 @@ $(DESTDIR)${archlibdir}: all .PHONY: bootstrap-clean check tags install: $(DESTDIR)${archlibdir} - @echo - @echo "Installing utilities for users to run." + $(info $ ) + $(info Installing utilities for users to run.) umask 022 && ${MKDIR_P} "$(DESTDIR)${bindir}" for file in ${INSTALLABLES} ; do \ $(INSTALL_PROGRAM) $(INSTALL_STRIP) $${file} \ @@ -375,7 +375,7 @@ bootstrap-clean maintainer-clean: distclean ## Test the contents of the directory. check: - @echo "We don't have any tests for the lib-src/ directory yet." + $(info We don't have any tests for the lib-src/ directory yet.) tagsfiles = $(wildcard ${srcdir}/*.[ch]) diff --git a/src/verbose.mk.in b/src/verbose.mk.in index 9252971acc..eee9d215ea 100644 --- a/src/verbose.mk.in +++ b/src/verbose.mk.in @@ -33,26 +33,26 @@ AM_V_GLOBALS = AM_V_NO_PD = AM_V_RC = else -AM_V_AR = @echo " AR " $@; +AM_V_AR = @$(info $ AR $@) AM_V_at = @ -AM_V_CC = @echo " CC " $@; -AM_V_CXX = @echo " CXX " $@; -AM_V_CCLD = @echo " CCLD " $@; -AM_V_CXXLD = @echo " CXXLD " $@; +AM_V_CC = @$(info $ CC $@) +AM_V_CXX = @$(info $ CXX $@) +AM_V_CCLD = @$(info $ CCLD $@) +AM_V_CXXLD = @$(info $ CXXLD $@) ifeq ($(HAVE_NATIVE_COMP),yes) ifeq ($(NATIVE_DISABLED),1) -AM_V_ELC = @echo " ELC " $@; +AM_V_ELC = @$(info $ ELC $@) AM_V_ELN = else -AM_V_ELC = @echo " ELC+ELN " $@; -AM_V_ELN = @echo " ELN " $@; +AM_V_ELC = @$(info $ ELC+ELN $@) +AM_V_ELN = @$(info $ ELN $@) endif else -AM_V_ELC = @echo " ELC " $@; +AM_V_ELC = @$(info $ ELC $@) AM_V_ELN = endif -AM_V_GEN = @echo " GEN " $@; -AM_V_GLOBALS = @echo " GEN " globals.h; +AM_V_GEN = @$(info $ GEN $@) +AM_V_GLOBALS = @$(info $ GEN globals.h) AM_V_NO_PD = --no-print-directory -AM_V_RC = @echo " RC " $@; +AM_V_RC = @$(info $ RC $@) endif diff --git a/test/Makefile.in b/test/Makefile.in index eeda2918fa..0bb35581d1 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -375,10 +375,10 @@ check-declare: .PHONY: subdirs subdir-targets generate-test-jobs subdirs: - @echo $(SUBDIRS) + @: $(info $(SUBDIRS)) subdir-targets: - @echo $(SUBDIR_TARGETS) + @: $(info $(SUBDIR_TARGETS)) generate-test-jobs: @$(MAKE) -C infra generate-test-jobs SUBDIRS="$(SUBDIRS)" commit a34650acff3740980ef23d900d35004bcfe2ef04 Author: Mattias Engdegård Date: Mon Dec 20 18:17:23 2021 +0100 Fix sloppy base64 acceptance of some multibyte characters The base64 encoding functions incorrectly accepted some multibyte characters; stop doing that (bug#52670). * src/fns.c (base64_encode_1): Reject all multibyte characters. * test/src/fns-tests.el (fns-tests-base64-encode-string) (fns-test-base64url-encode-region) (fns-test-base64url-encode-string): Add tests. * doc/lispref/text.texi (Base 64): Rephrase outdated manual text. * etc/NEWS: Add a notice. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 5ab5e5715f..9771d8a7ed 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4793,9 +4793,8 @@ converting to and from this code. This function converts the region from @var{beg} to @var{end} into base 64 code. It returns the length of the encoded text. An error is signaled if a character in the region is multibyte, i.e., in a -multibyte buffer the region must contain only characters from the -charsets @code{ascii}, @code{eight-bit-control} and -@code{eight-bit-graphic}. +multibyte buffer the region must contain only ASCII characters or raw +bytes. Normally, this function inserts newline characters into the encoded text, to avoid overlong lines. However, if the optional argument diff --git a/etc/NEWS b/etc/NEWS index 24f3da8f96..57fe40c488 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -848,6 +848,14 @@ This change is now applied in 'dired-insert-directory'. 'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode', 'vc-arch-command'. ++++ +** Base64 encoding no longer tolerates latin-1 input. +The functions 'base64-encode-string', 'base64url-encode-string', +'base64-encode-region' and 'base64url-encode-region' no longer accept +characters in the range U+0080..U+00FF as substitutes for single bytes +in the range 128..255, but signal an error for all multibyte characters. +The input must be encoded text. + * Lisp Changes in Emacs 29.1 diff --git a/src/fns.c b/src/fns.c index 76c76c92ba..23721334f7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3653,7 +3653,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); - else if (c >= 256) + else if (c >= 128) return -1; i += bytes; } @@ -3696,7 +3696,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); - else if (c >= 256) + else if (c >= 128) return -1; i += bytes; } @@ -3721,7 +3721,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); - else if (c >= 256) + else if (c >= 128) return -1; i += bytes; } diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index bec5c03f9e..63423f622f 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -318,7 +318,10 @@ (should (equal (base64-encode-string "fooba") "Zm9vYmE=")) (should (equal (base64-encode-string "foobar") "Zm9vYmFy")) (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7e") "FPucA9l+")) - (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l/"))) + (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l/")) + + (should-error (base64-encode-string "ƒ")) + (should-error (base64-encode-string "ü"))) (ert-deftest fns-test-base64url-encode-region () ;; url variant with padding @@ -360,7 +363,11 @@ (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t) (fns-tests--string-repeat "FPucA9l-" 10))) (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t) - (fns-tests--string-repeat "FPucA9l_" 10)))) + (fns-tests--string-repeat "FPucA9l_" 10))) + + (should-error (fns-tests--with-region base64url-encode-region "ƒ")) + (should-error (fns-tests--with-region base64url-encode-region "ü"))) + (ert-deftest fns-test-base64url-encode-string () ;; url variant with padding @@ -394,7 +401,10 @@ (should (equal (base64url-encode-string (fns-tests--string-repeat "fooba" 15) t) (fns-tests--string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5))) (should (equal (base64url-encode-string (fns-tests--string-repeat "foobar" 15) t) (concat (fns-tests--string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy"))) (should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t) (fns-tests--string-repeat "FPucA9l-" 10))) - (should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t) (fns-tests--string-repeat "FPucA9l_" 10)))) + (should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t) (fns-tests--string-repeat "FPucA9l_" 10))) + + (should-error (base64url-encode-string "ƒ")) + (should-error (base64url-encode-string "ü"))) (ert-deftest fns-tests-base64-decode-string () ;; standard variant RFC2045 commit 27be90154d1a4b19efe30c97f221b29e3becc920 Author: Sam Steingold Date: Mon Dec 20 13:22:42 2021 -0500 Fix build in a separate directory (bug#52669) * src/lisp.h: Include instead of "globals.h" diff --git a/src/lisp.h b/src/lisp.h index 92ab05b422..1518d4a869 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -954,7 +954,7 @@ typedef EMACS_UINT Lisp_Word_tag; ? ((y) - 1 + (x)) & ~ ((y) - 1) \ : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y)) -#include "globals.h" +#include /* Header of vector-like objects. This documents the layout constraints on vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents commit 6e050a4da7a175c590e9efae97891cf8ac85a887 Author: Stefan Kangas Date: Mon Dec 20 18:51:09 2021 +0100 Use defvar-keymap in wdired.el * lisp/wdired.el (wdired-mode-map, wdired-perm-mode-map): Use defvar-keymap. diff --git a/lisp/wdired.el b/lisp/wdired.el index eb5a638556..2e09bf5d9e 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -155,26 +155,24 @@ nonexistent directory will fail." :version "26.1" :type 'boolean) -(defvar wdired-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-x\C-s" #'wdired-finish-edit) - (define-key map "\C-c\C-c" #'wdired-finish-edit) - (define-key map "\C-c\C-k" #'wdired-abort-changes) - (define-key map "\C-c\C-[" #'wdired-abort-changes) - (define-key map "\C-x\C-q" #'wdired-exit) - (define-key map "\C-m" #'undefined) - (define-key map "\C-j" #'undefined) - (define-key map "\C-o" #'undefined) - (define-key map [up] #'wdired-previous-line) - (define-key map "\C-p" #'wdired-previous-line) - (define-key map [down] #'wdired-next-line) - (define-key map "\C-n" #'wdired-next-line) - (define-key map [remap upcase-word] #'wdired-upcase-word) - (define-key map [remap capitalize-word] #'wdired-capitalize-word) - (define-key map [remap downcase-word] #'wdired-downcase-word) - (define-key map [remap self-insert-command] #'wdired--self-insert) - map) - "Keymap used in `wdired-mode'.") +(defvar-keymap wdired-mode-map + :doc "Keymap used in `wdired-mode'." + "C-x C-s" #'wdired-finish-edit + "C-c C-c" #'wdired-finish-edit + "C-c C-k" #'wdired-abort-changes + "C-c C-[" #'wdired-abort-changes + "C-x C-q" #'wdired-exit + "RET" #'undefined + "C-j" #'undefined + "C-o" #'undefined + "" #'wdired-previous-line + "C-p" #'wdired-previous-line + "" #'wdired-next-line + "C-n" #'wdired-next-line + " " #'wdired-upcase-word + " " #'wdired-capitalize-word + " " #'wdired-downcase-word + " " #'wdired--self-insert) (easy-menu-define wdired-mode-menu wdired-mode-map "Menu for `wdired-mode'." @@ -872,21 +870,19 @@ Like original function but it skips read-only words." ;; The following code deals with changing the access bits (or ;; permissions) of the files. -(defvar wdired-perm-mode-map - (let ((map (make-sparse-keymap))) - (define-key map " " #'wdired-toggle-bit) - (define-key map "r" #'wdired-set-bit) - (define-key map "w" #'wdired-set-bit) - (define-key map "x" #'wdired-set-bit) - (define-key map "-" #'wdired-set-bit) - (define-key map "S" #'wdired-set-bit) - (define-key map "s" #'wdired-set-bit) - (define-key map "T" #'wdired-set-bit) - (define-key map "t" #'wdired-set-bit) - (define-key map "s" #'wdired-set-bit) - (define-key map "l" #'wdired-set-bit) - (define-key map [mouse-1] #'wdired-mouse-toggle-bit) - map)) +(defvar-keymap wdired-perm-mode-map + "SPC" #'wdired-toggle-bit + "r" #'wdired-set-bit + "w" #'wdired-set-bit + "x" #'wdired-set-bit + "-" #'wdired-set-bit + "S" #'wdired-set-bit + "s" #'wdired-set-bit + "T" #'wdired-set-bit + "t" #'wdired-set-bit + "s" #'wdired-set-bit + "l" #'wdired-set-bit + "" #'wdired-mouse-toggle-bit) ;; Put a keymap property to the permission bits of the files, and store the ;; original name and permissions as a property commit 89eb23589f9274c8531f291f3e8156f3d640dd27 Author: Stefan Kangas Date: Mon Dec 20 18:34:42 2021 +0100 Use declare-function instead of defun in eieio-tests.el * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el: Prefer declare-function to defun. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 802792567b..c13d3ee6ef 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -139,8 +139,8 @@ ;; ))) ;; Silence byte-compiler. -(defun eitest-subordinate--eieio-childp ()) -(defun class-alloc-initarg--eieio-childp ()) +(declare-function eitest-subordinate--eieio-childp nil) +(declare-function class-alloc-initarg--eieio-childp nil) (ert-deftest eieio-test-01-mix-alloc-initarg () ;; Only run this test if the message framework thingy works. (skip-unless (and (message "foo") (string= "foo" (current-message)))) @@ -213,8 +213,8 @@ Argument C is the class bound to this static method." (oset-default c some-slot value))) ;; Silence byte-compiler. -(defun static-method-class-2 ()) -(defun static-method-class-2--eieio-childp ()) +(declare-function static-method-class-2 nil) +(declare-function static-method-class-2--eieio-childp nil) (ert-deftest eieio-test-04-static-method () ;; Call static method on a class and see if it worked (static-method-class-method 'static-method-class 'class) @@ -546,8 +546,8 @@ METHOD is the method that was attempting to be called." ;; Silence byte-compiler. (defvar eitest-tests nil) -(defun eitest-superior ()) -(defun eitest-superior--eieio-childp ()) +(declare-function eitest-superior nil) +(declare-function eitest-superior--eieio-childp nil) (ert-deftest eieio-test-22-init-forms-dont-match-runnable () ;; Init forms with types that don't match the runnable. (defclass eitest-subordinate nil @@ -597,8 +597,8 @@ METHOD is the method that was attempting to be called." ;; Silence byte-compiler. (defvar eitest-t1 nil) -(defun eieio-tests-initform-not-evaluated-when-initarg-is-present ()) -(defun eieio-tests-initform-not-evaluated-when-initarg-is-present--eieio-childp ()) +(declare-function eieio-tests-initform-not-evaluated-when-initarg-is-present nil) +(declare-function eieio-tests-initform-not-evaluated-when-initarg-is-present--eieio-childp nil) (ert-deftest eieio-test-25-slot-tests () (setq eitest-t1 (class-c)) ;; Slot initialization commit de797bb853e85e3cc3c9ec71f51e4e78e41af4ab Author: Mattias Engdegård Date: Mon Dec 20 17:29:17 2021 +0100 ; * lisp/emacs-lisp/cl-macs.el (cl--self-tco): fix bootstrapping diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 9e93e8775d..87f7e07851 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2145,8 +2145,8 @@ Like `cl-flet' but the definitions can refer to previous ones. (not (memq var shadowings)) ;; If any of the new bindings is a dynamic ;; variable, the body is not in tail position. - (not (cl-some #'macroexp--dynamic-variable-p - shadowings)))))) + (not (delq nil (mapcar #'macroexp--dynamic-variable-p + shadowings))))))) `(,(car exp) ,bindings . ,(funcall opt-exps exps))) ((and `(condition-case ,err-var ,bodyform . ,handlers) (guard (not (eq err-var var)))) commit 19206fd1e764cfe89234ae9245bafa88ef1ec354 Author: Mattias Engdegård Date: Mon Dec 20 17:13:09 2021 +0100 Silence byte-compiler warnings from absent optional features * test/src/inotify-tests.el (inotify-rm-watch): * test/src/lcms-tests.el (lcms-xyz->jch): * test/src/sqlite-tests.el (sqlite-open): Add declarations to prevent byte-compilation warnings when features are absent. diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el index 70330ac865..ea1951b889 100644 --- a/test/src/inotify-tests.el +++ b/test/src/inotify-tests.el @@ -28,6 +28,7 @@ (declare-function inotify-add-watch "inotify.c" (file-name aspect callback)) (declare-function inotify-rm-watch "inotify.c" (watch-descriptor)) +(declare-function inotify-valid-p "inotify.c" (watch-descriptor)) (ert-deftest inotify-valid-p-simple () "Simple tests for `inotify-valid-p'." diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index d2d137e9bd..bffeba762a 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -35,6 +35,13 @@ (require 'ert) (require 'color) +(declare-function lcms-jab->jch "lcms.c") +(declare-function lcms-jch->jab "lcms.c") +(declare-function lcms-xyz->jch "lcms.c") +(declare-function lcms-jch->xyz "lcms.c") +(declare-function lcms-temp->white-point "lcms.c") +(declare-function lcms-cam02-ucs "lcms.c") + (defconst lcms-colorspacious-d65 '(0.95047 1.0 1.08883) "D65 white point from colorspacious.") diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el index 27ba74e9d2..d7100537a4 100644 --- a/test/src/sqlite-tests.el +++ b/test/src/sqlite-tests.el @@ -35,6 +35,7 @@ (declare-function sqlite-more-p "sqlite.c") (declare-function sqlite-select "sqlite.c") (declare-function sqlite-open "sqlite.c") +(declare-function sqlite-load-extension "sqlite.c") (ert-deftest sqlite-select () (skip-unless (sqlite-available-p)) commit 92ffe44834b8f77ee3f4d37edfdb19f30a376869 Author: Mattias Engdegård Date: Mon Dec 20 11:59:22 2021 +0100 Body of dynamic let-bindings is not in tail position This fixes a known bug in `named-let`. * lisp/emacs-lisp/cl-macs.el (cl--self-tco): Prevent TCO from inside dynamic variable bindings. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels): Add test. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index f78fdcf008..9e93e8775d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2139,9 +2139,14 @@ Like `cl-flet' but the definitions can refer to previous ones. ;; setq the fresh new `ofargs' vars instead ;-) (let ((shadowings (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))) - ;; If `var' is shadowed, then it clearly can't be - ;; tail-called any more. - (not (memq var shadowings))))) + (and + ;; If `var' is shadowed, then it clearly can't be + ;; tail-called any more. + (not (memq var shadowings)) + ;; If any of the new bindings is a dynamic + ;; variable, the body is not in tail position. + (not (cl-some #'macroexp--dynamic-variable-p + shadowings)))))) `(,(car exp) ,bindings . ,(funcall opt-exps exps))) ((and `(condition-case ,err-var ,bodyform . ,handlers) (guard (not (eq err-var var)))) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 13da60ec45..ced2cc10f3 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -666,7 +666,24 @@ collection clause." (should (pcase (macroexpand '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) #'len)) - (`(function (lambda (,_ ,_) . ,_)) t)))) + (`(function (lambda (,_ ,_) . ,_)) t))) + + ;; Verify that there is no tail position inside dynamic variable bindings. + (defvar dyn-var) + (let ((dyn-var 'a)) + (cl-labels ((f (x) (if x + dyn-var + (let ((dyn-var 'b)) + (f dyn-var))))) + (should (equal (f nil) 'b)))) + + ;; Control: same as above but with lexical binding. + (let ((lex-var 'a)) + (cl-labels ((f (x) (if x + lex-var + (let ((lex-var 'b)) + (f lex-var))))) + (should (equal (f nil) 'a))))) (ert-deftest cl-macs--progv () (defvar cl-macs--test) commit 8706f6fde13729bf330693cfd163773583e526a9 Author: Mattias Engdegård Date: Sat Dec 11 21:39:19 2021 +0100 Add `macroexp--dynamic-variable-p` This predicate can be used for discriminating between lexically and dynamically bound variables during macro-expansion (only). It is restricted to internal use for the time being. * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Use macroexpand--all-toplevel. * lisp/emacs-lisp/macroexp.el (macroexp-dynamic-variable-p): New. (macroexp--expand-all): Maintain macroexp--dynvars. (macroexpand-all): Rebind macroexp--dynvars. (macroexpand--all-toplevel): New. (internal-macroexpand-for-load): Use macroexpand--all-toplevel. * src/eval.c (eval_sub): Transfer defvar declarations from Vinternal_interpreter_environment into macroexp--dynvars during lazy macro-expansion. * src/lread.c (readevalloop): Rebind macroexp--dynvars around read-and-evaluate operations. (syms_of_lread): Define macroexp--dynvars. * test/lisp/emacs-lisp/macroexp-resources/vk.el: New file. * test/lisp/emacs-lisp/macroexp-tests.el (macroexp-tests--run-emacs) (macroexp-tests--eval-in-subprocess) (macroexp-tests--byte-compile-in-subprocess) (macroexp--tests-dynamic-variable-p): Add tests. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a98c9197a0..11107ec0f6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -510,7 +510,7 @@ Return the compile-time value of FORM." ;; whether to compile as byte-compile-form ;; or byte-compile-file-form. (let ((expanded - (macroexpand-all + (macroexpand--all-toplevel form macroexpand-all-environment))) (eval expanded lexical-binding) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index a20c424e2b..c04cbb7fff 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -289,6 +289,16 @@ is executed without being compiled first." `(let ,(nreverse bindings) . ,body) (macroexp-progn body))))) +(defun macroexp--dynamic-variable-p (var) + "Whether the variable VAR is dynamically scoped. +Only valid during macro-expansion." + (defvar byte-compile-bound-variables) + (or (not lexical-binding) + (special-variable-p var) + (memq var macroexp--dynvars) + (and (boundp 'byte-compile-bound-variables) + (memq var byte-compile-bound-variables)))) + (defun macroexp--expand-all (form) "Expand all macros in FORM. This is an internal version of `macroexpand-all'. @@ -316,28 +326,32 @@ Assumes the caller has bound `macroexpand-all-environment'." (cddr form)) (cdr form)) form)) - (`(,(or 'defvar 'defconst) . ,_) (macroexp--all-forms form 2)) + (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) + (push name macroexp--dynvars) + (macroexp--all-forms form 2)) (`(function ,(and f `(lambda . ,_))) - (macroexp--cons 'function - (macroexp--cons (macroexp--all-forms f 2) - nil - (cdr form)) - form)) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons 'function + (macroexp--cons (macroexp--all-forms f 2) + nil + (cdr form)) + form))) (`(,(or 'function 'quote) . ,_) form) (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) pcase--dontcare)) - (macroexp--cons - fun - (macroexp--cons - (macroexp--all-clauses bindings 1) - (if (null body) - (macroexp-unprogn - (macroexp-warn-and-return - (format "Empty %s body" fun) - nil nil 'compile-only)) - (macroexp--all-forms body)) - (cdr form)) - form)) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons + fun + (macroexp--cons + (macroexp--all-clauses bindings 1) + (if (null body) + (macroexp-unprogn + (macroexp-warn-and-return + (format "Empty %s body" fun) + nil nil 'compile-only)) + (macroexp--all-forms body)) + (cdr form)) + form))) (`(,(and fun `(lambda . ,_)) . ,args) ;; Embedded lambda in function position. ;; If the byte-optimizer is loaded, try to unfold this, @@ -421,6 +435,14 @@ Assumes the caller has bound `macroexpand-all-environment'." If no macros are expanded, FORM is returned unchanged. The second optional arg ENVIRONMENT specifies an environment of macro definitions to shadow the loaded ones for use in file byte-compilation." + (let ((macroexpand-all-environment environment) + (macroexp--dynvars macroexp--dynvars)) + (macroexp--expand-all form))) + +;; This function is like `macroexpand-all' but for use with top-level +;; forms. It does not dynbind `macroexp--dynvars' because we want +;; top-level `defvar' declarations to be recorded in that variable. +(defun macroexpand--all-toplevel (form &optional environment) (let ((macroexpand-all-environment environment)) (macroexp--expand-all form))) @@ -706,7 +728,7 @@ test of free variables in the following ways: (let ((macroexp--pending-eager-loads (cons load-file-name macroexp--pending-eager-loads))) (if full-p - (macroexpand-all form) + (macroexpand--all-toplevel form) (macroexpand form))) (error ;; Hopefully this shouldn't happen thanks to the cycle detection, diff --git a/src/eval.c b/src/eval.c index fe29564aa2..ddf455e4d7 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2608,6 +2608,19 @@ eval_sub (Lisp_Object form) interpreted using lexical-binding or not. */ specbind (Qlexical_binding, NILP (Vinternal_interpreter_environment) ? Qnil : Qt); + + /* Make the macro aware of any defvar declarations in scope. */ + Lisp_Object dynvars = Vmacroexp__dynvars; + for (Lisp_Object p = Vinternal_interpreter_environment; + !NILP (p); p = XCDR(p)) + { + Lisp_Object e = XCAR (p); + if (SYMBOLP (e)) + dynvars = Fcons(e, dynvars); + } + if (!EQ (dynvars, Vmacroexp__dynvars)) + specbind (Qmacroexp__dynvars, dynvars); + exp = apply1 (Fcdr (fun), original_args); exp = unbind_to (count1, exp); val = eval_sub (exp); diff --git a/src/lread.c b/src/lread.c index 5a2f1bc54e..4992576414 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2209,6 +2209,7 @@ readevalloop (Lisp_Object readcharfun, specbind (Qinternal_interpreter_environment, (NILP (lex_bound) || EQ (lex_bound, Qunbound) ? Qnil : list1 (Qt))); + specbind (Qmacroexp__dynvars, Vmacroexp__dynvars); /* Ensure sourcename is absolute, except whilst preloading. */ if (!will_dump_p () @@ -5469,4 +5470,10 @@ This variable's value can only be set via file-local variables. See Info node `(elisp)Shorthands' for more details. */); Vread_symbol_shorthands = Qnil; DEFSYM (Qobarray_cache, "obarray-cache"); + + DEFSYM (Qmacroexp__dynvars, "macroexp--dynvars"); + DEFVAR_LISP ("macroexp--dynvars", Vmacroexp__dynvars, + doc: /* List of variables declared dynamic in the current scope. +Only valid during macro-expansion. Internal use only. */); + Vmacroexp__dynvars = Qnil; } diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el new file mode 100644 index 0000000000..8bbd94ac66 --- /dev/null +++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el @@ -0,0 +1,126 @@ +;;; vk.el --- test code for macroexp-tests -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; 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. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(require 'macroexp) + +(defmacro vk-variable-kind (var) + (if (macroexp--dynamic-variable-p var) ''dyn ''lex)) + +(defvar vk-a 1) +(defconst vk-b 2) +(defvar vk-c) + +(defun vk-f1 (x) + (defvar vk-u1) + (let ((vk-a 10) + (vk-b 20) + (vk-c 30) + (vk-u1 40) + (y 50)) + (ignore vk-a vk-b vk-c vk-u1 x y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-c) ; dyn + (vk-variable-kind vk-u1) ; dyn + (vk-variable-kind x) ; lex + (vk-variable-kind y)))) ; lex + +(eval-and-compile + (defvar vk-u2) + (defun vk-f2 (x) + (defvar vk-v2) + (let ((vk-u2 11) + (vk-v2 12) + (y 13)) + (ignore vk-u2 vk-v2 x y) + (list + (vk-variable-kind vk-u2) ; dyn + (vk-variable-kind vk-v2) ; dyn + (vk-variable-kind x) ; lex + (vk-variable-kind y))))) ; lex + +(eval-when-compile + (defvar vk-u3) + (defun vk-f3 (x) + (defvar vk-v3) + (let ((vk-a 23) + (vk-b 24) + (vk-u3 25) + (vk-v3 26) + (y 27)) + (ignore vk-a vk-b vk-u3 vk-v3 x y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-u3) ; dyn + (vk-variable-kind vk-v3) ; dyn + (vk-variable-kind x) ; lex + (vk-variable-kind y))))) ; lex + +(defconst vk-val3 (eval-when-compile (vk-f3 0))) + +(defconst vk-f4 '(lambda (x) + (defvar vk-v4) + (let ((vk-v4 31) + (y 32)) + (ignore vk-v4 x y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-v4) ; dyn + (vk-variable-kind x) ; dyn + (vk-variable-kind y))))) ; dyn + +(defconst vk-f5 '(closure (t) (x) + (defvar vk-v5) + (let ((vk-v5 41) + (y 42)) + (ignore vk-v5 x y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-v5) ; dyn + (vk-variable-kind x) ; lex + (vk-variable-kind y))))) ; lex + +(defun vk-f6 () + (eval '(progn + (defvar vk-v6) + (let ((vk-v6 51) + (y 52)) + (ignore vk-v6 y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-v6) ; dyn + (vk-variable-kind vk-y)))))) ; dyn + +(defun vk-f7 () + (eval '(progn + (defvar vk-v7) + (let ((vk-v7 51) + (y 52)) + (ignore vk-v7 y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-v7) ; dyn + (vk-variable-kind vk-y)))) ; lex + t)) + +(provide 'vk) diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el index 89d3882d1d..292c11ac6c 100644 --- a/test/lisp/emacs-lisp/macroexp-tests.el +++ b/test/lisp/emacs-lisp/macroexp-tests.el @@ -24,6 +24,9 @@ ;;; Code: +(require 'macroexp) +(require 'ert-x) + (ert-deftest macroexp--tests-fgrep () (should (equal (macroexp--fgrep '((x) (y)) '([x] z ((u)))) '((x)))) @@ -67,6 +70,58 @@ (should (equal "m1.el" (file-name-nondirectory macroexp--m1-tests-comp-filename))))) +(defun macroexp-tests--run-emacs (&rest args) + "Run Emacs in batch mode with ARGS, return output." + (let ((emacs (expand-file-name invocation-name invocation-directory))) + (with-temp-buffer + (let ((res (apply #'call-process emacs nil t nil + "-Q" "--batch" args)) + (output (buffer-string))) + (unless (equal res 0) + (message "%s" output) + (error "Inferior Emacs exited with status %S" res)) + output)))) + +(defun macroexp-tests--eval-in-subprocess (file expr) + (let ((output (macroexp-tests--run-emacs + "-l" file (format "--eval=(print %S)" expr)))) + (car (read-from-string output)))) + +(defun macroexp-tests--byte-compile-in-subprocess (file) + "Byte-compile FILE using a subprocess to avoid contaminating the lisp state." + (let ((output (macroexp-tests--run-emacs "-f" "batch-byte-compile" file))) + (when output + (message "%s" output)))) + +(ert-deftest macroexp--tests-dynamic-variable-p () + "Test `macroexp--dynamic-variable-p'." + (let* ((vk-el (ert-resource-file "vk.el")) + (vk-elc (concat vk-el "c")) + (expr '(list (vk-f1 0) + (vk-f2 0) + vk-val3 + (funcall vk-f4 0) + (funcall vk-f5 0) + (vk-f6) + (vk-f7)))) + ;; We compile and run the test in separate processes for complete + ;; isolation between test cases. + (should (equal (macroexp-tests--eval-in-subprocess vk-el expr) + '((dyn dyn dyn dyn lex lex) + (dyn dyn lex lex) + (dyn dyn dyn dyn lex lex) + (dyn dyn dyn dyn dyn) + (dyn dyn dyn lex lex) + (dyn dyn dyn dyn) + (dyn dyn dyn lex)))) + (macroexp-tests--byte-compile-in-subprocess vk-el) + (should (equal (macroexp-tests--eval-in-subprocess vk-elc expr) + '((dyn dyn dyn dyn lex lex) + (dyn dyn lex lex) + (dyn dyn dyn dyn lex lex) + (dyn dyn dyn dyn dyn) + (dyn dyn dyn lex lex) + (dyn dyn dyn dyn) + (dyn dyn dyn lex)))))) -(provide 'macroexp-tests) ;;; macroexp-tests.el ends here commit 3259f399d46dabff5e0a87169d3d3455729d8681 Author: Mattias Engdegård Date: Sun Dec 19 12:38:17 2021 +0100 Treat base64 string encode/decode as pure functions * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns, pure-fns): Mark base64-decode-string, base64-encode-string and base64url-encode-string as pure and side-effect-free. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 2bdf1f5511..66ac67a814 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1464,6 +1464,7 @@ See Info node `(elisp) Integer Basics'." (let ((side-effect-free-fns '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan assq + base64-decode-string base64-encode-string base64url-encode-string bool-vector-count-consecutive bool-vector-count-population bool-vector-subsetp boundp buffer-file-name buffer-local-variables buffer-modified-p @@ -1620,6 +1621,7 @@ See Info node `(elisp) Integer Basics'." assq rassq rassoc plist-get lax-plist-get plist-member aref elt + base64-decode-string base64-encode-string base64url-encode-string bool-vector-subsetp bool-vector-count-population bool-vector-count-consecutive ))) commit eead51bc71cf1b9c80ce1b806bbdfb95245e568d Author: Stefan Kangas Date: Mon Dec 20 15:54:56 2021 +0100 Silence byte-compiler using with-no-warnings in tests We could silence the specific warnings by adding support for them to with-suppressed-warnings, but it is almost not worth the complexity for warnings that only show up in one file. In any case, it is not urgent, so leave behind FIXMEs for now. * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-37-obsolete-name-in-constructor, class-c) (eieio-test-01-mix-alloc-initarg, slotattr-class-base): * test/lisp/progmodes/elisp-mode-tests.el (xref-elisp-generic-co-located-default): Silence byte-compiler. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index a462b4540d..802792567b 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -66,40 +66,41 @@ :documentation "Detail about amphibian on land and water.")) "Class A and B combined.") -(defclass class-c () - ((slot-1 :initarg :moose - :initform 'moose - :type symbol - :allocation :instance - :documentation "First slot testing slot arguments." - :custom symbol - :label "Wild Animal" - :group borg - :protection :public) - (slot-2 :initarg :penguin - :initform "penguin" - :type string - :allocation :instance - :documentation "Second slot testing slot arguments." - :custom string - :label "Wild bird" - :group vorlon - :accessor get-slot-2 - :protection :private) - (slot-3 :initarg :emu - :initform 'emu - :type symbol - :allocation :class - :documentation "Third slot test class allocated accessor" - :custom symbol - :label "Fuzz" - :group tokra - :accessor get-slot-3 - :protection :private) - ) - (:custom-groups (foo)) - "A class for testing slot arguments." - ) +(with-no-warnings ; FIXME: Make more specific. + (defclass class-c () + ((slot-1 :initarg :moose + :initform 'moose + :type symbol + :allocation :instance + :documentation "First slot testing slot arguments." + :custom symbol + :label "Wild Animal" + :group borg + :protection :public) + (slot-2 :initarg :penguin + :initform "penguin" + :type string + :allocation :instance + :documentation "Second slot testing slot arguments." + :custom string + :label "Wild bird" + :group vorlon + :accessor get-slot-2 + :protection :private) + (slot-3 :initarg :emu + :initform 'emu + :type symbol + :allocation :class + :documentation "Third slot test class allocated accessor" + :custom symbol + :label "Fuzz" + :group tokra + :accessor get-slot-3 + :protection :private) + ) + (:custom-groups (foo)) + "A class for testing slot arguments." + )) (defclass class-subc (class-c) ((slot-1 ;; :initform moose - don't override this @@ -146,10 +147,11 @@ ;; Defining this class should generate a warning(!) message that ;; you should not mix :initarg with class allocated slots. - (defclass class-alloc-initarg () - ((throwwarning :initarg :throwwarning - :allocation :class)) - "Throw a warning mixing allocation class and an initarg.") + (with-no-warnings ; FIXME: Make more specific. + (defclass class-alloc-initarg () + ((throwwarning :initarg :throwwarning + :allocation :class)) + "Throw a warning mixing allocation class and an initarg.")) ;; Check that message is there (should (current-message)) @@ -823,25 +825,26 @@ Subclasses to override slot attributes.") (let ((obj (slotattr-ok))) (should (eq (oref obj initform) 'no-init)))) -(defclass slotattr-class-base () - ((initform :allocation :class - :initform 'init) - (type :allocation :class - :type list) - (initarg :allocation :class - :initarg :initarg) - (protection :allocation :class - :protection :private) - (custom :allocation :class - :custom (repeat string) - :label "Custom Strings" - :group moose) - (docstring :allocation :class - :documentation - "Replace the doc-string for this property.") - ) - "Baseclass we will attempt to subclass. -Subclasses to override slot attributes.") +(with-no-warnings ; FIXME: Make more specific. + (defclass slotattr-class-base () + ((initform :allocation :class + :initform 'init) + (type :allocation :class + :type list) + (initarg :allocation :class + :initarg :initarg) + (protection :allocation :class + :protection :private) + (custom :allocation :class + :custom (repeat string) + :label "Custom Strings" + :group moose) + (docstring :allocation :class + :documentation + "Replace the doc-string for this property.") + ) + "Baseclass we will attempt to subclass. +Subclasses to override slot attributes.")) (defclass slotattr-class-ok (slotattr-class-base) ((initform :initform 'no-init) @@ -967,7 +970,12 @@ Subclasses to override slot attributes.") (ert-deftest eieio-test-37-obsolete-name-in-constructor () ;; FIXME repeated intermittent failures on hydra and elsewhere (bug#24503). :tags '(:unstable) - (should (equal (eieio--testing "toto") '("toto" 2)))) + ;; Disable byte-compiler "Warning: Obsolete name arg "toto" to + ;; constructor eieio--testing". This could be made more specific + ;; with changes to `with-suppressed-warnings', but it's not worth + ;; the hassle for just this one test. + (with-no-warnings + (should (equal (eieio--testing "toto") '("toto" 2))))) (ert-deftest eieio-autoload () "Tests to see whether reftex-auc has been autoloaded" diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 9dc5e8cadc..62e0c29323 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -449,13 +449,15 @@ to (xref-elisp-test-descr-to-target xref)." ;; dispatching code. ) -(cl-defgeneric xref-elisp-generic-co-located-default (arg1 arg2) - "Doc string generic co-located-default." - "co-located default") - -(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2) - "Doc string generic co-located-default xref-elisp-root-type." - "non-default for co-located-default") +(with-no-warnings ; FIXME: Make more specific. + (cl-defgeneric xref-elisp-generic-co-located-default (arg1 arg2) + "Doc string generic co-located-default." + "co-located default")) + +(with-no-warnings ; FIXME: Make more specific. + (cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2) + "Doc string generic co-located-default xref-elisp-root-type." + "non-default for co-located-default")) (cl-defgeneric xref-elisp-generic-separate-default (arg1 arg2) "Doc string generic separate-default." commit b5393c68aef07562a1cc14ed100c3dbfb29f11ce Author: Stefan Kangas Date: Mon Dec 20 15:25:23 2021 +0100 Silence undefined function warnings in eieio-tests.el * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el: Silence byte-compiler with some function definitions. These are overridden by class definitions further down. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index a9e39ea8fb..a462b4540d 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -137,6 +137,9 @@ ;; (error "invalid-slot-type thrown when eieio-error-unsupported-class-tags is nil") ;; ))) +;; Silence byte-compiler. +(defun eitest-subordinate--eieio-childp ()) +(defun class-alloc-initarg--eieio-childp ()) (ert-deftest eieio-test-01-mix-alloc-initarg () ;; Only run this test if the message framework thingy works. (skip-unless (and (message "foo") (string= "foo" (current-message)))) @@ -207,6 +210,9 @@ Argument C is the class bound to this static method." (if (eieio-object-p c) (setq c (eieio-object-class c))) (oset-default c some-slot value))) +;; Silence byte-compiler. +(defun static-method-class-2 ()) +(defun static-method-class-2--eieio-childp ()) (ert-deftest eieio-test-04-static-method () ;; Call static method on a class and see if it worked (static-method-class-method 'static-method-class 'class) @@ -536,8 +542,10 @@ METHOD is the method that was attempting to be called." (should (eq (oref eitest-pvinit evalval) 2)) (should (eq (oref eitest-pvinit evalnow) 1))) +;; Silence byte-compiler. (defvar eitest-tests nil) - +(defun eitest-superior ()) +(defun eitest-superior--eieio-childp ()) (ert-deftest eieio-test-22-init-forms-dont-match-runnable () ;; Init forms with types that don't match the runnable. (defclass eitest-subordinate nil @@ -585,7 +593,10 @@ METHOD is the method that was attempting to be called." (should-not (cl-typep listooa '(list-of class-b))) (should-not (cl-typep listoob '(list-of class-a))))) +;; Silence byte-compiler. (defvar eitest-t1 nil) +(defun eieio-tests-initform-not-evaluated-when-initarg-is-present ()) +(defun eieio-tests-initform-not-evaluated-when-initarg-is-present--eieio-childp ()) (ert-deftest eieio-test-25-slot-tests () (setq eitest-t1 (class-c)) ;; Slot initialization commit 2bfea5fd1fd1335d4b865e5561f8a40596064eae Author: Stefan Kangas Date: Mon Dec 20 13:57:19 2021 +0100 Prefer skip-unless in one eieio test * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-01-mix-alloc-initarg): Use skip-unless to correctly mark the test as skipped. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 25b36c0f1c..a9e39ea8fb 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -139,19 +139,19 @@ (ert-deftest eieio-test-01-mix-alloc-initarg () ;; Only run this test if the message framework thingy works. - (when (and (message "foo") (string= "foo" (current-message))) - - ;; Defining this class should generate a warning(!) message that - ;; you should not mix :initarg with class allocated slots. - (defclass class-alloc-initarg () - ((throwwarning :initarg :throwwarning - :allocation :class)) - "Throw a warning mixing allocation class and an initarg.") - - ;; Check that message is there - (should (current-message)) - (should (string-match "Class allocated slots do not need :initarg" - (current-message))))) + (skip-unless (and (message "foo") (string= "foo" (current-message)))) + + ;; Defining this class should generate a warning(!) message that + ;; you should not mix :initarg with class allocated slots. + (defclass class-alloc-initarg () + ((throwwarning :initarg :throwwarning + :allocation :class)) + "Throw a warning mixing allocation class and an initarg.") + + ;; Check that message is there + (should (current-message)) + (should (string-match "Class allocated slots do not need :initarg" + (current-message)))) (defclass abstract-class () ((some-slot :initarg :some-slot commit 3cf11a3c6101cc30e3a8d40fdab6cdcb097105c8 Author: Stefan Kangas Date: Mon Dec 20 13:51:06 2021 +0100 Silence byte-compiler in cconv-tests.el * test/lisp/emacs-lisp/cconv-tests.el (cconv-tests-iter-lambda-:documentation) (cconv-tests-cl-function-:documentation): Silence byte-compiler. diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el index 0701892b8c..94bc759fa0 100644 --- a/test/lisp/emacs-lisp/cconv-tests.el +++ b/test/lisp/emacs-lisp/cconv-tests.el @@ -107,23 +107,25 @@ "Docstring for iter-lambda can be specified with :documentation." ;; FIXME: See Bug#28557. :expected-result :failed - (let ((iter-fun - (iter-lambda () - (:documentation (concat "iter-lambda" " documentation")) - (iter-yield 'iter-lambda-result)))) - (should (string= (documentation iter-fun) "iter-lambda documentation")) - (should (eq (iter-next (funcall iter-fun)) 'iter-lambda-result)))) + (with-no-warnings ; disable warnings for now as test is expected to fail + (let ((iter-fun + (iter-lambda () + (:documentation (concat "iter-lambda" " documentation")) + (iter-yield 'iter-lambda-result)))) + (should (string= (documentation iter-fun) "iter-lambda documentation")) + (should (eq (iter-next (funcall iter-fun)) 'iter-lambda-result))))) (ert-deftest cconv-tests-cl-function-:documentation () "Docstring for cl-function can be specified with :documentation." ;; FIXME: See Bug#28557. :expected-result :failed - (let ((fun (cl-function (lambda (&key arg) - (:documentation (concat "cl-function" - " documentation")) - (list arg 'cl-function-result))))) - (should (string= (documentation fun) "cl-function documentation")) - (should (equal (funcall fun :arg t) '(t cl-function-result))))) + (with-no-warnings ; disable warnings for now as test is expected to fail + (let ((fun (cl-function (lambda (&key arg) + (:documentation (concat "cl-function" + " documentation")) + (list arg 'cl-function-result))))) + (should (string= (documentation fun) "cl-function documentation")) + (should (equal (funcall fun :arg t) '(t cl-function-result)))))) (ert-deftest cconv-tests-function-:documentation () "Docstring for lambda inside function can be specified with :documentation." commit 152b94ed0f57e81563b5dab34ee0183ecfac9394 Merge: 1ffb75780b 16ed9fad2c Author: Stefan Kangas Date: Mon Dec 20 06:30:32 2021 +0100 Merge from origin/emacs-28 16ed9fad2c ; * doc/lispref/frames.texi (Child Frames): Improve wording. f11b996a3c Clarify description of two mouse dragging parameters (Bug#... commit 1ffb75780bbee7e251d3fe7b0bb3622990f2fdd5 Author: Stefan Kangas Date: Sun Dec 19 21:29:35 2021 +0100 * lisp/progmodes/sh-script.el (sh-mode-map): Use defvar-keymap. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index a90fc425cf..92326d0dcf 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -402,39 +402,36 @@ This is buffer-local in every such buffer.") (rpm . (,sh-mode-syntax-table ?\' "."))) "Syntax-table used in Shell-Script mode. See `sh-feature'.") -(defvar sh-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c(" 'sh-function) - (define-key map "\C-c\C-w" 'sh-while) - (define-key map "\C-c\C-u" 'sh-until) - (define-key map "\C-c\C-t" 'sh-tmp-file) - (define-key map "\C-c\C-s" 'sh-select) - (define-key map "\C-c\C-r" 'sh-repeat) - (define-key map "\C-c\C-o" 'sh-while-getopts) - (define-key map "\C-c\C-l" 'sh-indexed-loop) - (define-key map "\C-c\C-i" 'sh-if) - (define-key map "\C-c\C-f" 'sh-for) - (define-key map "\C-c\C-c" 'sh-case) - (define-key map "\C-c?" #'smie-config-show-indent) - (define-key map "\C-c=" #'smie-config-set-indent) - (define-key map "\C-c<" #'smie-config-set-indent) - (define-key map "\C-c>" #'smie-config-guess) - (define-key map "\C-c\C-\\" 'sh-backslash-region) - - (define-key map "\C-c+" 'sh-add) - (define-key map "\C-\M-x" 'sh-execute-region) - (define-key map "\C-c\C-x" 'executable-interpret) - (define-key map "\C-c\C-n" 'sh-send-line-or-region-and-step) - (define-key map "\C-c\C-d" 'sh-cd-here) - (define-key map "\C-c\C-z" 'sh-show-shell) - - (define-key map [remap delete-backward-char] - 'backward-delete-char-untabify) - (define-key map "\C-c:" 'sh-set-shell) - (define-key map [remap backward-sentence] 'sh-beginning-of-command) - (define-key map [remap forward-sentence] 'sh-end-of-command) - map) - "Keymap used in Shell-Script mode.") +(defvar-keymap sh-mode-map + :doc "Keymap used in Shell-Script mode." + "C-c (" #'sh-function + "C-c C-w" #'sh-while + "C-c C-u" #'sh-until + "C-c C-t" #'sh-tmp-file + "C-c C-s" #'sh-select + "C-c C-r" #'sh-repeat + "C-c C-o" #'sh-while-getopts + "C-c C-l" #'sh-indexed-loop + "C-c C-i" #'sh-if + "C-c C-f" #'sh-for + "C-c C-c" #'sh-case + "C-c ?" #'smie-config-show-indent + "C-c =" #'smie-config-set-indent + "C-c <" #'smie-config-set-indent + "C-c >" #'smie-config-guess + "C-c C-\\" #'sh-backslash-region + + "C-c +" #'sh-add + "C-M-x" #'sh-execute-region + "C-c C-x" #'executable-interpret + "C-c C-n" #'sh-send-line-or-region-and-step + "C-c C-d" #'sh-cd-here + "C-c C-z" #'sh-show-shell + "C-c :" #'sh-set-shell + + " " #'backward-delete-char-untabify + " " #'sh-beginning-of-command + " " #'sh-end-of-command) (easy-menu-define sh-mode-menu sh-mode-map "Menu for Shell-Script mode." commit 4c479a1041c52c0a310f5c7a4017440a53c95582 Author: Stefan Kangas Date: Sun Dec 19 21:12:23 2021 +0100 ; * lisp/progmodes/sh-script.el (sh-mode-menu): Fix typos. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index c6b6f83471..a90fc425cf 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -440,7 +440,7 @@ This is buffer-local in every such buffer.") "Menu for Shell-Script mode." '("Sh-Script" ["Backslash region" sh-backslash-region - :help "Insert, align, or delete end-of-line backslashes on the lines in the region."] + :help "Insert, align, or delete end-of-line backslashes on the lines in the region"] ["Set shell type..." sh-set-shell :help "Set this buffer's shell to SHELL (a string)"] ["Execute script..." executable-interpret @@ -458,7 +458,7 @@ This is buffer-local in every such buffer.") ["Select Statement" sh-select :help "Insert a select statement "] ["Indexed Loop" sh-indexed-loop - :help "Insert an indexed loop from 1 to n."] + :help "Insert an indexed loop from 1 to n"] ["Options Loop" sh-while-getopts :help "Insert a while getopts loop."] ["While Loop" sh-while @@ -482,7 +482,7 @@ This is buffer-local in every such buffer.") ["Show indentation" smie-config-show-indent :help "Show the how the current line would be indented"] ["Learn buffer indentation" smie-config-guess - :help "Learn how to indent the buffer the way it currently is."])) + :help "Learn how to indent the buffer the way it currently is"])) (defvar sh-skeleton-pair-default-alist '((?\( _ ?\)) (?\)) (?\[ ?\s _ ?\s ?\]) (?\]) commit e34017fdbec8b794fcc3201f6b85ec09a964b555 Author: Lars Ingebrigtsen Date: Sun Dec 19 20:25:44 2021 +0100 Further tweaks to emoji person groups * lisp/international/emoji.el (emoji--score): Don't take the bit after the colon into consideration, like in "kiss: person, person, light skin tone, medium-light skin tone". diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 205a803a25..cd6684c3f6 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -361,7 +361,8 @@ the name is not known." derivations)))) (defun emoji--score (string) - (if (string-match-p "person\\|people" string) + (if (string-match-p "person\\|people" + (replace-regexp-in-string ":.*" "" string)) 0 1)) commit 6aac4caaff7c3217b917f3a08a114ab68f082740 Author: Lars Ingebrigtsen Date: Sun Dec 19 20:21:15 2021 +0100 Further tweaks to the emoji segmentation * lisp/international/emoji.el (emoji--parse-emoji-test): Ensure that we key off of the "person" variants, even if they come after the gendered variations (which is the case for a handful of glyphs). diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 4375a6344c..205a803a25 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -305,6 +305,7 @@ the name is not known." (setq emoji--names (make-hash-table :test #'equal)) (let ((derivations (make-hash-table :test #'equal)) (case-fold-search t) + (glyphs nil) group subgroup) (while (not (eobp)) (cond @@ -318,27 +319,40 @@ the name is not known." (let* ((codes (match-string 1)) (qualification (match-string 2)) (name (match-string 3)) - (base (emoji--base-name name derivations)) (glyph (mapconcat (lambda (code) (string (string-to-number code 16))) (split-string codes)))) - ;; Special-case flags. - (when (equal base "flag") - (setq base name)) - ;; Register all glyphs to that we can look up their names - ;; later. - (setf (gethash glyph emoji--names) name) - ;; For the interface, we only care about the fully qualified - ;; emojis. - (when (equal qualification "fully-qualified") - (when (equal base name) - (emoji--add-to-group group subgroup glyph)) - ;; Create mapping from base glyph name to name of - ;; derived glyphs. - (setf (gethash base derivations) - (nconc (gethash base derivations) (list glyph))))))) + (push (list name qualification group subgroup glyph) glyphs)))) (forward-line 1)) + ;; We sort the data so that the "person foo" variant comes + ;; first, so that that becomes the key. + (setq glyphs + (sort (nreverse glyphs) + (lambda (g1 g2) + (and (equal (nth 2 g1) (nth 2 g2)) + (equal (nth 3 g1) (nth 3 g2)) + (< (emoji--score (car g1)) + (emoji--score (car g2))))))) + ;; Get the derivations. + (cl-loop for (name qualification group subgroup glyph) in glyphs + for base = (emoji--base-name name derivations) + do + ;; Special-case flags. + (when (equal base "flag") + (setq base name)) + ;; Register all glyphs to that we can look up their names + ;; later. + (setf (gethash glyph emoji--names) name) + ;; For the interface, we only care about the fully qualified + ;; emojis. + (when (equal qualification "fully-qualified") + (when (equal base name) + (emoji--add-to-group group subgroup glyph)) + ;; Create mapping from base glyph name to name of + ;; derived glyphs. + (setf (gethash base derivations) + (nconc (gethash base derivations) (list glyph))))) ;; Finally create the mapping from the base glyphs to derived ones. (setq emoji--derived (make-hash-table :test #'equal)) (maphash (lambda (_k v) @@ -346,6 +360,11 @@ the name is not known." (cdr v))) derivations)))) +(defun emoji--score (string) + (if (string-match-p "person\\|people" string) + 0 + 1)) + (defun emoji--add-to-group (group subgroup glyph) ;; "People & Body" is very large; split it up. (cond commit df3fde6fa5366d02fb41d98962df0b2e1148d5b2 Author: Lars Ingebrigtsen Date: Sun Dec 19 19:53:04 2021 +0100 Further fixes for emojis in the "people" categories * lisp/international/emoji.el (emoji--base-name): Get more derived categories right. diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index d0e906848c..4375a6344c 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -412,18 +412,26 @@ the name is not known." (write-region (point-min) (point-max) file))) (defun emoji--base-name (name derivations) - (let* ((base (replace-regexp-in-string ":.*" "" name)) - (non-binary (replace-regexp-in-string "\\`\\(man\\|woman\\) " "" - base))) - ;; If we have (for instance) "person golfing", and we're adding - ;; "man golfing", make the latter a derivation of the former. - (cond - ((gethash (concat "person " non-binary) derivations) - (concat "person " non-binary)) - ((gethash non-binary derivations) - non-binary) - (t - base)))) + (let* ((base (replace-regexp-in-string ":.*" "" name))) + (catch 'found + ;; If we have (for instance) "person golfing", and we're adding + ;; "man golfing", make the latter a derivation of the former. + (let ((non-binary (replace-regexp-in-string + "\\`\\(m[ae]n\\|wom[ae]n\\) " "" base))) + (dolist (prefix '("person " "people " "")) + (let ((key (concat prefix non-binary))) + (when (gethash key derivations) + (throw 'found key))))) + ;; We can also have the gender at the end of the string, like + ;; "merman" and "pregnant woman". + (let ((non-binary (replace-regexp-in-string + "\\(m[ae]n\\|wom[ae]n\\|maid\\)\\'" "" base))) + (dolist (suffix '(" person" "person" "")) + (let ((key (concat non-binary suffix))) + (when (gethash key derivations) + (throw 'found key))))) + ;; Just return the base. + base))) (defun emoji--split-subgroup (subgroup) (let ((prefixes '("face" "hand" "person" "animal" "plant" commit 434c2cb2e9ac7705ee67a0a2493c29b1cbbcfa39 Author: Juri Linkov Date: Sun Dec 19 19:47:36 2021 +0200 * lisp/isearch.el: Don't display "Pending" for lax and toggle commands. * lisp/isearch.el (isearch-message-prefix): Display "Pending" only when isearch-adjusted is 't' (bug#52356). (isearch-define-mode-toggle): Set isearch-adjusted to 'toggle' instead of 't'. (isearch-search-fun-default): Set isearch-adjusted to 'lax' instead of 't'. diff --git a/lisp/isearch.el b/lisp/isearch.el index 8815cb4f2d..9e144ac272 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2063,7 +2063,7 @@ The command then executes BODY and updates the isearch prompt." #',function)) (setq isearch-regexp nil))) ,@body - (setq isearch-success t isearch-adjusted t) + (setq isearch-success t isearch-adjusted 'toggle) (isearch-update)) (define-key isearch-mode-map ,key #',command-name) ,@(when (and function (symbolp function)) @@ -3417,7 +3417,7 @@ the word mode." ;; If currently failing, display no ellipsis. (or isearch-success (setq ellipsis nil)) (let ((m (concat (if isearch-success "" "failing ") - (if isearch-adjusted "pending " "") + (if (eq isearch-adjusted t) "pending " "") (if (and isearch-wrapped (not isearch-wrap-function) (if isearch-forward @@ -3521,10 +3521,10 @@ Can be changed via `isearch-search-fun-function' for special needs." ;; (Bug#35802). (regexp (cond (isearch-regexp-function - (let ((lax (and (not bound) + (let ((lax (and (not bound) ; not lazy-highlight (isearch--lax-regexp-function-p)))) (when lax - (setq isearch-adjusted t)) + (setq isearch-adjusted 'lax)) (if (functionp isearch-regexp-function) (funcall isearch-regexp-function string lax) (word-search-regexp string lax)))) commit 16ed9fad2c86565493cedfabee8df0cf1e8b5cd3 (refs/remotes/origin/emacs-28) Author: Eli Zaretskii Date: Sun Dec 19 19:27:41 2021 +0200 ; * doc/lispref/frames.texi (Child Frames): Improve wording. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 756f2745d6..3aab940842 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3343,20 +3343,22 @@ are handy (@pxref{Window Parameters}). These allow to remove an unwanted mode line (when @code{drag-with-header-line} is chosen) and to remove mouse-sensitive areas which might interfere with frame dragging. - When the mouse cursor overshoots, it's easy to drag a frame out of the -screen area of its parent. Retrieving such a frame can be hairy once -the mouse button has been released. To prevent such a situation, it is -advisable to set the frame's @code{top-visible} or @code{bottom-visible} -parameter (@pxref{Mouse Dragging Parameters}). - - Set the @code{top-visible} parameter of a child frame to a number when -you intend to drag that frame via its header line. This inhibits -dragging the top edge of the child frame above the top edge of its -parent. Set the @code{bottom-visible} parameter to a number when you -intend to drag that frame via its mode line. This inhibits dragging the -bottom edge of the child frame beneath the bottom edge of its parent. -In either case, that number also specifies width and height (in pixels) -of the area of the child frame that remains visible during dragging. + When the user drags a frame with a mouse and overshoots, it's easy +to drag a frame out of the screen area of its parent. Retrieving such +a frame can be hairy once the mouse button has been released. To +prevent such a situation, it is advisable to set the frame's +@code{top-visible} or @code{bottom-visible} parameter (@pxref{Mouse +Dragging Parameters}). + + Set the @code{top-visible} parameter of a child frame to a number +when you intend to allow the user dragging that frame by its header +line. Setting @code{top-visible} to a number inhibits dragging the +top edge of the child frame above the top edge of its parent. Set the +@code{bottom-visible} parameter to a number when you intend to drag +that frame via its mode line; this inhibits dragging the bottom edge +of the child frame beneath the bottom edge of its parent. In either +case, that number also specifies width and height (in pixels) of the +area of the child frame that remains visible during dragging. When a child frame is used for displaying a buffer via @code{display-buffer-in-child-frame} (@pxref{Buffer Display Action commit f11b996a3c7fad35d9a1221d06abcd28242bd16c Author: Martin Rudalics Date: Sun Dec 19 17:59:15 2021 +0100 Clarify description of two mouse dragging parameters (Bug#52537) * doc/lispref/frames.texi (Child Frames): Clarify description of 'top-visible' and 'bottom-visible' parameters (Bug#52537). diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 56ac711813..756f2745d6 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3343,20 +3343,20 @@ are handy (@pxref{Window Parameters}). These allow to remove an unwanted mode line (when @code{drag-with-header-line} is chosen) and to remove mouse-sensitive areas which might interfere with frame dragging. - To avoid that dragging moves a frame completely out of its parent's -native frame, something which might happen when the mouse cursor -overshoots and makes the frame difficult to retrieve once the mouse -button has been released, it is advisable to set the frame's -@code{top-visible} or @code{bottom-visible} parameter correspondingly. - - The @code{top-visible} parameter specifies the number of pixels at the -top of the frame that always remain visible within the parent's native -frame during dragging and should be set when specifying a non-@code{nil} -@code{drag-with-header-line} parameter. The @code{bottom-visible} -parameter specifies the number of pixels at the bottom of the frame that -always remain visible within the parent's native frame during dragging -and should be preferred when specifying a non-@code{nil} -@code{drag-with-mode-line} parameter. + When the mouse cursor overshoots, it's easy to drag a frame out of the +screen area of its parent. Retrieving such a frame can be hairy once +the mouse button has been released. To prevent such a situation, it is +advisable to set the frame's @code{top-visible} or @code{bottom-visible} +parameter (@pxref{Mouse Dragging Parameters}). + + Set the @code{top-visible} parameter of a child frame to a number when +you intend to drag that frame via its header line. This inhibits +dragging the top edge of the child frame above the top edge of its +parent. Set the @code{bottom-visible} parameter to a number when you +intend to drag that frame via its mode line. This inhibits dragging the +bottom edge of the child frame beneath the bottom edge of its parent. +In either case, that number also specifies width and height (in pixels) +of the area of the child frame that remains visible during dragging. When a child frame is used for displaying a buffer via @code{display-buffer-in-child-frame} (@pxref{Buffer Display Action commit 0bc2900bbcb6acfdd1d9eba205dd0ebc67d62b65 Author: Eli Zaretskii Date: Sun Dec 19 18:50:48 2021 +0200 Move Rmail autoloads to the common loaddefs.el * lisp/mail/rmailsum.el: * lisp/mail/rmailsort.el: * lisp/mail/rmailmsc.el: * lisp/mail/rmailmm.el: * lisp/mail/rmailkwd.el: * lisp/mail/rmailedit.el: * lisp/mail/rmail.el: Remove generated-autoload-file setting and don't require rmail-loaddefs.el diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index afcb7f39bf..47fd28c18e 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -41,8 +41,6 @@ (require 'rfc2047) (require 'auth-source) -(require 'rmail-loaddefs) - (declare-function compilation--message->loc "compile" (cl-x) t) (declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset)) diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index fd24bdcecc..18859f2b28 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -484,8 +484,4 @@ HEADER-DIFF should be a return value from `rmail-edit-diff-headers'." (provide 'rmailedit) -;; Local Variables: -;; generated-autoload-file: "rmail-loaddefs.el" -;; End: - ;;; rmailedit.el ends here diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index d8fcc1c0a9..7efbfde27d 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -188,8 +188,4 @@ With prefix argument N moves forward N messages with these labels." (provide 'rmailkwd) -;; Local Variables: -;; generated-autoload-file: "rmail-loaddefs.el" -;; End: - ;;; rmailkwd.el ends here diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 66a1e9a4db..563ce9d0b8 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -1569,8 +1569,4 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'." (provide 'rmailmm) -;; Local Variables: -;; generated-autoload-file: "rmail-loaddefs.el" -;; End: - ;;; rmailmm.el ends here diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el index 673b2c5a7e..f5e89f8f17 100644 --- a/lisp/mail/rmailmsc.el +++ b/lisp/mail/rmailmsc.el @@ -54,8 +54,4 @@ This applies only to the current session." (setq rmail-inbox-list inbox-list))) (rmail-show-message-1 rmail-current-message)) -;; Local Variables: -;; generated-autoload-file: "rmail-loaddefs.el" -;; End: - ;;; rmailmsc.el ends here diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index 1669c8cd7b..8c790116a3 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -250,8 +250,4 @@ Numeric keys are sorted numerically, all others as strings." (provide 'rmailsort) -;; Local Variables: -;; generated-autoload-file: "rmail-loaddefs.el" -;; End: - ;;; rmailsort.el ends here diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 8fc3fc095c..ef172bc106 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -1877,8 +1877,4 @@ the summary is only showing a subset of messages." (provide 'rmailsum) -;; Local Variables: -;; generated-autoload-file: "rmail-loaddefs.el" -;; End: - ;;; rmailsum.el ends here commit f6959d05f4b9015ea79050053898b85a1af3ea91 Author: Lars Ingebrigtsen Date: Sun Dec 19 17:12:18 2021 +0100 Add some very rudimentary field-beginning/end tests diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index e83dd7c857..6b2eb32396 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -413,4 +413,17 @@ (translate-region-internal (point-min) (point-max) tt) (should (string-equal (buffer-string) "*"))))) +(ert-deftest find-fields () + (with-temp-buffer + (insert "foo" (propertize "bar" 'field 'bar) "zot") + (goto-char (point-min)) + (should (= (field-beginning) (point-min))) + (should (= (field-end) 4)) + (goto-char 5) + (should (= (field-beginning) 4)) + (should (= (field-end) 7)) + (goto-char 8) + (should (= (field-beginning) 7)) + (should (= (field-end) (point-max))))) + ;;; editfns-tests.el ends here commit c139d289df4c76807501c3e35b0d8f4bc8d511ce Author: Eli Zaretskii Date: Sun Dec 19 17:44:32 2021 +0200 ; Fix last change to filelock-tests.el * test/src/filelock-tests.el (filelock-tests-file-locked-p-spoiled) (filelock-tests-unlock-spoiled) (filelock-tests-kill-buffer-spoiled): Expect 'permission-denied' only on MS-Windows. diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index 2d682e2e78..24dd37e5a4 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -123,7 +123,9 @@ the case)." (filelock-tests--spoil-lock-file buffer-file-truename) (let ((err (should-error (file-locked-p (buffer-file-name))))) (should (equal (seq-subseq err 0 2) - '(permission-denied "Testing file lock"))))))) + (if (eq system-type 'windows-nt) + '(permission-denied "Testing file lock") + '(file-error "Testing file lock")))))))) (ert-deftest filelock-tests-unlock-spoiled () "Check that `unlock-buffer' fails if the lockfile is \"spoiled\"." @@ -144,8 +146,11 @@ the case)." (lambda (err) (push err errors)))) (unlock-buffer)) (should (consp errors)) - (should (equal '(permission-denied "Unlocking file") - (seq-subseq (car errors) 0 2))) + (should (equal + (if (eq system-type 'windows-nt) + '(permission-denied "Unlocking file") + '(file-error "Unlocking file")) + (seq-subseq (car errors) 0 2))) (should (equal (length errors) 1)))))) (ert-deftest filelock-tests-kill-buffer-spoiled () @@ -174,8 +179,11 @@ the case)." (lambda (err) (push err errors)))) (kill-buffer)) (should (consp errors)) - (should (equal '(permission-denied "Unlocking file") - (seq-subseq (car errors) 0 2))) + (should (equal + (if (eq system-type 'windows-nt) + '(permission-denied "Unlocking file") + '(file-error "Unlocking file")) + (seq-subseq (car errors) 0 2))) (should (equal (length errors) 1)))))) (provide 'filelock-tests) commit cc63704815ee4ae686a0cf86e12f7f2596dd22a3 Author: Eli Zaretskii Date: Sun Dec 19 17:29:40 2021 +0200 New error symbol 'permission-denied' * src/fileio.c (syms_of_fileio) : Define the symbol and its 'err-conditions' and 'error-message' properties. (get_file_errno_data): Return permission-denied on EACCES. * test/src/filelock-tests.el (filelock-tests-file-locked-p-spoiled) (filelock-tests-unlock-spoiled) (filelock-tests-kill-buffer-spoiled): Adapt the tests to the new error symbol. * doc/lispref/errors.texi (Standard Errors): * etc/NEWS: Document 'permission-denied' error. diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index f848218e26..9dd052c523 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -98,6 +98,10 @@ Lisp reader, not to file I/O@. @xref{Input Functions}. @item file-already-exists This is a subcategory of @code{file-error}. @xref{Writing to Files}. +@item permission-denied +This is a subcategory of @code{file-error}, which occurs when the OS +doesn't allow Emacs to access a file or a directory for some reason. + @item file-date-error This is a subcategory of @code{file-error}. It occurs when @code{copy-file} tries and fails to set the last-modification time of diff --git a/etc/NEWS b/etc/NEWS index 862621a4d5..24f3da8f96 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1186,6 +1186,12 @@ The events 'touchscreen-begin, 'touchscreen-update', and 'touchscreen-end' have been added to take better advantage of touch-capable display panels. ++++ +** New error symbol 'permission-denied'. +This is a subcategory of 'file-error', and is signaled when some file +operation fails because the OS doesn't allow Emacs to access a file or +a directory. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/src/fileio.c b/src/fileio.c index a0563ccba4..f802e4e418 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -195,7 +195,11 @@ get_file_errno_data (char const *string, Lisp_Object name, int errorno) if (errorno == EEXIST) return Fcons (Qfile_already_exists, errdata); else - return Fcons (errorno == ENOENT ? Qfile_missing : Qfile_error, + return Fcons (errorno == ENOENT + ? Qfile_missing + : (errorno == EACCES + ? Qpermission_denied + : Qfile_error), Fcons (build_string (string), errdata)); } @@ -6380,6 +6384,7 @@ syms_of_fileio (void) DEFSYM (Qfile_already_exists, "file-already-exists"); DEFSYM (Qfile_date_error, "file-date-error"); DEFSYM (Qfile_missing, "file-missing"); + DEFSYM (Qpermission_denied, "permission-denied"); DEFSYM (Qfile_notify_error, "file-notify-error"); DEFSYM (Qremote_file_error, "remote-file-error"); DEFSYM (Qexcl, "excl"); @@ -6438,6 +6443,11 @@ behaves as if file names were encoded in `utf-8'. */); Fput (Qfile_missing, Qerror_message, build_pure_c_string ("File is missing")); + Fput (Qpermission_denied, Qerror_conditions, + Fpurecopy (list3 (Qpermission_denied, Qfile_error, Qerror))); + Fput (Qpermission_denied, Qerror_message, + build_pure_c_string ("Cannot access file or directory")); + Fput (Qfile_notify_error, Qerror_conditions, Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror))); Fput (Qfile_notify_error, Qerror_message, diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index ba00167963..2d682e2e78 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -123,7 +123,7 @@ the case)." (filelock-tests--spoil-lock-file buffer-file-truename) (let ((err (should-error (file-locked-p (buffer-file-name))))) (should (equal (seq-subseq err 0 2) - '(file-error "Testing file lock"))))))) + '(permission-denied "Testing file lock"))))))) (ert-deftest filelock-tests-unlock-spoiled () "Check that `unlock-buffer' fails if the lockfile is \"spoiled\"." @@ -144,7 +144,7 @@ the case)." (lambda (err) (push err errors)))) (unlock-buffer)) (should (consp errors)) - (should (equal '(file-error "Unlocking file") + (should (equal '(permission-denied "Unlocking file") (seq-subseq (car errors) 0 2))) (should (equal (length errors) 1)))))) @@ -174,7 +174,7 @@ the case)." (lambda (err) (push err errors)))) (kill-buffer)) (should (consp errors)) - (should (equal '(file-error "Unlocking file") + (should (equal '(permission-denied "Unlocking file") (seq-subseq (car errors) 0 2))) (should (equal (length errors) 1)))))) commit 8f82a83caec9ad48a6d4abc4dc26bed67f0e89e3 Author: Stefan Kangas Date: Sun Dec 19 16:09:32 2021 +0100 Make bad-packages-alist obsolete * lisp/simple.el (bad-packages-alist, bad-package-check): Make obsolete. (Bug#52351) diff --git a/lisp/simple.el b/lisp/simple.el index 26c3ff575e..b217aeb49c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9790,24 +9790,7 @@ If it does not exist, create it and switch it to `messages-buffer-mode'." ;; versions together with bad values. This is therefore not as ;; flexible as it could be. See the thread: ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00300.html -(defconst bad-packages-alist - ;; Not sure exactly which semantic versions have problems. - ;; Definitely 2.0pre3, probably all 2.0pre's before this. - '((semantic semantic-version "\\`2\\.0pre[1-3]\\'" - "The version of `semantic' loaded does not work in Emacs 22. -It can cause constant high CPU load. -Upgrade to at least Semantic 2.0pre4 (distributed with CEDET 1.0pre4).") - ;; CUA-mode does not work with GNU Emacs version 22.1 and newer. - ;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode - ;; provided the `CUA-mode' feature. Since this is no longer true, - ;; we can warn the user if the `CUA-mode' feature is ever provided. - (CUA-mode t nil -"CUA-mode is now part of the standard GNU Emacs distribution, -so you can now enable CUA via the Options menu or by customizing `cua-mode'. - -You have loaded an older version of CUA-mode which does not work -correctly with this version of Emacs. You should remove the old -version and use the one distributed with Emacs.")) +(defconst bad-packages-alist nil "Alist of packages known to cause problems in this version of Emacs. Each element has the form (PACKAGE SYMBOL REGEXP STRING). PACKAGE is either a regular expression to match file names, or a @@ -9815,9 +9798,11 @@ symbol (a feature name), like for `with-eval-after-load'. SYMBOL is either the name of a string variable, or t. Upon loading PACKAGE, if SYMBOL is t or matches REGEXP, display a warning using STRING as the message.") +(make-obsolete-variable 'bad-packages-alist nil "29.1") (defun bad-package-check (package) "Run a check using the element from `bad-packages-alist' matching PACKAGE." + (declare (obsolete nil "29.1")) (condition-case nil (let* ((list (assoc package bad-packages-alist)) (symbol (nth 1 list))) @@ -9829,11 +9814,6 @@ warning using STRING as the message.") (display-warning package (nth 3 list) :warning))) (error nil))) -(dolist (elem bad-packages-alist) - (let ((pkg (car elem))) - (with-eval-after-load pkg - (bad-package-check pkg)))) - ;;; Generic dispatcher commands commit 22b8d6813217187e3121338b93deabe62add99c1 Author: Alan Mackenzie Date: Sun Dec 19 14:26:06 2021 +0000 CC Mode: Remove annoying background fontification. Should fix bug #52298 Partially revert the commits from 2021-10-24 - 2021-10-26, "CC Mode: Fontify "found types" which are recognized after being first scanned". This removes the background fontification which ran off of a 0.1s timer, but leaves the facility of normal fontification causing the fontification throughout the buffer of newly found types. * lisp/progmodes/cc-fonts.el (c-find-types-background) (c-type-finder-timer-func): Remove. * lisp/progmodes/cc-mode.el (c-type-finder-timer, c-inhibit-type-finder) (c-type-finder-pos, c-post-gc-hook): Remove. (c-leave-cc-mode-mode): Remove the manipulations of c-type-finder-timer and c-post-gc-hook. (c-basic-common-init): Remove the manipulations of c-type-finder-pos, c-type-finder-timer, and c-post-gc-hook. * lisp/progmodes/cc-vars.el (c-type-finder-time-slot) (c-type-finder-repeat-time, c-type-finder-chunk-size): Remove. * doc/misc/cc-mode.texi (Found Types): Remove. Amend some menu entries. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index a2ff572a3f..a388846fbf 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -284,7 +284,6 @@ Font Locking * Faces:: * Doc Comments:: * Wrong Comment Style:: -* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @@ -1857,7 +1856,6 @@ sections apply to the other languages. * Faces:: * Doc Comments:: * Wrong Comment Style:: -* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @end menu @@ -2164,60 +2162,6 @@ which aren't of the default style will be fontified with @code{font-lock-warning-face}. @end defvar -@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node Found Types -@comment node-name, next, previous, up -@section ``Found Type'' handling. -@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -In most languages handled by CC Mode, @dfn{found types} are recognized -as types by their context in the source code. These contrast with -types which are basic to a language or are declared as types (e.g. by -@code{typedef} in C). - -In earlier versions of @ccmode{}, when @code{jit-lock-mode} was -enabled in Emacs (which it is by default), found types would -frequently fail to get fontified properly. This happened when the -fontification functions scanned a use of the found type before -scanning the code which caused it to be recognized. - -From @ccmode{} version 5.36, a timer mechanism scans the entire buffer -for found types in the seconds immediately after starting the major -mode. When a found type gets recognized, all its occurrences in the -buffer get marked for (re)fontification. This scanning happens in -short time slices interleaved with other processing, such as keyboard -handling, so that the responsiveness of Emacs should be barely -affected. This mechanism can be disabled (see below). It is only -active when @code{jit-lock-mode} is also active. - -@defvar c-type-finder-time-slot -@vindex type-finder-time-slot (c-) -The approximate time in seconds that CC Mode spends in scanning source -code before relinquishing control to other Emacs activities. The -default value is 0.05. To disable the scanning mechanism, set this -variable to @code{nil}. -@end defvar - -@defvar c-type-finder-repeat-time -@vindex type-finder-repeat-time (c-) -The approximate frequency (in seconds) with which the scanning -mechanism is triggered. This time must be greater than -@code{c-type-finder-time-slot}. Its default value is 0.1. If a less -powerful machine becomes sluggish due to the scanning, increase the -value of @code{c-type-finder-repeat-time} to compensate. -@end defvar - -@defvar c-type-finder-chunk-size -@vindex type-finder-chunk-size (c-) -The approximate size (in characters) of the buffer chunk processed as -a unit before the scanning mechanism checks whether -@code{c-type-finder-time-slot} seconds have passed. The default value -is 1000. A too small value here will cause inefficiencies due to the -initialization which happens for each chunk, whereas a too large value -will cause the processing to consume an excessive proportion of the -@code{c-type-finder-repeat-time}. -@end defvar - @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Misc Font Locking @comment node-name, next, previous, up diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 967464ac14..846c25f45a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -93,14 +93,10 @@ (cc-bytecomp-defvar c-preprocessor-face-name) (cc-bytecomp-defvar c-reference-face-name) (cc-bytecomp-defvar c-block-comment-flag) -(cc-bytecomp-defvar c-type-finder-pos) -(cc-bytecomp-defvar c-inhibit-type-finder) -(cc-bytecomp-defvar c-type-finder-timer) (cc-bytecomp-defun c-fontify-recorded-types-and-refs) (cc-bytecomp-defun c-font-lock-declarators) (cc-bytecomp-defun c-font-lock-objc-method) (cc-bytecomp-defun c-font-lock-invalid-string) -(cc-bytecomp-defun c-before-context-fl-expand-region) (cc-bytecomp-defun c-font-lock-fontify-region) @@ -1603,175 +1599,6 @@ casts and declarations are fontified. Used on level 2 and higher." nil)))) -(defun c-find-types-background (start limit) - ;; Find any "found types" between START and LIMIT. Allow any such types to - ;; be entered into `c-found-types' by the action of `c-forward-name' or - ;; `c-forward-type' called from this function. This process also causes - ;; occurrences of the type to be prepared for fontification throughout the - ;; buffer. - ;; - ;; Return POINT at the end of the function. This should be at or after - ;; LIMIT, and not later than the next decl-spot after LIMIT. - ;; - ;; This function is called from the timer `c-type-finder-timer'. It may do - ;; hidden buffer changes. - (save-excursion - (save-restriction - (widen) - (goto-char start) - ;; If we're in a (possibly large) literal, skip over it. - (let ((lit-bounds (nth 2 (c-full-pp-to-literal (point))))) - (if lit-bounds - (goto-char (cdr lit-bounds)))) - (when (< (point) limit) - (let (;; o - 'decl if we're in an arglist containing declarations - ;; (but if `c-recognize-paren-inits' is set it might also be - ;; an initializer arglist); - ;; o - '<> if the arglist is of angle bracket type; - ;; o - 'arglist if it's some other arglist; - ;; o - nil, if not in an arglist at all. This includes the - ;; parenthesized condition which follows "if", "while", etc. - context - ;; A list of starting positions of possible type declarations, or of - ;; the typedef preceding one, if any. - last-cast-end - ;; The result from `c-forward-decl-or-cast-1'. - decl-or-cast - ;; The maximum of the end positions of all the checked type - ;; decl expressions in the successfully identified - ;; declarations. The position might be either before or - ;; after the syntactic whitespace following the last token - ;; in the type decl expression. - (max-type-decl-end 0) - ;; Same as `max-type-decl-*', but used when we're before - ;; `token-pos'. - (max-type-decl-end-before-token 0) - ) - (goto-char start) - (c-find-decl-spots - limit - c-decl-start-re - nil ; (eval c-maybe-decl-faces) - - (lambda (match-pos inside-macro &optional toplev) - ;; Note to maintainers: don't use `limit' inside this lambda form; - ;; c-find-decl-spots sometimes narrows to less than `limit'. - (if (and c-macro-with-semi-re - (looking-at c-macro-with-semi-re)) - ;; Don't do anything more if we're looking at something that - ;; can't start a declaration. - t - - ;; Set `context' and `c-restricted-<>-arglists'. Look for - ;; "<" for the sake of C++-style template arglists. - ;; "Ignore "(" when it's part of a control flow construct - ;; (e.g. "for ("). - (let ((got-context - (c-get-fontification-context - match-pos - (< match-pos (if inside-macro - max-type-decl-end-before-token - max-type-decl-end)) - toplev))) - (setq context (car got-context) - c-restricted-<>-arglists (cdr got-context))) - - ;; In QT, "more" is an irritating keyword that expands to nothing. - ;; We skip over it to prevent recognition of "more slots: " - ;; as a bitfield declaration. - (when (and (c-major-mode-is 'c++-mode) - (looking-at - (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) - (goto-char (match-end 1)) - (c-forward-syntactic-ws)) - - ;; Now analyze the construct. This analysis will cause - ;; `c-forward-name' and `c-forward-type' to call `c-add-type', - ;; triggering the desired recognition and fontification of - ;; these found types. - (when (not (eq context 'not-decl)) - (setq decl-or-cast - (c-forward-decl-or-cast-1 - match-pos context last-cast-end)) - - (cond - ((eq decl-or-cast 'cast) - ;; Save the position after the previous cast so we can feed - ;; it to `c-forward-decl-or-cast-1' in the next round. That - ;; helps it discover cast chains like "(a) (b) c". - (setq last-cast-end (point)) - nil) - (decl-or-cast - ;; We've found a declaration. - - ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' - ;; under the assumption that we're after the first type decl - ;; expression in the declaration now. That's not really true; - ;; we could also be after a parenthesized initializer - ;; expression in C++, but this is only used as a last resort - ;; to slant ambiguous expression/declarations, and overall - ;; it's worth the risk to occasionally fontify an expression - ;; as a declaration in an initializer expression compared to - ;; getting ambiguous things in normal function prototypes - ;; fontified as expressions. - (if inside-macro - (when (> (point) max-type-decl-end-before-token) - (setq max-type-decl-end-before-token (point))) - (when (> (point) max-type-decl-end) - (setq max-type-decl-end (point))))) - (t t)))))))) - (point)))) - -(defun c-type-finder-timer-func () - ;; A CC Mode idle timer function for finding "found types". It triggers - ;; every `c-type-finder-repeat-time' seconds and processes buffer chunks of - ;; size around `c-type-finder-chunk-size' characters, and runs for (a little - ;; over) `c-type-finder-time-slot' seconds. The types it finds are inserted - ;; into `c-found-types', and their occurrences throughout the buffer are - ;; prepared for fontification. - (when (and c-type-finder-time-slot - (boundp 'font-lock-support-mode) - (eq font-lock-support-mode 'jit-lock-mode)) - (if c-inhibit-type-finder ; No processing immediately after a GC operation. - (setq c-inhibit-type-finder nil) - (let* ((stop-time (+ (float-time) c-type-finder-time-slot)) - (buf-list (buffer-list))) - ;; One CC Mode buffer needing processing each time around this loop. - (while (and buf-list - (< (float-time) stop-time)) - ;; Cdr through BUF-LIST to find the next buffer needing processing. - (while (and buf-list - (not (with-current-buffer (car buf-list) c-type-finder-pos))) - (setq buf-list (cdr buf-list))) - (when buf-list - (with-current-buffer (car buf-list) - ;; (message "%s" (current-buffer)) ; Useful diagnostic. - (save-restriction - (widen) - ;; Process one `c-type-finder-chunk-size' chunk each time - ;; around this loop. - (while (and c-type-finder-pos - (< (float-time) stop-time)) - ;; Process one chunk per iteration. - (save-match-data - (c-save-buffer-state - (case-fold-search - (beg (marker-position c-type-finder-pos)) - (end (min (+ beg c-type-finder-chunk-size) (point-max))) - (region (c-before-context-fl-expand-region beg end))) - (setq beg (car region) - end (cdr region)) - (setq beg (max (c-find-types-background beg end) end)) - (move-marker c-type-finder-pos - (if (save-excursion (goto-char beg) (eobp)) - nil - beg)) - (when (not (marker-position c-type-finder-pos)) - (setq c-type-finder-pos nil)))))))))))) - ;; Set the timer to run again. - (setq c-type-finder-timer - (run-at-time c-type-finder-repeat-time nil #'c-type-finder-timer-func))) - (defun c-font-lock-enum-body (limit) ;; Fontify the identifiers of each enum we find by searching forward. ;; diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index f9435c9cee..ae2ca39766 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -129,16 +129,6 @@ ; ' (require 'cc-fonts) ;) -(defvar c-type-finder-timer nil) -;; The variable which holds the repeating idle timer which triggers off the -;; background type finding search. - -(defvar c-inhibit-type-finder nil) -;; When non-nil (set by `c-post-gc-hook') don't perform the type finding -;; activities the next time `c-type-finder-timer' triggers. This ensures -;; keyboard/mouse input will be dealt with when garbage collection is taking a -;; large portion of CPU time. - ;; The following three really belong to cc-fonts.el, but they are required ;; even when cc-fonts.el hasn't been loaded (this happens in XEmacs when ;; font-lock-mode is nil). @@ -197,10 +187,7 @@ c-buffer-is-cc-mode)) (throw 'found nil))) (remove-hook 'post-command-hook 'c-post-command) - (remove-hook 'post-gc-hook 'c-post-gc-hook) - (and c-type-finder-timer - (progn (cancel-timer c-type-finder-timer) - (setq c-type-finder-timer nil))))) + (remove-hook 'post-gc-hook 'c-post-gc-hook))) (c-save-buffer-state () (c-clear-char-properties (point-min) (point-max) 'category) (c-clear-char-properties (point-min) (point-max) 'syntax-table) @@ -596,12 +583,6 @@ preferably use the `c-mode-menu' language constant directly." ;; currently no such text property. (make-variable-buffer-local 'c-max-syn-tab-mkr) -;; `c-type-finder-pos' is a marker marking the current place in a CC Mode -;; buffer which is due to be searched next for "found types", or nil if the -;; searching is complete. -(defvar c-type-finder-pos nil) -(make-variable-buffer-local 'c-type-finder-pos) - (defun c-basic-common-init (mode default-style) "Initialize the syntax handling routines and the line breaking/filling code. Intended to be used by other packages that embed CC Mode. @@ -774,17 +755,6 @@ that requires a literal mode spec at compile time." ;; c-after-font-lock-init. (add-hook 'after-change-functions 'c-after-change nil t) (add-hook 'post-command-hook 'c-post-command) - (setq c-type-finder-pos - (save-restriction - (widen) - (move-marker (make-marker) (point-min)))) - - ;; Install the functionality for seeking "found types" at mode startup: - (or c-type-finder-timer - (setq c-type-finder-timer - (run-at-time - c-type-finder-repeat-time nil #'c-type-finder-timer-func))) - (add-hook 'post-gc-hook #'c-post-gc-hook) (when (boundp 'font-lock-extend-after-change-region-function) (set (make-local-variable 'font-lock-extend-after-change-region-function) @@ -2028,9 +1998,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") c-new-id-end nil c-new-id-is-type nil))) -(defun c-post-gc-hook (&optional _stats) ; For XEmacs. - (setq c-inhibit-type-finder t)) - (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls ;; the language dependent `c-get-state-before-change-functions'. It is diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 40a43c32ed..83fd3da7c1 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1524,39 +1524,6 @@ working due to this change." :type 'boolean :group 'c) -(defcustom c-type-finder-time-slot 0.05 - "The length in seconds of a background type search time slot. - -In CC Mode modes, \"found types\" wouldn't always get cleanly -fontified without the background searching for them which happens -in the seconds after starting Emacs or initializing the major -mode. - -This background searching can be disabled by setting this option -to nil." - :type '(choice (const :tag "disabled" nil) - number) - :group 'c) - -(defcustom c-type-finder-repeat-time 0.1 - "The interval, in seconds, at which background type searches occur. - -This interval must be greater than `c-type-finder-time-slot'." - :type 'number - :group 'c) - -(defcustom c-type-finder-chunk-size 1000 - "The size, in characters, of a chunk for background type search. - -Chunks of this size are searched atomically for \"found types\" -just after starting Emacs or initializing the major mode. - -This chunk size is a balance between efficiency (with larger -values) and responsiveness of the keyboard (with smaller values). -See also `c-type-finder-time-slot'." - :type 'integer - :group 'c) - (define-widget 'c-extra-types-widget 'radio "Internal CC Mode widget for the `*-font-lock-extra-types' variables." :args '((const :tag "none" nil) commit 09af054dabd163125571ac470834cdb6de5ba672 Author: Stefan Kangas Date: Sun Dec 19 15:26:36 2021 +0100 Silence "initform needs quoting" warning in tests * test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el (persist-simple): * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (class-a) (class-c, inittest, slotattr-base, slotattr-ok) (slotattr-class-base, slotattr-class-ok, IT): Silence byte-compiler warnings about "ambiguous initform needs quoting". diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el index fd044ff373..d1183b81c6 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el @@ -99,7 +99,7 @@ This is usually a symbol that starts with `:'." (defclass persist-simple (eieio-persistent) ((slot1 :initarg :slot1 :type symbol - :initform moose) + :initform 'moose) (slot2 :initarg :slot2 :initform "foo") (slot3 :initform 2)) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 1595d1a084..25b36c0f1c 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -40,10 +40,10 @@ ;; Set up some test classes (defclass class-a () ((water :initarg :water - :initform h20 + :initform 'h20 :type symbol :documentation "Detail about water.") - (classslot :initform penguin + (classslot :initform 'penguin :type symbol :documentation "A class allocated slot." :allocation :class) @@ -68,7 +68,7 @@ (defclass class-c () ((slot-1 :initarg :moose - :initform moose + :initform 'moose :type symbol :allocation :instance :documentation "First slot testing slot arguments." @@ -87,7 +87,7 @@ :accessor get-slot-2 :protection :private) (slot-3 :initarg :emu - :initform emu + :initform 'emu :type symbol :allocation :class :documentation "Third slot test class allocated accessor" @@ -519,7 +519,7 @@ METHOD is the method that was attempting to be called." (defclass inittest nil ((staticval :initform 1) - (symval :initform eieio-test-permuting-value) + (symval :initform 'eieio-test-permuting-value) (evalval :initform (symbol-value 'eieio-test-permuting-value)) (evalnow :initform (symbol-value 'eieio-test-permuting-value) :allocation :class) @@ -763,7 +763,7 @@ Do not override for `prot-2'." (should (eq (oref eitest-II3 slot3) 'penguin))) (defclass slotattr-base () - ((initform :initform init) + ((initform :initform 'init) (type :type list) (initarg :initarg :initarg) (protection :protection :private) @@ -778,7 +778,7 @@ Do not override for `prot-2'." Subclasses to override slot attributes.") (defclass slotattr-ok (slotattr-base) - ((initform :initform no-init) + ((initform :initform 'no-init) (initarg :initarg :initblarg) (custom :custom string :label "One String" @@ -814,7 +814,7 @@ Subclasses to override slot attributes.") (defclass slotattr-class-base () ((initform :allocation :class - :initform init) + :initform 'init) (type :allocation :class :type list) (initarg :allocation :class @@ -833,7 +833,7 @@ Subclasses to override slot attributes.") Subclasses to override slot attributes.") (defclass slotattr-class-ok (slotattr-class-base) - ((initform :initform no-init) + ((initform :initform 'no-init) (initarg :initarg :initblarg) (custom :custom string :label "One String" @@ -895,7 +895,7 @@ Subclasses to override slot attributes.") (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1)))) (defclass IT (eieio-instance-tracker) - ((tracking-symbol :initform IT-list) + ((tracking-symbol :initform 'IT-list) (slot1 :initform 'die)) "Instance Tracker test object.") commit bc13902d3a069089792a65129efa6ed3176cac60 Merge: 4de46e6872 8535861430 Author: Michael Albinus Date: Sun Dec 19 15:21:26 2021 +0100 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 4de46e6872d31c151c13e3fde97b43902cb06588 Author: Michael Albinus Date: Sun Dec 19 15:21:06 2021 +0100 Fix timeout problem in autorevert-tests.el * test/lisp/autorevert-tests.el (auto-revert-test05-global-notify): Remove debug message. Increase timeout. diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index b31f0a9afc..2508b6a499 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -281,9 +281,9 @@ This expects `auto-revert--messages' to be bound by (ert-deftest auto-revert-test02-auto-revert-deleted-file () "Check autorevert for a deleted file." ;; Repeated unpredictable failures, bug#32645. - ;; Unlikely to be hydra-specific? - ; (skip-unless (not (getenv "EMACS_HYDRA_CI"))) :tags '(:unstable) + ;; Unlikely to be hydra-specific? + ;; (skip-unless (not (getenv "EMACS_HYDRA_CI"))) (with-auto-revert-test (ert-with-temp-file tmpfile (let (;; Try to catch bug#32645. @@ -484,8 +484,6 @@ This expects `auto-revert--messages' to be bound by (ert-with-temp-file file-3 (let* ((auto-revert-use-notify t) (auto-revert-avoid-polling t) - (auto-revert-debug (getenv "EMACS_EMBA_CI")) - (file-notify-debug (getenv "EMACS_EMBA_CI")) (was-in-global-auto-revert-mode global-auto-revert-mode) (file-2b (concat file-2 "-b")) require-final-newline buf-1 buf-2 buf-3) @@ -531,28 +529,16 @@ This expects `auto-revert--messages' to be bound by (should (equal (auto-revert-test--buffer-string buf-3) "3-a")) ;; Delete a visited file, and re-create it with new contents. - (when auto-revert-debug (message "Hallo0")) (delete-file file-1) - (when auto-revert-debug (message "Hallo1")) (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) - (when auto-revert-debug (message "Hallo2")) (auto-revert-test--write-file "1-b" file-1) - (when auto-revert-debug (message "Hallo3")) + ;; Since the file is deleted, it needs at least + ;; `autorevert-interval' to recognize the new file, + ;; while polling. So increase the timeout. (auto-revert-test--wait-for-buffer-text - buf-1 "1-b" (auto-revert--timeout)) - ;; On emba, `buf-1' is a killed buffer. - (when auto-revert-debug - (message - "Hallo4 %s %s %s %s %s %s %s" - buf-1 (buffer-name buf-1) (buffer-live-p buf-1) - file-1 (get-file-buffer file-1) - (buffer-name (get-file-buffer file-1)) - (buffer-live-p (get-file-buffer file-1))) - (with-current-buffer buf-1 - (message "Hallo5\n%s" (buffer-local-variables)))) + buf-1 "1-b" (* 2 (auto-revert--timeout))) (should (buffer-local-value 'auto-revert-notify-watch-descriptor buf-1)) - (when auto-revert-debug (message "Hallo6")) ;; Write a buffer to a new file, then modify the new file on disk. (with-current-buffer buf-2 commit 8535861430fc0ce82da73e01063ae11c85c65267 Author: Kévin Le Gouguec Date: Sun Dec 19 14:58:41 2021 +0100 Enable webp support in PGTK builds, too * configure.ac (HAVE_WEBP): Enable webp in PGTK builds, too. diff --git a/configure.ac b/configure.ac index 2e7ea2bd6f..d1a433a502 100644 --- a/configure.ac +++ b/configure.ac @@ -2315,6 +2315,8 @@ dnl use the toolkit if we have gtk, or X11R5 or newer. term_header=pgtkterm.h with_gtk3=yes USE_X_TOOLKIT=none + HAVE_PGTK=yes + AC_DEFINE([HAVE_PGTK], 1, [Define to 1 if you have pure Gtk+-3.]) ;; haiku ) term_header=haikuterm.h @@ -2677,7 +2679,7 @@ HAVE_WEBP=no if test "${with_webp}" != "no"; then if test "${HAVE_X11}" = "yes" || test "${opsys}" = "mingw32" \ || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes" \ - || test "${HAVE_BE_APP}" = "yes"; then + || test "${HAVE_BE_APP}" = "yes" || test "${HAVE_PGTK}" = "yes"; then WEBP_REQUIRED=0.6.0 WEBP_MODULE="libwebp >= $WEBP_REQUIRED" @@ -2950,8 +2952,6 @@ PGTK_LIBS= if test "$window_system" = "pgtk"; then PGTK_OBJ="pgtkfns.o pgtkterm.o pgtkselect.o pgtkmenu.o pgtkim.o xsettings.o" PGTK_LIBS="$GTK_LIBS" - HAVE_PGTK=yes - AC_DEFINE([HAVE_PGTK], 1, [Define to 1 if you have pure Gtk+-3.]) fi AC_SUBST(PGTK_OBJ) AC_SUBST(PGTK_LIBS) commit ec692470bdbd9f673e925bae1c96ad066fb0295a Author: Eli Zaretskii Date: Sun Dec 19 15:48:30 2021 +0200 Fix last change in 'handle_display_prop' * src/xdisp.c (handle_display_prop): Pass the window's buffer to 'display_min_width' and to 'handle_display_spec'. (Bug#52385) diff --git a/src/xdisp.c b/src/xdisp.c index 3a1bc1613f..0c35d24c26 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5209,9 +5209,8 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) return Qnil; } -static -Lisp_Object get_display_property (ptrdiff_t bufpos, Lisp_Object prop, - Lisp_Object object) +static Lisp_Object +get_display_property (ptrdiff_t bufpos, Lisp_Object prop, Lisp_Object object) { return find_display_property (Fget_text_property (make_fixnum (bufpos), Qdisplay, object), @@ -5364,6 +5363,10 @@ handle_display_prop (struct it *it) propval = get_char_property_and_overlay (make_fixnum (position->charpos), Qdisplay, object, &overlay); + /* Rest of the code must have OBJECT be either a string or a buffer. */ + if (!STRINGP (it->string)) + object = it->w->contents; + /* Handle min-width ends. */ if (!NILP (it->min_width_property) && NILP (find_display_property (propval, Qmin_width))) @@ -5374,9 +5377,6 @@ handle_display_prop (struct it *it) /* Now OVERLAY is the overlay that gave us this property, or nil if it was a text property. */ - if (!STRINGP (it->string)) - object = it->w->contents; - display_replaced = handle_display_spec (it, propval, object, overlay, position, bufpos, FRAME_WINDOW_P (it->f)); commit 9ef9d0c697c663a5e0b2d183a9447213fc1742f4 Author: Stefan Kangas Date: Sun Dec 19 14:45:55 2021 +0100 Silence "Unknown slot" warnings in tests * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el: * test/lisp/net/ntlm-tests.el: Silence byte-compiler. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 599d7900c3..1595d1a084 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -31,6 +31,11 @@ (eval-when-compile (require 'cl-lib)) +;; Silence byte-compiler. +(eval-when-compile + (dolist (slot '(:a :b ooga-booga :derived-value missing-slot)) + (cl-pushnew slot eieio--known-slot-names))) + ;;; Code: ;; Set up some test classes (defclass class-a () diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index 2420b3b48a..7b89e6b078 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -227,6 +227,8 @@ This string will be returned from the NTLM server to the NTLM client." ;; Silence some byte-compiler warnings that occur when ;; web-server/web-server.el is not found. +(eval-when-compile (cl-pushnew 'headers eieio--known-slot-names) + (cl-pushnew 'process eieio--known-slot-names)) (declare-function ws-send nil) (declare-function ws-parse-request nil) (declare-function ws-start nil) commit d9d38059d193699c2ae6cdf69341f5aa62e87781 Author: Daniel Mendler Date: Sun Dec 19 14:21:50 2021 +0100 Add a new elp-restore-package command * lisp/emacs-lisp/elp.el (elp-restore-package): New command (bug#52457). diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index dce8478d2e..fdd0ad6666 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -298,6 +298,14 @@ For example, to instrument all ELP functions, do the following: 'intern (all-completions prefix obarray 'elp-profilable-p)))) +(defun elp-restore-package (prefix) + "Remove instrumentation from functions with names starting with PREFIX." + (interactive "SPrefix: ") + (elp-restore-list + (mapcar #'intern + (all-completions (symbol-name prefix) + obarray 'elp-profilable-p)))) + (defun elp-restore-list (&optional list) "Restore the original definitions for all functions in `elp-function-list'. Use optional LIST if provided instead." commit 25d80456084e25c6d8b6cdcac21b2122f4ad26f0 Author: Lars Ingebrigtsen Date: Sun Dec 19 14:20:15 2021 +0100 Fix elp-*-list interactive specs * lisp/emacs-lisp/elp.el (elp-reset-list): (elp-restore-list): Fix the interactive specs (bug#52457). diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index fde7947a27..dce8478d2e 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -301,7 +301,7 @@ For example, to instrument all ELP functions, do the following: (defun elp-restore-list (&optional list) "Restore the original definitions for all functions in `elp-function-list'. Use optional LIST if provided instead." - (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!? + (interactive) (mapcar #'elp-restore-function (or list elp-function-list))) (defun elp-restore-all () @@ -323,7 +323,7 @@ Use optional LIST if provided instead." (defun elp-reset-list (&optional list) "Reset the profiling information for all functions in `elp-function-list'. Use optional LIST if provided instead." - (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!? + (interactive) (let ((list (or list elp-function-list))) (mapcar 'elp-reset-function list))) commit d745f4b6a0944778c495cd13e11fe096a9bd56f7 Merge: 7904cae492 5f25852e91 Author: Stefan Kangas Date: Sun Dec 19 14:02:30 2021 +0100 Merge from origin/emacs-28 5f25852e91 Update to Org 9.5.1-31-ga18849 commit 7904cae492062ac70ae1539be5b21c5274dcdf46 Author: Lars Ingebrigtsen Date: Sun Dec 19 13:44:21 2021 +0100 Rework how shr sets targets to make it more reliable * lisp/net/eww.el (eww-display-html): The target is now a list. * lisp/net/shr.el (shr--link-targets): New variable. (shr-insert-document): Set the targets. (shr-descend): Save targets and apply them later. (shr-ensure-paragraph): Remove hack to avoid filling from removing targets. (shr-tag-a): Save targets for later. (shr-render-td-1): Bind and set targets (bug#52512). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 0c66cf3a0d..8930eb427d 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -710,7 +710,7 @@ The renaming scheme is performed in accordance with (shr-target-id (goto-char (point-min)) (let ((match (text-property-search-forward - 'shr-target-id shr-target-id t))) + 'shr-target-id shr-target-id #'member))) (when match (goto-char (prop-match-beginning match))))) (t diff --git a/lisp/net/shr.el b/lisp/net/shr.el index c18d69b592..44fb5ec6e9 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -262,6 +262,7 @@ and other things: (defvar shr-target-id nil "Target fragment identifier anchor.") +(defvar shr--link-targets nil) (defvar-keymap shr-map "a" #'shr-show-alt-text @@ -354,6 +355,7 @@ DOM should be a parse tree as generated by (* shr-width (frame-char-width))) (shr--window-width))) (max-specpdl-size max-specpdl-size) + (shr--link-targets nil) ;; `bidi-display-reordering' is supposed to be only used for ;; debugging purposes, but Shr's naïve filling algorithm ;; cannot cope with the complexity of RTL text in an LTR @@ -377,9 +379,22 @@ DOM should be a parse tree as generated by (shr-descend dom) (shr-fill-lines start (point)) (shr--remove-blank-lines-at-the-end start (point)) + (shr--set-target-ids shr--link-targets) (when shr-warning (message "%s" shr-warning)))) +(defun shr--set-target-ids (ids) + ;; If the buffer is empty, there's no point in setting targets. + (unless (zerop (buffer-size)) + ;; We may have several targets in the same place (if you have + ;; several things after one another). So group + ;; them by position. + (dolist (group (seq-group-by #'cdr ids)) + (let ((point (min (1- (point-max)) (car group)))) + (put-text-property point (1+ point) + 'shr-target-id + (mapcar #'car (cdr group))))))) + (defun shr--remove-blank-lines-at-the-end (start end) (save-restriction (save-excursion @@ -614,16 +629,8 @@ size, and full-buffer size." (funcall function dom)) (t (shr-generic dom))) - (when-let* ((id (dom-attr dom 'id))) - ;; If the element was empty, we don't have anything to put the - ;; anchor on. So just insert a dummy character. - (when (= start (point)) - (if (not (bolp)) - (insert ? ) - (insert ? ) - (shr-mark-fill start)) - (put-text-property (1- (point)) (point) 'display "")) - (put-text-property (1- (point)) (point) 'shr-target-id id)) + (when-let ((id (dom-attr dom 'id))) + (push (cons id (point)) shr--link-targets)) ;; If style is set, then this node has set the color. (when style (shr-colorize-region @@ -893,22 +900,6 @@ size, and full-buffer size." (looking-at " *$"))) ;; We're already at a new paragraph; do nothing. ) - ((and (not (bolp)) - (save-excursion - (beginning-of-line) - (looking-at " *$")) - (save-excursion - (forward-line -1) - (looking-at " *$")) - ;; Check all chars on the current line and see whether - ;; they're all placeholders. - (cl-loop for pos from (line-beginning-position) upto (1- (point)) - unless (get-text-property pos 'shr-target-id) - return nil - finally return t)) - ;; We have some invisible markers from
; - ;; do nothing. - ) ((and prefix (= prefix (- (point) (line-beginning-position)))) ;; Do nothing; we're at the start of a
  • . @@ -1472,13 +1463,9 @@ ones, in case fg and bg are nil." (start (point)) shr-start) (shr-generic dom) - (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'. - (dom-attr dom 'name)))) ; Obsolete since HTML5. - ;; We have an empty element, so just insert... something. - (when (= start (point)) - (insert ?\s) - (put-text-property (1- (point)) (point) 'display "")) - (put-text-property start (1+ start) 'shr-target-id id)) + (when-let* ((id (and (not (dom-attr dom 'id)) ; Handled by `shr-descend'. + (dom-attr dom 'name)))) ; Obsolete since HTML5. + (push (cons id (point)) shr--link-targets)) (when url (shr-urlify (or shr-start start) (shr-expand-url url) title)))) @@ -2470,6 +2457,7 @@ flags that control whether to collect or render objects." (style (dom-attr dom 'style)) (shr-stylesheet shr-stylesheet) (max-width 0) + (shr--link-targets nil) natural-width) (when style (setq style (and (string-search "color" style) @@ -2511,6 +2499,7 @@ flags that control whether to collect or render objects." (end-of-line) (point))) (goto-char (point-min)) + (shr--set-target-ids shr--link-targets) (list max-width natural-width (count-lines (point-min) (point-max)) commit ae289486d039a443f74420f091a674a19ec9f378 Author: Lars Ingebrigtsen Date: Sun Dec 19 13:02:53 2021 +0100 Fix prompt in `sql-sqlite' * lisp/progmodes/sql.el (sql-get-login): Fix the Database: prompt (bug#52546). diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index f5888a0ce7..9e40fbd6ef 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3318,7 +3318,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist)) ('database - (sql-get-login-ext 'sql-database "Database" + (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist)) ('port commit 9051a93747002c08ddae8e391a9b29a08d118588 Author: Lars Ingebrigtsen Date: Sun Dec 19 12:46:01 2021 +0100 Fix indexing gendered emoji forms that have "person" base forms * lisp/international/emoji.el (emoji--base-name): Index man/woman on the generic form we have read already (bug#52580). diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 1202571b32..d0e906848c 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -417,10 +417,13 @@ the name is not known." base))) ;; If we have (for instance) "person golfing", and we're adding ;; "man golfing", make the latter a derivation of the former. - (if (or (gethash (concat "person " non-binary) derivations) - (gethash non-binary derivations)) - non-binary - base))) + (cond + ((gethash (concat "person " non-binary) derivations) + (concat "person " non-binary)) + ((gethash non-binary derivations) + non-binary) + (t + base)))) (defun emoji--split-subgroup (subgroup) (let ((prefixes '("face" "hand" "person" "animal" "plant" commit 276fd481767ad980b4896ecb12a28c47d8a2c749 Author: LdBeth Date: Sun Dec 19 12:26:15 2021 +0100 Add a shr-allowed-images user option * lisp/net/shr.el (shr-allowed-images): New variable (bug#52594). (shr-image-is-blocked): New function to use it. (shr-tag-img): Use it. * doc/misc/eww.texi (Advanced): Document it. Copyright-paperwork-exempt: yes diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index ebfdaf546e..e41aa8d886 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -305,6 +305,7 @@ state the directionality. @vindex shr-max-image-proportion @vindex shr-blocked-images +@vindex shr-allowed-images @cindex Image Display Loading random images from the web can be problematic due to their size or content. By customizing @code{shr-max-image-proportion} you @@ -312,7 +313,9 @@ can set the maximal image proportion in relation to the window they are displayed in. E.g., 0.7 means an image is allowed to take up 70% of the width and height. If Emacs supports image scaling (ImageMagick support required) then larger images are scaled down. You can block -specific images completely by customizing @code{shr-blocked-images}. +specific images completely by customizing @code{shr-blocked-images}, +or, if you want to only allow some specific images, customize +@code{shr-allowed-images}. @vindex shr-inhibit-images You can control image display by customizing diff --git a/etc/NEWS b/etc/NEWS index b50e7e5db0..862621a4d5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -409,6 +409,11 @@ It narrows to the current node. ** eww/shr ++++ +*** New user option 'shr-allowed-images'. +This complements 'shr-blocked-images', but allows specifying just the +allowed images. + +++ *** New user option 'shr-use-xwidgets-for-media'. If non-nil (and Emacs has been built with support for xwidgets), diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 5f31f03430..c18d69b592 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -57,8 +57,15 @@ fit these criteria." :version "24.1" :type 'float) +(defcustom shr-allowed-images nil + "If non-nil, only images that match this regexp are displayed. +If nil, all URLs are allowed. Also see `shr-blocked-images'." + :version "29.1" + :type '(choice (const nil) regexp)) + (defcustom shr-blocked-images nil - "Images that have URLs matching this regexp will be blocked." + "Images that have URLs matching this regexp will be blocked. +If nil, no images are blocked. Also see `shr-allowed-images'." :version "24.1" :type '(choice (const nil) regexp)) @@ -552,6 +559,12 @@ size, and full-buffer size." (shr-insert sub) (shr-descend sub)))) +(defun shr-image-blocked-p (url) + (or (and shr-blocked-images + (string-match shr-blocked-images url)) + (and shr-allowed-images + (not (string-match shr-allowed-images url))))) + (defun shr-indirect-call (tag-name dom &rest args) (let ((function (intern (concat "shr-tag-" (symbol-name tag-name)) obarray)) ;; Allow other packages to override (or provide) rendering @@ -1165,7 +1178,7 @@ Return a string with image data." ;; SVG images may contain references to further images that we may ;; want to block. So special-case these by parsing the XML data ;; and remove anything that looks like a blocked bit. - (when (and shr-blocked-images + (when (and (or shr-allowed-images shr-blocked-images) (eq content-type 'image/svg+xml)) (setq data ;; Note that libxml2 doesn't parse everything perfectly, @@ -1344,8 +1357,7 @@ ones, in case fg and bg are nil." ((or (not (eq (dom-tag elem) 'image)) ;; Filter out blocked elements inside the SVG image. (not (setq url (dom-attr elem ':xlink:href))) - (not shr-blocked-images) - (not (string-match-p shr-blocked-images url))) + (not (shr-image-blocked-p url))) (insert " ") (shr-dom-print elem))))) (insert (format "" (dom-tag dom)))) @@ -1651,8 +1663,7 @@ The preference is a float determined from `shr-prefer-media-type'." (funcall shr-put-image-function image alt (list :width width :height height))))) ((or shr-inhibit-images - (and shr-blocked-images - (string-match-p shr-blocked-images url))) + (shr-image-blocked-p url)) (setq shr-start (point)) (shr-insert alt)) ((and (not shr-ignore-cache) commit 7fd900ff3a780a83422241552902cfe3c2ecb1d8 Author: miha Date: Sun Dec 19 12:02:11 2021 +0100 Fix prompt colors in comint-snapshot-last-prompt * lisp/comint.el (comint-snapshot-last-prompt): Fix colorization of the prompt (bug#11883). diff --git a/lisp/comint.el b/lisp/comint.el index 5f99f560cf..3decb80ff0 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2036,7 +2036,7 @@ the start, the cdr to the end of the last prompt recognized.") Freezes the `font-lock-face' text property in place." (when comint-last-prompt (with-silent-modifications - (font-lock-prepend-text-property + (font-lock-append-text-property (car comint-last-prompt) (cdr comint-last-prompt) 'font-lock-face 'comint-highlight-prompt)) commit 6f2351a4864fa5dd2c1a6cd070a2499278038958 Author: Lars Ingebrigtsen Date: Sun Dec 19 11:49:46 2021 +0100 Move rmail-related functions from gnus-util.el to gnus-rmail.el * lisp/gnus/gnus-rmail.el: New file with rmail-related functions moved from gnus-util.el. * lisp/gnus/gnus-util.el: Move the rmail-related functions to its own file. This avoids loading rmail.el when something requires gnus-util.el. diff --git a/lisp/gnus/gnus-rmail.el b/lisp/gnus/gnus-rmail.el new file mode 100644 index 0000000000..f9dcc286a6 --- /dev/null +++ b/lisp/gnus/gnus-rmail.el @@ -0,0 +1,142 @@ +;;; gnus-rmail.el --- Saving to rmail/babyl files -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +;;; Functions for saving to babyl/mail files. + +(require 'rmail) +(require 'rmailsum) +(require 'nnmail) + +(defun gnus-output-to-rmail (filename &optional ask) + "Append the current article to an Rmail file named FILENAME. +In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless +FILENAME exists and is Babyl format." + ;; Some of this codes is borrowed from rmailout.el. + (setq filename (expand-file-name filename)) + ;; FIXME should we really be messing with this defcustom? + ;; It is not needed for the operation of this function. + (if (boundp 'rmail-default-rmail-file) + (setq rmail-default-rmail-file filename) ; 22 + (setq rmail-default-file filename)) ; 23 + (let ((artbuf (current-buffer)) + (tmpbuf (gnus-get-buffer-create " *Gnus-output*")) + ;; Babyl rmail.el defines this, mbox does not. + (babyl (fboundp 'rmail-insert-rmail-file-header))) + (save-excursion + ;; Note that we ignore the possibility of visiting a Babyl + ;; format buffer in Emacs 23, since Rmail no longer supports that. + (or (get-file-buffer filename) + (progn + ;; In case someone wants to write to a Babyl file from Emacs 23. + (when (file-exists-p filename) + (setq babyl (mail-file-babyl-p filename)) + t)) + (if (or (not ask) + (gnus-yes-or-no-p + (concat "\"" filename "\" does not exist, create it? "))) + (let ((file-buffer (create-file-buffer filename))) + (with-current-buffer file-buffer + (if (fboundp 'rmail-insert-rmail-file-header) + (rmail-insert-rmail-file-header)) + (let ((require-final-newline nil) + (coding-system-for-write mm-text-coding-system)) + (gnus-write-buffer filename))) + (kill-buffer file-buffer)) + (error "Output file does not exist"))) + (set-buffer tmpbuf) + (erase-buffer) + (insert-buffer-substring artbuf) + (if babyl + (gnus-convert-article-to-rmail) + ;; Non-Babyl case copied from gnus-output-to-mail. + (goto-char (point-min)) + (if (looking-at "From ") + (forward-line 1) + (insert "From nobody " (current-time-string) "\n")) + (let (case-fold-search) + (while (re-search-forward "^From " nil t) + (beginning-of-line) + (insert ">")))) + ;; Decide whether to append to a file or to an Emacs buffer. + (let ((outbuf (get-file-buffer filename))) + (if (not outbuf) + (progn + (unless babyl ; from gnus-output-to-mail + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (forward-char -2) + (unless (looking-at "\n\n") + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert "\n")))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (mm-append-to-file (point-min) (point-max) filename))) + ;; File has been visited, in buffer OUTBUF. + (set-buffer outbuf) + (let ((buffer-read-only nil) + (msg (and (boundp 'rmail-current-message) + (symbol-value 'rmail-current-message)))) + ;; If MSG is non-nil, buffer is in RMAIL mode. + ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23. + (when msg + (unless babyl + (rmail-swap-buffers-maybe) + (rmail-maybe-set-message-counters)) + (widen) + (unless babyl + (goto-char (point-max)) + ;; Ensure we have a blank line before the next message. + (unless (bolp) + (insert "\n")) + (insert "\n")) + (narrow-to-region (point-max) (point-max))) + (insert-buffer-substring tmpbuf) + (when msg + (when babyl + (goto-char (point-min)) + (widen) + (search-backward "\n\^_") + (narrow-to-region (point) (point-max))) + (rmail-count-new-messages t) + (when (rmail-summary-exists) + (rmail-select-summary + (rmail-update-summary))) + (rmail-show-message msg)) + (save-buffer))))) + (kill-buffer tmpbuf))) + +(defun gnus-convert-article-to-rmail () + "Convert article in current buffer to Rmail message format." + (let ((buffer-read-only nil)) + ;; Convert article directly into Babyl format. + (goto-char (point-min)) + (insert "\^L\n0, unseen,,\n*** EOOH ***\n") + (while (search-forward "\n\^_" nil t) ;single char + (replace-match "\n^_" t t)) ;2 chars: "^" and "_" + (goto-char (point-max)) + (insert "\^_"))) + +;;; gnus-rmail.el ends here diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index a777157f89..8dbdcc83f8 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -858,126 +858,9 @@ variables and then do only the assignment atomically." `(let ((inhibit-quit gnus-atomic-be-safe)) ,@forms)) -;;; Functions for saving to babyl/mail files. - -(require 'rmail) -(autoload 'rmail-update-summary "rmailsum") - (defvar mm-text-coding-system) - (declare-function mm-append-to-file "mm-util" (start end filename &optional codesys inhibit)) -(declare-function rmail-swap-buffers-maybe "rmail" ()) -(declare-function rmail-maybe-set-message-counters "rmail" ()) -(declare-function rmail-count-new-messages "rmail" (&optional nomsg)) -(declare-function rmail-summary-exists "rmail" ()) -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -;; Macroexpansion of rmail-select-summary: -(declare-function rmail-summary-displayed "rmail" ()) -(declare-function rmail-pop-to-buffer "rmail" (&rest args)) -(declare-function rmail-maybe-display-summary "rmail" ()) - -(defun gnus-output-to-rmail (filename &optional ask) - "Append the current article to an Rmail file named FILENAME. -In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless -FILENAME exists and is Babyl format." - (require 'rmail) - (require 'mm-util) - (require 'nnmail) - ;; Some of this codes is borrowed from rmailout.el. - (setq filename (expand-file-name filename)) - ;; FIXME should we really be messing with this defcustom? - ;; It is not needed for the operation of this function. - (if (boundp 'rmail-default-rmail-file) - (setq rmail-default-rmail-file filename) ; 22 - (setq rmail-default-file filename)) ; 23 - (let ((artbuf (current-buffer)) - (tmpbuf (gnus-get-buffer-create " *Gnus-output*")) - ;; Babyl rmail.el defines this, mbox does not. - (babyl (fboundp 'rmail-insert-rmail-file-header))) - (save-excursion - ;; Note that we ignore the possibility of visiting a Babyl - ;; format buffer in Emacs 23, since Rmail no longer supports that. - (or (get-file-buffer filename) - (progn - ;; In case someone wants to write to a Babyl file from Emacs 23. - (when (file-exists-p filename) - (setq babyl (mail-file-babyl-p filename)) - t)) - (if (or (not ask) - (gnus-yes-or-no-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (with-current-buffer file-buffer - (if (fboundp 'rmail-insert-rmail-file-header) - (rmail-insert-rmail-file-header)) - (let ((require-final-newline nil) - (coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (if babyl - (gnus-convert-article-to-rmail) - ;; Non-Babyl case copied from gnus-output-to-mail. - (goto-char (point-min)) - (if (looking-at "From ") - (forward-line 1) - (insert "From nobody " (current-time-string) "\n")) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert ">")))) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (progn - (unless babyl ; from gnus-output-to-mail - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (forward-char -2) - (unless (looking-at "\n\n") - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert "\n")))) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (mm-append-to-file (point-min) (point-max) filename))) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - (symbol-value 'rmail-current-message)))) - ;; If MSG is non-nil, buffer is in RMAIL mode. - ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23. - (when msg - (unless babyl - (rmail-swap-buffers-maybe) - (rmail-maybe-set-message-counters)) - (widen) - (unless babyl - (goto-char (point-max)) - ;; Ensure we have a blank line before the next message. - (unless (bolp) - (insert "\n")) - (insert "\n")) - (narrow-to-region (point-max) (point-max))) - (insert-buffer-substring tmpbuf) - (when msg - (when babyl - (goto-char (point-min)) - (widen) - (search-backward "\n\^_") - (narrow-to-region (point) (point-max))) - (rmail-count-new-messages t) - (when (rmail-summary-exists) - (rmail-select-summary - (rmail-update-summary))) - (rmail-show-message msg)) - (save-buffer))))) - (kill-buffer tmpbuf))) (defun gnus-output-to-mail (filename &optional ask) "Append the current article to a mail file named FILENAME." @@ -1035,17 +918,6 @@ FILENAME exists and is Babyl format." (insert-buffer-substring tmpbuf))))) (kill-buffer tmpbuf))) -(defun gnus-convert-article-to-rmail () - "Convert article in current buffer to Rmail message format." - (let ((buffer-read-only nil)) - ;; Convert article directly into Babyl format. - (goto-char (point-min)) - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (while (search-forward "\n\^_" nil t) ;single char - (replace-match "\n^_" t t)) ;2 chars: "^" and "_" - (goto-char (point-max)) - (insert "\^_"))) - (defun gnus-map-function (funs arg) "Apply the result of the first function in FUNS to the second, and so on. ARG is passed to the first function." @@ -1675,6 +1547,11 @@ lists of strings." (while overlays (delete-overlay (pop overlays))))) +;; This function used to live in this file, but was moved to a +;; separate file to avoid pulling in rmail.el when requiring +;; gnus-util. +(autoload 'gnus-output-to-rmail "gnus-rmail") + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index afe07ee46f..1f1c39bb8b 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2528,14 +2528,6 @@ are always t.") ("babel" babel-as-string) ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ;; This is only used in message.el, which has an autoload. - ("rmailout" rmail-output) - ;; Next two used in gnus-util, which has autoloads, and contrib/sendmail. - ("rmail" rmail-count-new-messages rmail-show-message - ;; Next two only used in gnus-util. - rmail-summary-exists rmail-select-summary) - ;; Only used in gnus-util, which has an autoload. - ("rmailsum" rmail-update-summary) ("gnus-xmas" gnus-xmas-splash) ("score-mode" :interactive t gnus-score-mode gnus-score-edit-all-score) ("gnus-mh" gnus-summary-save-article-folder diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c2d14296f9..285369b84c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2053,7 +2053,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'gnus-groups-from-server "gnus") (autoload 'gnus-open-server "gnus-int") (autoload 'gnus-output-to-mail "gnus-util") -(autoload 'gnus-output-to-rmail "gnus-util") +(autoload 'gnus-output-to-rmail "gnus-rmail") (autoload 'gnus-request-post "gnus-int") (autoload 'gnus-server-string "gnus") (autoload 'message-setup-toolbar "messagexmas") commit 5f25852e91f167f99988fbe8d1944fe92d70b903 Author: Kyle Meyer Date: Sat Dec 18 13:50:40 2021 -0500 Update to Org 9.5.1-31-ga18849 diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 2dd1d031cb..8ed7002ef6 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -179,15 +179,14 @@ source code blocks by languages matching a regular expression. Return a list whose CAR is the tangled file name." (interactive "fFile to tangle: \nP") - (let ((visited-p (find-buffer-visiting (expand-file-name file))) - to-be-removed) + (let* ((visited (find-buffer-visiting file)) + (buffer (or visited (find-file-noselect file)))) (prog1 - (save-window-excursion - (find-file file) - (setq to-be-removed (current-buffer)) - (mapcar #'expand-file-name (org-babel-tangle nil target-file lang-re))) - (unless visited-p - (kill-buffer to-be-removed))))) + (with-current-buffer buffer + (org-with-wide-buffer + (mapcar #'expand-file-name + (org-babel-tangle nil target-file lang-re)))) + (unless visited (kill-buffer buffer))))) (defun org-babel-tangle-publish (_ filename pub-dir) "Tangle FILENAME and place the results in PUB-DIR." diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 354f408679..59bdd5b0ed 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6765,7 +6765,7 @@ Any match of REMOVE-RE will be removed from TXT." (setq duration (- (org-duration-to-minutes s2) (org-duration-to-minutes s1)))) ;; Format S1 and S2 for display. - (when s1 (setq s1 (org-get-time-of-day s1 'overtime))) + (when s1 (setq s1 (format "%5s" (org-get-time-of-day s1 'overtime)))) (when s2 (setq s2 (org-get-time-of-day s2 'overtime)))) (when (string-match org-tag-group-re txt) ;; Tags are in the string diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index a355d8e5fa..3ce806855c 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -428,7 +428,8 @@ current time." (save-excursion (goto-char (if line (point-at-bol) (point-min))) (while (not (eobp)) - (let ((habit (get-text-property (point) 'org-habit-p))) + (let ((habit (get-text-property (point) 'org-habit-p)) + (invisible-prop (get-text-property (point) 'invisible))) (when habit (move-to-column org-habit-graph-column t) (delete-char (min (+ 1 org-habit-preceding-days @@ -439,7 +440,12 @@ current time." habit (time-subtract moment (days-to-time org-habit-preceding-days)) moment - (time-add moment (days-to-time org-habit-following-days)))))) + (time-add moment (days-to-time org-habit-following-days)))) + ;; Inherit invisible state of hidden entries. + (when invisible-prop + (put-text-property + (- (point) org-habit-graph-column) (point) + 'invisible invisible-prop)))) (forward-line))))) (defun org-habit-toggle-habits () diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index b009b9691f..514f82ea4a 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5.1-25-g9ca3bc")) + (let ((org-git-version "release_9.5.1-31-ga18849")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 00bbc07688..f784369f95 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6905,7 +6905,7 @@ frame is not changed." (setq beg (point) heading (org-get-heading 'no-tags)) (org-end-of-subtree t t) - (when (org-at-heading-p) (backward-char 1)) + (when (and (not (eobp)) (org-at-heading-p)) (backward-char 1)) (setq end (point))) (when (and (buffer-live-p org-last-indirect-buffer) (not (eq org-indirect-buffer-display 'new-frame))