commit 96be8458b09f95eb33a149b724e40c1b38c78478 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Wed May 11 06:59:39 2022 +0000 Make Haiku event buffer non-static * src/haikuterm.c (haiku_read_socket): Don't make `buf' static in case thread yielding happens inside. diff --git a/src/haikuterm.c b/src/haikuterm.c index ec6a8f0cea..58855d07fb 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2998,7 +2998,7 @@ static int haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) { int message_count; - static void *buf; + void *buf; ssize_t b_size; int button_or_motion_p, do_help; enum haiku_event_type type; commit 70c4b5bdc6d5e534e1a23c05da1b60c47243a192 Author: Po Lu Date: Wed May 11 06:56:43 2022 +0000 Fix event memory leak on Haiku * src/haikuterm.c (haiku_read_socket): Allocate event buffer on the stack. diff --git a/src/haikuterm.c b/src/haikuterm.c index a740331482..ec6a8f0cea 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3007,11 +3007,10 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) message_count = 0; button_or_motion_p = 0; do_help = 0; - buf = NULL; + + buf = alloca (200); block_input (); - if (!buf) - buf = xmalloc (200); haiku_read_size (&b_size, false); while (b_size >= 0) { commit 80951f764b7053f93d69ac5c73c0e504ab308450 Author: Po Lu Date: Wed May 11 03:48:36 2022 +0000 Fix frame invalidation on Haiku * src/haiku_support.cc (FlipBuffers): Only set view bitmap if it actually changed. * src/haikuterm.c (haiku_clip_to_string_exactly) (haiku_draw_window_cursor, haiku_draw_fringe_bitmap): Fix region invalidation. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index cb9dfabc4e..6caf8049d1 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1619,16 +1619,17 @@ class EmacsView : public BView copy_bitmap = NULL; } if (!copy_bitmap) - copy_bitmap = new BBitmap (offscreen_draw_bitmap_1); + { + copy_bitmap = new BBitmap (offscreen_draw_bitmap_1); + SetViewBitmap (copy_bitmap, Frame (), + Frame (), B_FOLLOW_NONE, 0); + } else copy_bitmap->ImportBits (offscreen_draw_bitmap_1); if (copy_bitmap->InitCheck () != B_OK) gui_abort ("Failed to init copy bitmap during buffer flip"); - SetViewBitmap (copy_bitmap, - Frame (), Frame (), B_FOLLOW_NONE, 0); - Invalidate (&invalid_region); invalid_region.MakeEmpty (); UnlockLooper (); diff --git a/src/haikuterm.c b/src/haikuterm.c index 28ab66c9bc..a740331482 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -204,6 +204,8 @@ haiku_clip_to_string_exactly (struct glyph_string *s, struct glyph_string *dst) { BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), s->x, s->y, s->width, s->height); + BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), s->x, + s->y, s->width, s->height); } static void @@ -2087,10 +2089,12 @@ haiku_draw_window_cursor (struct window *w, case DEFAULT_CURSOR: case NO_CURSOR: break; + case HBAR_CURSOR: BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; + case BAR_CURSOR: if (cursor_glyph->resolved_level & 1) { @@ -2104,6 +2108,7 @@ haiku_draw_window_cursor (struct window *w, BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; + case HOLLOW_BOX_CURSOR: if (phys_cursor_glyph->type != IMAGE_GLYPH) { @@ -2115,6 +2120,7 @@ haiku_draw_window_cursor (struct window *w, BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; + case FILLED_BOX_CURSOR: draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); } @@ -2575,13 +2581,18 @@ haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, face = p->face; block_input (); - BView_draw_lock (view, true, p->x, p->y, p->wd, p->h); + BView_draw_lock (view, true, 0, 0, 0, 0); BView_StartClip (view); + if (p->wd && p->h) + BView_invalidate_region (view, p->x, p->y, p->wd, p->h); + haiku_clip_to_row (w, row, ANY_AREA); if (p->bx >= 0 && !p->overlay_p) { + BView_invalidate_region (view, p->bx, p->by, p->nx, p->ny); + if (!face->stipple) { BView_SetHighColor (view, face->background); commit 736081320803c6d1f987f753f63581a0fd42b1fe Author: Po Lu Date: Wed May 11 02:02:21 2022 +0000 Try to preserve font styles in the Haiku font dialog * haiku_support.cc (class EmacsFontSelectionDialog) (UpdateStylesForIndex): If a style was previously selected and exists in the new family as well, select it after adding the new items. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 6b4951e139..cb9dfabc4e 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2619,13 +2619,22 @@ class EmacsFontSelectionDialog : public BWindow void UpdateStylesForIndex (int idx) { - int n, i; + int n, i, previous_selection; uint32 flags; font_family family; font_style style; BStringItem *item; + char *current_style; n = all_styles.CountItems (); + current_style = NULL; + previous_selection = font_style_pane.CurrentSelection (); + + if (previous_selection >= 0) + { + item = all_styles.ItemAt (previous_selection); + current_style = strdup (item->Text ()); + } font_style_pane.MakeEmpty (); all_styles.MakeEmpty (); @@ -2641,6 +2650,10 @@ class EmacsFontSelectionDialog : public BWindow else item = new BStringItem (""); + if (current_style && pending_selection_idx < 0 + && !strcmp (current_style, style)) + pending_selection_idx = i; + font_style_pane.AddItem (item); all_styles.AddItem (item); } @@ -2654,6 +2667,9 @@ class EmacsFontSelectionDialog : public BWindow pending_selection_idx = -1; UpdateForSelectedStyle (); + + if (current_style) + free (current_style); } bool commit a78a5b1346683b882613dca1a63d47359fcc8983 Author: Po Lu Date: Wed May 11 01:21:18 2022 +0000 Make reliefs on Haiku more like X * src/haikuterm.c (haiku_draw_relief_rect): Use frame background (normal GC) for corners. diff --git a/src/haikuterm.c b/src/haikuterm.c index 26ea69758b..28ab66c9bc 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -715,7 +715,7 @@ haiku_draw_relief_rect (struct glyph_string *s, int left_x, int top_y, if (vwidth > 1 && right_p) BView_StrokeLine (view, right_x, top_y, right_x, bottom_y); - BView_SetHighColor (view, s->face->background); + BView_SetHighColor (view, FRAME_BACKGROUND_PIXEL (s->f)); /* Omit corner pixels. */ if (hwidth > 1 && vwidth > 1) commit a09fc827489d595f8776aa0091ec853e4c825d66 Author: Po Lu Date: Wed May 11 09:13:36 2022 +0800 ; * src/window.c (Fset_window_vscroll): Fix doc string. diff --git a/src/window.c b/src/window.c index 47c008a643..a87b4834aa 100644 --- a/src/window.c +++ b/src/window.c @@ -7959,7 +7959,7 @@ corresponds to an integral number of pixels. The return value is the result of this rounding. If PIXELS-P is non-nil, the return value is VSCROLL. -PRESERVE_VSCROLL_P makes setting the start of WINDOW preserve the +PRESERVE-VSCROLL-P makes setting the start of WINDOW preserve the vscroll if its start is "frozen" due to a resized mini-window. */) (Lisp_Object window, Lisp_Object vscroll, Lisp_Object pixels_p, Lisp_Object preserve_vscroll_p) commit 8baa13ed999f5c7895013f86009a983047b12cec Author: Po Lu Date: Wed May 11 09:09:05 2022 +0800 Clean up some MAYBE_UNUSED functions * src/xterm.c (x_clear_area1): Wrap in the conditions where it will actually be used. diff --git a/src/xterm.c b/src/xterm.c index d44554df7b..4c1720ca94 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8848,13 +8848,15 @@ x_delete_glyphs (struct frame *f, int n) /* Like XClearArea, but check that WIDTH and HEIGHT are reasonable. If they are <= 0, this is probably an error. */ -MAYBE_UNUSED static void +#if defined USE_GTK || !defined USE_CAIRO +static void x_clear_area1 (Display *dpy, Window window, int x, int y, int width, int height, int exposures) { eassert (width > 0 && height > 0); XClearArea (dpy, window, x, y, width, height, exposures); } +#endif void x_clear_area (struct frame *f, int x, int y, int width, int height) commit 430b5ba838f31865139e3a724f9191e2b1de57d1 Author: Paul Eggert Date: Tue May 10 15:20:49 2022 -0700 * src/eval.c (Ffunctionp): Clarify "function" in doc string. diff --git a/src/eval.c b/src/eval.c index 77ec47e2b7..950338bf79 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2803,7 +2803,11 @@ apply1 (Lisp_Object fn, Lisp_Object arg) } DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, - doc: /* Return t if OBJECT is a function. */) + doc: /* Return t if OBJECT is a function. + +An object is a function if it is callable via `funcall'; +this includes primitive functions, byte-code functions, closures, and +symbols with function bindings. */) (Lisp_Object object) { if (FUNCTIONP (object)) commit 4433df3b2015b3b1acd9d24bf7169c010fb51a05 Author: Paul Eggert Date: Tue May 10 14:47:09 2022 -0700 * src/floatfns.c: Update comment. diff --git a/src/floatfns.c b/src/floatfns.c index f2b3b13acd..293184c70f 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -29,14 +29,20 @@ along with GNU Emacs. If not, see . */ C99 and C11 require the following math.h functions in addition to the C89 functions. Of these, Emacs currently exports only the - starred ones to Lisp, since we haven't found a use for the others: - acosh, atanh, cbrt, *copysign, erf, erfc, exp2, expm1, fdim, fma, - fmax, fmin, fpclassify, hypot, ilogb, isfinite, isgreater, - isgreaterequal, isinf, isless, islessequal, islessgreater, *isnan, - isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb - (approximately), lrint/llrint, lround/llround, nan, nearbyint, - nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, - scalbn, signbit, tgamma, *trunc. + starred ones to Lisp, since we haven't found a use for the others. + Also, it uses the ones marked "+" internally: + acosh, atanh, cbrt, copysign (implemented by signbit), erf, erfc, + exp2, expm1, fdim, fma, fmax, fmin, fpclassify, hypot, +ilogb, + isfinite, isgreater, isgreaterequal, isinf, isless, islessequal, + islessgreater, *isnan, isnormal, isunordered, lgamma, log1p, *log2 + [via (log X 2)], logb (approximately; implemented by frexp), + +lrint/llrint, +lround/llround, nan, nearbyint, nextafter, + nexttoward, remainder, remquo, *rint, round, scalbln, +scalbn, + +signbit, tgamma, *trunc. + + The C standard also requires functions for float and long double + that are not listed above. Of these functions, Emacs uses only the + following internally: fabsf, powf, sprintf. */ #include commit 203ffc68468abaccfed7e8ee630d9aa143ce5dbf Author: Paul Eggert Date: Tue May 10 14:44:35 2022 -0700 Port libm configure-time test to Solaris 11.4 * configure.ac (LIB_MATH): Check all the math.h functions that Emacs uses, not just sqrt (Bug#55294). diff --git a/configure.ac b/configure.ac index 484ce980a5..1ba4448d1e 100644 --- a/configure.ac +++ b/configure.ac @@ -1617,16 +1617,63 @@ AC_DEFUN([AC_TYPE_SIZE_T]) # Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them. AC_DEFUN([AC_TYPE_UID_T]) -# sqrt and other floating-point functions such as fmod and frexp -# are found in -lm on many systems. -OLD_LIBS=$LIBS -AC_SEARCH_LIBS([sqrt], [m]) -if test "X$LIBS" = "X$OLD_LIBS"; then - LIB_MATH= -else - LIB_MATH=$ac_cv_search_sqrt -fi -LIBS=$OLD_LIBS +# Check for all math.h functions that Emacs uses; on some platforms, +# -lm is needed for some of these functions. +AC_CACHE_CHECK([for math library], + [emacs_cv_lib_math], + [OLD_LIBS=$LIBS + AC_LINK_IFELSE( + [AC_LANG_SOURCE([[ + #include + int + main (int argc, char **argv) + { + double d = argc; + float f = argc; + int i = argc; + long l = argc; + d = acos (d); + d = asin (d); + d = atan (d); + d = atan2 (d, d); + d = ceil (d); + d = copysign (d, d); + d = cos (d); + d = exp (d); + d = fabs (d); + d = floor (d); + d = fmod (d, d); + d = frexp (d, &i); + d = ldexp (d, i); + d = log (d); + d = log2 (d); + d = log10 (d); + d = pow (d, d); + d = rint (d); + d = scalbn (d, l); + d = sin (d); + d = sqrt (d); + d = tan (d); + d = trunc (d); + f = fabsf (f); + f = powf (f, f); + i = ilogb (d); + i = signbit (d); + l = lrint (d); + l = lround (d); + return d == f && i == l; + } + ]])], + [emacs_cv_lib_math='none required'], + [LIBS="-lm $LIBS" + AC_LINK_IFELSE([], + [emacs_cv_lib_math=-lm], + [AC_MSG_ERROR([Math library (-lm) not found])])]) + LIBS=$OLD_LIBS]) +case $emacs_cv_lib_math in + -*) LIB_MATH=$emacs_cv_lib_math;; + *) LIB_MATH=;; +esac dnl Current possibilities handled by sed (aix4-2 -> aix, dnl gnu-linux -> gnu/linux, etc.): commit 620ac6735520aea97ce49059b0df38ed41930b6b Author: Alexander Adolf Date: Mon May 2 23:01:11 2022 +0200 EUDC: Add completion-at-point support * lisp/net/eudc-capf.el: New file. * lisp/gnus/message.el (message-mode): Add `eudc-capf-complete' to `completion-at-point-functions' when a `message-mode' buffer is created. * doc/misc/eudc.texi (Inline Query Expansion): Add a new subsection, describing the new `completion-at-point' mechanism in `message-mode'. * etc/NEWS (EUDC): Describe the new `completion-at-point' method. diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index d2850282fe..7fd5add67e 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -713,6 +713,7 @@ be passed to the program. @node Inline Query Expansion @section Inline Query Expansion +@subsection Inline Query Expansion Using a Key Binding Inline query expansion is a powerful method to get completion from your directory servers. The most common usage is for expanding names @@ -885,6 +886,29 @@ An error is signaled. The expansion aborts. Default is @code{select} @end defvar +@subsection Inline Query Expansion Using completion-at-point + +In addition to providing a dedicated EUDC function for binding to a +key shortcut (@pxref{Inline Query Expansion}), EUDC also provides a +function to contribute search results to the Emacs in-buffer +completion system available via the function +@code{completion-at-point} (@pxref{Identifier +Inquiries,,,maintaining}) in @code{message-mode} buffers +(@pxref{Top,Message,, message, Message}). When using this mechanism, +queries are made in the multi-server query mode of operation +(@pxref{Multi-server Queries}). + +When a buffer in @code{message-mode} is created, EUDC's inline +expansion function is automatically added to the variable +@code{completion-at-point-functions}. As a result, whenever +@code{completion-at-point} is invoked in a @code{message-mode} buffer, +EUDC will be queried for email addresses matching the words before +point. Since this will be useful only when editing specific message +header fields that require specifying one or more email addresses, an +additional check is performed whether point is actually in one of +those header fields. Thus, any matching email addresses will be +offered for completion in suitable message header fields only, and not +in other places, like for example the body of the message. @node The Server Hotlist diff --git a/etc/NEWS b/etc/NEWS index 5b0922506a..a0164bbf3f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1073,6 +1073,12 @@ is called, and the returned values are used to populate the phrase and comment parts (see RFC 5322 for definitions). In both cases, the phrase part will be automatically quoted if necessary. ++++ +*** New function 'eudc-capf-complete' with message-mode integration +EUDC can now contribute email addresses to 'completion-at-point' by +adding the new function 'eudc-capf-complete' to +'completion-at-point-functions' in message-mode. + ** eww/shr +++ diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index e7dc089a3c..3cef247522 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -51,6 +51,7 @@ (require 'yank-media) (require 'mailcap) (require 'sendmail) +(require 'eudc-capf) (autoload 'mailclient-send-it "mailclient") @@ -3180,8 +3181,7 @@ Like `text-mode', but with these additional commands: (mail-abbrevs-setup)) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) - ;; FIXME: merge the completion tables from ecomplete/bbdb/...? - ;;(add-hook 'completion-at-point-functions #'message-ecomplete-capf nil t) + (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t) (add-hook 'completion-at-point-functions #'message-completion-function nil t) (unless buffer-file-name (message-set-auto-save-file-name)) @@ -8364,7 +8364,8 @@ set to nil." (t (expand-abbrev)))) -(add-to-list 'completion-category-defaults '(email (styles substring))) +(add-to-list 'completion-category-defaults '(email (styles substring + partial-completion))) (defun message--bbdb-query-with-words (words) ;; FIXME: This (or something like this) should live on the BBDB side. diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el new file mode 100644 index 0000000000..68cbfd93ff --- /dev/null +++ b/lisp/net/eudc-capf.el @@ -0,0 +1,133 @@ +;;; eudc-capf.el --- EUDC - completion-at-point bindings -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; Author: Alexander Adolf +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This library provides functions to deliver email addresses from +;; EUDC search results to `completion-at-point'. +;; +;; Email address completion will likely be desirable only in +;; situations where designating email recipients plays a role, such +;; as when composing or replying to email messages, or when posting +;; to newsgroups, possibly with copies of the post being emailed. +;; Hence, modes relevant in such contexts, such as for example +;; `message-mode' and `mail-mode', often at least to some extent +;; provide infrastructure for different functions to be called when +;; completing in certain message header fields, or in the body of +;; the message. In other modes for editing email messages or +;; newsgroup posts, which do not provide such infrastructure, any +;; completion function providing email addresses will need to check +;; whether the completion attempt occurs in an appropriate context +;; (that is, in a relevant message header field) before providing +;; completion candidates. Two mechanisms are thus provided by this +;; library. +;; +;; The first mechanism is intended for use by the modes listed in +;; `eudc-capf-modes', and relies on these modes adding +;; `eudc-capf-complete' to `completion-at-point-functions', as +;; would be usually done for any general-purpose completion +;; function. In this mode of operation, and in order to offer +;; email addresses only in contexts where the user would expect +;; them, a check is performed whether point is on a line that is a +;; message header field suitable for email addresses, such as for +;; example "To:", "Cc:", etc. +;; +;; The second mechanism is intended for when the user modifies +;; `message-completion-alist' to replace `message-expand-name' with +;; the function `eudc-capf-message-expand-name'. As a result, +;; minibuffer completion (`completing-read') for email addresses +;; would no longer enabled in `message-mode', but +;; `completion-at-point' (in-buffer completion) only. + +;;; Usage: + +;; In a major mode, or context where you want email address +;; completion, you would do something along the lines of: +;; +;; (require 'eudc-capf) +;; (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t) +;; +;; The minus one argument puts it at the front of the list so it is +;; called first, and the t value for the LOCAL parameter causes the +;; setting to be buffer local, so as to avoid modifying any global +;; setting. +;; +;; The value of the variable `eudc-capf-modes' indicates which +;; major modes do such a setup as part of their initialisation +;; code. + +;;; Code: + +(require 'eudc) + +(defvar message-email-recipient-header-regexp) +(defvar mail-abbrev-mode-regexp) +(declare-function mail-abbrev-in-expansion-header-p "mailabbrev" ()) + +(defconst eudc-capf-modes '(message-mode) + "List of modes in which email address completion is to be attempted.") + +;; completion functions + +;;;###autoload +(defun eudc-capf-complete () + "Email address completion function for `completion-at-point-functions'. + +This function checks whether the current major mode is one of the +modes listed in `eudc-capf-modes', and whether point is on a line +with a message header listing email recipients, that is, a line +whose beginning matches `message-email-recipient-header-regexp', +and, if the check succeeds, searches for records matching the +words before point. + +The return value is either nil when no match is found, or a +completion table as required for functions listed in +`completion-at-point-functions'." + (if (and (seq-some #'derived-mode-p eudc-capf-modes) + (let ((mail-abbrev-mode-regexp message-email-recipient-header-regexp)) + (mail-abbrev-in-expansion-header-p))) + (eudc-capf-message-expand-name))) + +;;;###autoload +(defun eudc-capf-message-expand-name () + "Email address completion function for `message-completion-alist'. + +When this function is added to `message-completion-alist', +replacing any existing entry for `message-expand-name' there, +with an appropriate regular expression such as for example +`message-email-recipient-header-regexp', then EUDC will be +queried for email addresses, and the results delivered to +`completion-at-point'." + (if (or eudc-server eudc-server-hotlist) + (progn + (let* ((beg (save-excursion + (re-search-backward "\\([:,]\\|^\\)[ \t]*") + (match-end 0))) + (end (point)) + (prefix (save-excursion (buffer-substring-no-properties beg end)))) + (list beg end + (completion-table-with-cache + (lambda (_) + (eudc-query-with-words (split-string prefix "[ \t]+") t)) + t)))))) + +(provide 'eudc-capf) +;;; eudc-capf.el ends here commit b186d5063d0a32ccab1abd8212c7b2858fd8b044 Author: समीर सिंह Sameer Singh Date: Tue May 10 03:54:14 2022 +0530 Add support for the Siddham script * lisp/language/indian.el ("Siddham"): New language environment. Add composition rules for Siddham. Add sample text and input method. * lisp/international/fontset.el (script-representative-chars) (setup-default-fontset): Support Siddham. * lisp/leim/quail/indian.el ("siddham"): New input method. * etc/HELLO: Add a Siddham greeting. * etc/NEWS: Announce the new language environment and its input method. (Bug#55350) diff --git a/etc/HELLO b/etc/HELLO index b64aacfbe5..b14fa0e861 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -76,6 +76,7 @@ Oriya (ଓଡ଼ିଆ) ଶୁଣିବେ Polish (język polski) Dzień dobry! / Cześć! Russian (русский) Здра́вствуйте! Sharada (𑆯𑆳𑆫𑆢𑆳) 𑆤𑆩𑆱𑇀𑆑𑆳𑆫 +Siddham (𑖭𑖰𑖟𑖿𑖠𑖽) 𑖡𑖦𑖫𑖿𑖝𑖸 Sinhala (සිංහල) ආයුබෝවන් Slovak (slovenčina) Dobrý deň Slovenian (slovenščina) Pozdravljeni! diff --git a/etc/NEWS b/etc/NEWS index 06a3b24a1d..5b0922506a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -772,6 +772,12 @@ This language environment supports the Sharada script. Named after the goddess of learning, this script is used to write the Kashmiri language. A new input method, 'sharada', is provided to type text in this script. +*** New language environment "Siddham". +This language environment supports the Siddham script for the Sanskrit +language. Nowadays it is mostly used by the Buddhist monks in Japan for +religious writings. A new input method, 'siddham', is provided to type +text in this script. + --- *** New Greek translation of the Emacs tutorial. Type 'C-u C-h t' to select it in case your language setup does not do diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 7fa390a34b..144c3761a0 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -240,7 +240,7 @@ (grantha #x11305) (newa #x11400) (tirhuta #x11481 #x1148F #x114D0) - (siddham #x11580) + (siddham #x1158E #x115AF #x115D4) (modi #x11600) (takri #x11680) (dogra #x11800) @@ -777,6 +777,7 @@ kaithi sharada tirhuta + siddham makasar dives-akuru cuneiform diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 1e10c2a61a..b399756bbe 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -169,6 +169,17 @@ Kashmiri language and its script Sharada is supported in this language environment.")) '("Indian")) +(set-language-info-alist + "Siddham" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "siddham") + (sample-text . "Siddham (𑖭𑖰𑖟𑖿𑖠𑖽) 𑖡𑖦𑖭𑖿𑖝𑖸") + (documentation . "\ +Sanskrit language and one of its script Siddham is supported +in this language environment.")) + '("Indian")) + ;; Replace mnemonic characters in REGEXP according to TABLE. TABLE is ;; an alist of (MNEMONIC-STRING . REPLACEMENT-STRING). @@ -543,5 +554,24 @@ language environment.")) (concat fricatives "?" consonant vowel "?") 0 'font-shape-gstring)))) +;; Siddham composition rules +(let ((consonant "[\x1158E-\x115AE]") + (nukta "\x115C0") + (independent-vowel "[\x11580-\x1158D\x115D8-\x115DB]") + (vowel "[\x115AF-\x115BB\x115DC\x115DD]") + (nasal "[\x115BC\x115BD]") + (virama "\x115BF")) + (set-char-table-range composition-function-table + '(#x115AF . #x115C0) + (list (vector + ;; Consonant based syllables + (concat consonant nukta "?\\(?:" virama consonant nukta "?\\)*\\(?:" + virama "\\|" vowel "*" nukta "?" nasal "?\\)") + 1 'font-shape-gstring) + (vector + ;; Nasal vowels + (concat independent-vowel nasal "?") + 1 'font-shape-gstring)))) + (provide 'indian) ;;; indian.el ends here diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index b1e547a26e..3bc03558c3 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -1163,4 +1163,108 @@ Full key sequences are listed below:") ("`M" ?𑇏) ) +(quail-define-package + "siddham" "Sharada" "𑖭𑖰" t "Siddham phonetic input method. + + `\\=`' is used to switch levels instead of Alt-Gr. +" nil t t t t nil nil nil nil nil t) + +(quail-define-rules +("``" ?₹) +("`1" ?𑗊) +("`!" ?𑗔) +("`2" ?𑗋) +("`@" ?𑗕) +("`3" ?𑗌) +("`#" ?𑗖) +("`4" ?𑗍) +("`$" ?𑗗) +("`5" ?𑗎) +("`%" ?𑗅) +("`6" ?𑗏) +("`^" ?𑗆) +("`7" ?𑗐) +("`&" ?𑗇) +("`8" ?𑗑) +("`*" ?𑗈) +("`9" ?𑗒) +("`\(" ?𑗉) +("`0" ?𑗓) +("`\)" ?𑗄) +("`\\" ?𑗂) +("`|" ?𑗃) +("`" ?𑖘) +("q" ?𑖘) +("Q" ?𑖙) +("`q" ?𑗘) +("`Q" ?𑗙) +("w" ?𑖚) +("W" ?𑖛) +("`w" ?𑗚) +("`W" ?𑗛) +("e" ?𑖸) +("E" ?𑖹) +("`e" ?𑖊) +("`E" ?𑖋) +("r" ?𑖨) +("R" ?𑖴) +("`r" ?𑖆) +("t" ?𑖝) +("T" ?𑖞) +("`t" ?𑗜) +("`T" ?𑗝) +("y" ?𑖧) +("u" ?𑖲) +("U" ?𑖳) +("`u" ?𑖄) +("`U" ?𑖅) +("i" ?𑖰) +("I" ?𑖱) +("`i" ?𑖂) +("`I" ?𑖃) +("o" ?𑖺) +("O" ?𑖻) +("`o" ?𑖌) +("`O" ?𑖍) +("p" ?𑖢) +("P" ?𑖣) +("a" ?𑖯) +("A" ?𑖁) +("`a" ?𑖀) +("s" ?𑖭) +("S" ?𑖫) +("d" ?𑖟) +("D" ?𑖠) +("`d" ?𑗁) +("f" ?𑖿) +("F" ?𑖵) +("`f" ?𑖇) +("g" ?𑖐) +("G" ?𑖑) +("h" ?𑖮) +("H" ?𑖾) +("j" ?𑖕) +("J" ?𑖖) +("k" ?𑖎) +("K" ?𑖏) +("l" ?𑖩) +("L" ?𑖈) +("`l" ?𑖉) +("z" ?𑖗) +("Z" ?𑖒) +("x" ?𑖬) +("X" ?𑗀) +("c" ?𑖓) +("C" ?𑖔) +("`c" #x200C) ; ZWNJ +("v" ?𑖪) +("b" ?𑖤) +("B" ?𑖥) +("n" ?𑖡) +("N" ?𑖜) +("m" ?𑖦) +("M" ?𑖽) +("`m" ?𑖼) +) + ;;; indian.el ends here commit a175c9f3f0b9d40f65ee084e5177f401c791c3ae Author: Eli Zaretskii Date: Tue May 10 20:17:59 2022 +0300 ; * etc/NEWS: Clarify entry about Buffers menu. diff --git a/etc/NEWS b/etc/NEWS index 0eb240e2a0..06a3b24a1d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -261,7 +261,7 @@ startup. Previously, these functions ignored --- *** The entries following the buffers in the "Buffers" menu can now be altered. Change the 'menu-bar-buffers-menu-command-entries' variable to alter -the remaining entries. +the entries that follow the buffer list. --- ** 'delete-process' is now a command. commit b1cc3adac2ea31699cdbfe166078b463af7e8894 Author: Eli Zaretskii Date: Tue May 10 20:13:43 2022 +0300 ; Fix recent changes in documentation of ispell.el * etc/NEWS: * lisp/textmodes/ispell.el (ispell-region, ispell-buffer): Avoid passive tense in doc strings and NEWS. diff --git a/etc/NEWS b/etc/NEWS index ac357a2886..0eb240e2a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -791,9 +791,9 @@ contents. --- *** 'ispell-region' and 'ispell-buffer' now push the mark. -The location of the last word the user was queried about is pushed to -the mark ring, so that the user can skip back to the location with -'C-x C-x'. +These commands push onto the mark ring the location of the last +misspelled word where corrections were offered, so that you can then +skip back to that location with 'C-x C-x'. ** dabbrev diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 93008ca7fb..1810d7bcae 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3052,7 +3052,7 @@ when needed." ;;;###autoload (defun ispell-region (reg-start reg-end &optional recheckp shift) "Interactively check a region for spelling errors. -Mark is left at the final word that the user was queried about. +Leave the mark at the last misspelled word that the user was queried about. Return nil if spell session was terminated, otherwise returns shift offset amount for last line processed." @@ -3615,7 +3615,7 @@ to limit the check." ;;;###autoload (defun ispell-buffer () "Check the current buffer for spelling errors interactively. -Mark is left at the final word that the user was queried about." +Leave the mark at the last misspelled word that the user was queried about." (interactive) (ispell-region (point-min) (point-max))) commit 44db73d968040cf76ba3b50694cb43d30667205a Author: Lars Ingebrigtsen Date: Tue May 10 18:33:14 2022 +0200 Fix some quoting problems in defcustom :type * lisp/progmodes/gdb-mi.el (gdb-restore-window-configuration-after-quit): * lisp/gnus/gnus.el (large-newsgroup-initial): * lisp/eshell/em-hist.el (eshell-hist-ignoredups): Fix invalid quoting in :type. diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index a18127a547..1877749c5c 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -104,7 +104,7 @@ in bash, and any other non-nil value mirrors the \"ignoredups\" value." :type '(choice (const :tag "Don't ignore anything" nil) (const :tag "Ignore consecutive duplicates" t) - (const :tag "Only keep last duplicate" 'erase))) + (const :tag "Only keep last duplicate" erase))) (defcustom eshell-save-history-on-exit t "Determine if history should be automatically saved. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 1f673771fa..f60c11f985 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1591,7 +1591,7 @@ posting an article." "Alist of group regexps and its initial input of the number of articles." :variable-group gnus-group-parameter :parameter-type '(choice :tag "Initial Input for Large Newsgroup" - (const :tag "All" 'all) + (const :tag "All" all) (integer)) :parameter-document "\ diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 089c273bc6..3b9e1231ab 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -284,8 +284,8 @@ Possible values are: :type '(choice (const :tag "Always restore" t) (const :tag "Don't restore" nil) - (const :tag "Depends on `gdb-show-main'" 'if-gdb-show-main) - (const :tag "Depends on `gdb-many-windows'" 'if-gdb-many-windows)) + (const :tag "Depends on `gdb-show-main'" if-gdb-show-main) + (const :tag "Depends on `gdb-many-windows'" if-gdb-many-windows)) :group 'gdb :version "28.1") commit fd49e3c62bf162bbe27de6ecc107a4e934a21708 Author: Lars Ingebrigtsen Date: Tue May 10 17:46:55 2022 +0200 Add new command to toggle hiding all widgets in a Customize buffer * lisp/cus-edit.el (custom-commands): Add menu entry. (custom-toggle-hide-all-variables): New command (bug#15748). diff --git a/etc/NEWS b/etc/NEWS index 1c89493a1f..ac357a2886 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -780,6 +780,13 @@ so automatically. * Changes in Specialized Modes and Packages in Emacs 29.1 +** Customize + +--- +*** New command 'custom-toggle-hide-all-variables'. +This is bound to 'H' and toggles whether to hide or show the widget +contents. + ** ispell --- diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index dae97b0230..0870bf6782 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -441,6 +441,7 @@ Use group `text' for this instead. This group is deprecated." (define-key map "u" 'Custom-goto-parent) (define-key map "n" 'widget-forward) (define-key map "p" 'widget-backward) + (define-key map "H" 'custom-toggle-hide-all-variables) map) "Keymap for `Custom-mode'.") @@ -745,6 +746,9 @@ groups after non-groups, if nil do not order groups at all." (or custom-file user-init-file) "Un-customize settings in this and future sessions." "delete" "Uncustomize" (modified set changed rogue saved)) + (" Toggle hiding all values " custom-toggle-hide-all-variables + t "Toggle hiding all values." + "hide" "Hide" t) (" Help for Customize " Custom-help t "Get help for using Customize." "help" "Help" t) (" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit" t)) @@ -2834,6 +2838,29 @@ try matching its doc string against `custom-guess-doc-alist'." (custom-add-parent-links widget)) (custom-add-see-also widget))))) +(defvar custom--hidden-state) + +(defun custom-toggle-hide-all-variables () + "Toggle whether to show contents of the widgets in the current buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + ;; Surely there's a better way to find all the "top level" widgets + ;; in a buffer, but I couldn't find it. + (while (not (eobp)) + (when-let* ((widget (widget-at (point))) + (parent (widget-get widget :parent)) + (state (widget-get parent :custom-state))) + (when (eq state custom--hidden-state) + (custom-toggle-hide-variable widget))) + (forward-line 1))) + (setq custom--hidden-state (if (eq custom--hidden-state 'hidden) + 'standard + 'hidden)) + (if (eq custom--hidden-state 'hidden) + (message "All variables hidden") + (message "All variables shown"))) + (defun custom-toggle-hide-variable (visibility-widget &rest _ignore) "Toggle the visibility of a `custom-variable' parent widget. By default, this signals an error if the parent has unsaved @@ -5230,7 +5257,8 @@ if that value is non-nil." :label (nth 5 arg))) custom-commands) (setq custom-tool-bar-map map)))) - (setq-local custom--invocation-options nil) + (setq-local custom--invocation-options nil + custom--hidden-state 'hidden) (setq-local revert-buffer-function #'custom--revert-buffer) (make-local-variable 'custom-options) (make-local-variable 'custom-local-buffer) commit 2f3cf7ffe3c9ce986caf6d093b880fed6046b7ec Author: Lars Ingebrigtsen Date: Tue May 10 17:05:22 2022 +0200 Use fields on log-edit headers (which changes `C-a' behaviour) * lisp/vc/log-edit.el (log-edit-insert-message-template): Fieldify headers so that `C-a' takes us to the start of the string, not the line (bug#15645). diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 79dafe60cc..e958673fea 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -710,10 +710,14 @@ different header separator appropriate for `log-edit-mode'." (interactive) (when (or (called-interactively-p 'interactive) (log-edit-empty-buffer-p)) - (insert "Summary: ") - (when log-edit-setup-add-author - (insert "\nAuthor: ")) - (insert "\n\n") + (dolist (header (append '("Summary") (and log-edit-setup-add-author + '("Author")))) + ;; Make `C-a' work like in other buffers with header names. + (insert (propertize (concat header ": ") + 'field 'header + 'rear-nonsticky t) + "\n")) + (insert "\n") (message-position-point))) (defun log-edit-insert-cvs-template () commit 00451c6fc62d96c866fe87ae153e27d687c50d1a Author: Lars Ingebrigtsen Date: Tue May 10 16:23:43 2022 +0200 Make ispell-region/buffer push the mark of the final word * lisp/textmodes/ispell.el (ispell-region): Push the mark of the final location. (ispell-process-line): Change the return value to include the position of the final word. diff --git a/etc/NEWS b/etc/NEWS index 2557a092a8..1c89493a1f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -780,6 +780,14 @@ so automatically. * Changes in Specialized Modes and Packages in Emacs 29.1 +** ispell + +--- +*** 'ispell-region' and 'ispell-buffer' now push the mark. +The location of the last word the user was queried about is pushed to +the mark ring, so that the user can skip back to the location with +'C-x C-x'. + ** dabbrev --- diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index b58514972a..93008ca7fb 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3052,6 +3052,8 @@ when needed." ;;;###autoload (defun ispell-region (reg-start reg-end &optional recheckp shift) "Interactively check a region for spelling errors. +Mark is left at the final word that the user was queried about. + Return nil if spell session was terminated, otherwise returns shift offset amount for last line processed." (interactive "r") ; Don't flag errors on read-only bufs. @@ -3063,7 +3065,8 @@ amount for last line processed." (region-type (if (and (= reg-start (point-min)) (= reg-end (point-max))) (buffer-name) "region")) (program-basename (file-name-nondirectory ispell-program-name)) - (dictionary (or ispell-current-dictionary "default"))) + (dictionary (or ispell-current-dictionary "default")) + max-word) (unwind-protect (save-excursion (message "Spell-checking %s using %s with %s dictionary..." @@ -3159,10 +3162,14 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r ;; Reset `in-comment' (and indirectly `add-comment') for new line in-comment nil)) (setq ispell-end (point)) ; "end" tracks region retrieved. - (if string ; there is something to spell check! - ;; (special start end) - (setq shift (ispell-process-line string - (and recheckp shift)))) + ;; There is something to spell check! + (when string + ;; (special start end) + (let ((res (ispell-process-line string + (and recheckp shift)))) + (setq shift (car res)) + (when (cdr res) + (setq max-word (cdr res))))) (goto-char ispell-end))))) (if ispell-quit nil @@ -3173,6 +3180,9 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r (kill-buffer ispell-choices-buffer)) (set-marker skip-region-start nil) (set-marker rstart nil) + ;; Allow the user to pop back to the last position. + (when max-word + (push-mark max-word t)) (if ispell-quit (progn ;; preserve or clear the region for ispell-continue. @@ -3407,9 +3417,12 @@ Returns a string with the line data." This will modify the buffer for spelling errors. Requires variables ISPELL-START and ISPELL-END to be defined in its dynamic scope. -Returns the sum SHIFT due to changes in word replacements." + +Returns a cons cell where the `car' is sum SHIFT due to changes +in word replacements, and the `cdr' is the location of the final +word that was queried about." ;;(declare special ispell-start ispell-end) - (let (poss accept-list) + (let (poss accept-list max-word) (if (not (numberp shift)) (setq shift 0)) ;; send string to spell process and get input. @@ -3463,6 +3476,7 @@ Returns the sum SHIFT due to changes in word replacements." (error (concat "Ispell misalignment: word " "`%s' point %d; probably incompatible versions") ispell-pipe-word actual-point))) + (setq max-word (marker-position word-start)) ;; ispell-cmd-loop can go recursive & change buffer (if ispell-keep-choices-win (setq replace (ispell-command-loop @@ -3559,7 +3573,7 @@ Returns the sum SHIFT due to changes in word replacements." (set-marker line-end nil))) ;; Finished with misspelling! (setq ispell-filter (cdr ispell-filter))) - shift)) + (cons shift max-word))) ;;;###autoload @@ -3600,7 +3614,8 @@ to limit the check." ;;;###autoload (defun ispell-buffer () - "Check the current buffer for spelling errors interactively." + "Check the current buffer for spelling errors interactively. +Mark is left at the final word that the user was queried about." (interactive) (ispell-region (point-min) (point-max))) commit f38a5e45c891f80b4537c8cda28783d3bb43cdec Author: Lars Ingebrigtsen Date: Tue May 10 15:33:32 2022 +0200 Fix markup in read-number doc string * lisp/subr.el (read-number): Fix markup for the letter. diff --git a/lisp/subr.el b/lisp/subr.el index 54c9f35264..d7f06bdcde 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3055,7 +3055,8 @@ DEFAULT specifies a default value to return if the user just types RET. The value of DEFAULT is inserted into PROMPT. HIST specifies a history list variable. See `read-from-minibuffer' for details of the HIST argument. -This function is used by the `interactive' code letter `n'." + +This function is used by the `interactive' code letter \"n\"." (let ((n nil) (default1 (if (consp default) (car default) default))) (when default1 commit ec01391ab3ecf3c1edb1070c97803e2aa2273367 Author: Lars Ingebrigtsen Date: Tue May 10 15:25:06 2022 +0200 Allow packages to alter menu entries in the Buffers menu * lisp/menu-bar.el (menu-bar-update-buffers): Use it. (menu-bar-buffers-menu-command-entries): Put the entries into the defvar so that packages can modify it (bug#14244). diff --git a/etc/NEWS b/etc/NEWS index 13c8aacb2b..2557a092a8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -256,6 +256,13 @@ startup. Previously, these functions ignored * Changes in Emacs 29.1 +** Menus + +--- +*** The entries following the buffers in the "Buffers" menu can now be altered. +Change the 'menu-bar-buffers-menu-command-entries' variable to alter +the remaining entries. + --- ** 'delete-process' is now a command. When called interactively, it will kill the process running in the diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 9a3181afb8..488bf05f3a 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2320,8 +2320,29 @@ Buffers menu is regenerated." (cdr elt))) buf))) -;; Used to cache the menu entries for commands in the Buffers menu -(defvar menu-bar-buffers-menu-command-entries nil) +(defvar menu-bar-buffers-menu-command-entries + (list '(command-separator "--") + (list 'next-buffer + 'menu-item + "Next Buffer" + 'next-buffer + :help "Switch to the \"next\" buffer in a cyclic order") + (list 'previous-buffer + 'menu-item + "Previous Buffer" + 'previous-buffer + :help "Switch to the \"previous\" buffer in a cyclic order") + (list 'select-named-buffer + 'menu-item + "Select Named Buffer..." + 'switch-to-buffer + :help "Prompt for a buffer name, and select that buffer in the current window") + (list 'list-all-buffers + 'menu-item + "List All Buffers" + 'list-buffers + :help "Pop up a window listing all Emacs buffers")) + "Entries to be included at the end of the \"Buffers\" menu.") (defvar menu-bar-select-buffer-function 'switch-to-buffer "Function to select the buffer chosen from the `Buffers' menu-bar menu. @@ -2406,35 +2427,7 @@ It must accept a buffer as its only required argument.") `((frames-separator "--") (frames menu-item "Frames" ,frames-menu)))))) - ;; Add in some normal commands at the end of the menu. We use - ;; the copy cached in `menu-bar-buffers-menu-command-entries' - ;; if it's been set already. Note that we can't use constant - ;; lists for the menu-entries, because the low-level menu-code - ;; modifies them. - (unless menu-bar-buffers-menu-command-entries - (setq menu-bar-buffers-menu-command-entries - (list '(command-separator "--") - (list 'next-buffer - 'menu-item - "Next Buffer" - 'next-buffer - :help "Switch to the \"next\" buffer in a cyclic order") - (list 'previous-buffer - 'menu-item - "Previous Buffer" - 'previous-buffer - :help "Switch to the \"previous\" buffer in a cyclic order") - (list 'select-named-buffer - 'menu-item - "Select Named Buffer..." - 'switch-to-buffer - :help "Prompt for a buffer name, and select that buffer in the current window") - (list 'list-all-buffers - 'menu-item - "List All Buffers" - 'list-buffers - :help "Pop up a window listing all Emacs buffers" - )))) + ;; Add in some normal commands at the end of the menu. (setq buffers-menu (nconc buffers-menu menu-bar-buffers-menu-command-entries)) commit cfa317fa92c3ebc47bbdee25b5595cb85a21e298 Author: Po Lu Date: Tue May 10 21:34:19 2022 +0800 Improve display of relief rectangles on NS * src/nsterm.m (ns_draw_relief): Respect cursor color and draw corners like X. diff --git a/src/nsterm.m b/src/nsterm.m index 238a842d78..e25f94e5d8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3477,6 +3477,9 @@ larger if there are taller display elements (e.g., characters else newBaseCol = [NSColor colorWithUnsignedLong: s->face->background]; + if (s->hl == DRAW_CURSOR) + newBaseCol = FRAME_CURSOR_COLOR (s->f); + if (newBaseCol == nil) newBaseCol = [NSColor grayColor]; @@ -3485,18 +3488,31 @@ larger if there are taller display elements (e.g., characters [baseCol release]; baseCol = [newBaseCol retain]; [lightCol release]; - lightCol = [[baseCol highlightWithLevel: 0.2] retain]; + lightCol = [[baseCol highlightWithLevel: 0.4] retain]; [darkCol release]; - darkCol = [[baseCol shadowWithLevel: 0.3] retain]; + darkCol = [[baseCol shadowWithLevel: 0.4] retain]; } /* Calculate the inner rectangle. */ - inner = NSMakeRect (NSMinX (outer) + (left_p ? hthickness : 0), - NSMinY (outer) + (top_p ? vthickness : 0), - NSWidth (outer) - (left_p ? hthickness : 0) - - (right_p ? hthickness : 0), - NSHeight (outer) - (top_p ? vthickness : 0) - - (bottom_p ? vthickness : 0)); + inner = outer; + + if (left_p) + { + inner.origin.x += vthickness; + inner.size.width -= vthickness; + } + + if (right_p) + inner.size.width -= vthickness; + + if (top_p) + { + inner.origin.y += hthickness; + inner.size.height -= hthickness; + } + + if (bottom_p) + inner.size.height -= hthickness; [(raised_p ? lightCol : darkCol) set]; @@ -3508,7 +3524,7 @@ larger if there are taller display elements (e.g., characters if (top_p) { [p lineToPoint: NSMakePoint (NSMaxX (outer), NSMinY (outer))]; - [p lineToPoint :NSMakePoint (NSMaxX (inner), NSMinY (inner))]; + [p lineToPoint: NSMakePoint (NSMaxX (inner), NSMinY (inner))]; } [p lineToPoint: NSMakePoint (NSMinX (inner), NSMinY (inner))]; if (left_p) @@ -3584,6 +3600,31 @@ larger if there are taller display elements (e.g., characters [darkCol set]; [p stroke]; + + if (vthickness > 1 && hthickness > 1) + { + [FRAME_BACKGROUND_COLOR (s->f) set]; + + if (left_p && top_p) + [NSBezierPath fillRect: NSMakeRect (NSMinX (outer), + NSMinY (outer), + 1, 1)]; + + if (right_p && top_p) + [NSBezierPath fillRect: NSMakeRect (NSMaxX (outer) - 1, + NSMinY (outer), + 1, 1)]; + + if (right_p && bottom_p) + [NSBezierPath fillRect: NSMakeRect (NSMaxX (outer) - 1, + NSMaxY (outer) - 1, + 1, 1)]; + + if (left_p && bottom_p) + [NSBezierPath fillRect: NSMakeRect (NSMinX (outer), + NSMaxY (outer) - 1, + 1, 1)]; + } } commit d1848d82aa671b38031868473e6ec91881422ce2 Merge: 97ca460163 77bf4ca000 Author: Eli Zaretskii Date: Tue May 10 16:13:04 2022 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 97ca4601632c0ed8434925d7e03e4d644276986a Author: समीर सिंह Sameer Singh Date: Tue May 10 00:49:58 2022 +0530 ; * lisp/language/indian.el: Improve composition rules. (Bug#55341) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 4b6c4744f1..1e10c2a61a 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -462,8 +462,9 @@ language environment.")) ;; Kaithi composition rules (let ((consonant "[\x1108D-\x110AF]") (nukta "\x110BA") + (independent-vowel "[\x11083-\x1108C]") (vowel "[\x1108D-\x110C2]") - (anusvara-candrabindu "[\x11080\x11081]") + (nasal "[\x11080\x11081]") (virama "\x110B9") (number-sign "\x110BD") (number-sign-above "\x110CD") @@ -474,7 +475,11 @@ language environment.")) (list (vector ;; Consonant based syllables (concat consonant nukta "?\\(?:" virama zwj "?" consonant nukta "?\\)*\\(?:" - virama zwj "?\\|" vowel "*" nukta "?" anusvara-candrabindu "?\\)") + virama zwj "?\\|" vowel "*" nukta "?" nasal "?\\)") + 1 'font-shape-gstring) + (vector + ;; Nasal vowels + (concat independent-vowel nasal "?") 1 'font-shape-gstring))) (set-char-table-range composition-function-table '(#x110BD . #x110BD) @@ -489,29 +494,33 @@ language environment.")) (concat number-sign-above numerals) 0 'font-shape-gstring)))) -(provide 'indian) - ;; Tirhuta composition rules (let ((consonant "[\x1148F-\x114AF]") (nukta "\x114C3") + (independent-vowel "[\x11481-\x1148E]") (vowel "[\x114B0-\x114BE]") - (anusvara-candrabindu "[\x114BF\x114C0]") + (nasal "[\x114BF\x114C0]") (virama "\x114C2")) (set-char-table-range composition-function-table '(#x114B0 . #x114C3) (list (vector ;; Consonant based syllables (concat consonant nukta "?\\(?:" virama consonant nukta "?\\)*\\(?:" - virama "\\|" vowel "*" nukta "?" anusvara-candrabindu "?\\)") + virama "\\|" vowel "*" nukta "?" nasal "?\\)") + 1 'font-shape-gstring) + (vector + ;; Nasal vowels + (concat independent-vowel nasal "?") 1 'font-shape-gstring)))) ;; Sharada composition rules (let ((consonant "[\x11191-\x111B2]") (nukta "\x111CA") + (independent-vowel "[\x11183-\x11190]") (vowel "[\x111B3-\x111BF\x111CE]") (vowel-modifier "\x111CB") (extra-short-vowel-mark "\x111CC") - (anusvara-candrabindu "[\x11181\x11180\x111CF]") + (nasal "[\x11181\x11180\x111CF]") (virama "\x111C0") (fricatives "[\x111C2\x111C3]") (sandhi-mark "\x111C9") @@ -522,15 +531,17 @@ language environment.")) ;; Consonant based syllables (concat consonant nukta "?" vowel-modifier "?\\(?:" virama consonant nukta "?" vowel-modifier "?\\)*\\(?:" virama - "\\|" vowel "*" nukta "?" anusvara-candrabindu "?" - extra-short-vowel-mark "?" vowel-modifier "?" sandhi-mark - "?+" misc "?\\)") - 1 'font-shape-gstring))) - (set-char-table-range composition-function-table - '(#x111C2 . #x111C3) - (list (vector + "\\|" vowel "*" nukta "?" nasal "?" extra-short-vowel-mark + "?" vowel-modifier "?" sandhi-mark "?+" misc "?\\)") + 1 'font-shape-gstring) + (vector + ;; Nasal vowels + (concat independent-vowel nasal "?") + 1 'font-shape-gstring) + (vector ;; Fricatives with Consonants (concat fricatives "?" consonant vowel "?") 0 'font-shape-gstring)))) +(provide 'indian) ;;; indian.el ends here commit 77bf4ca000b4d1c901907c774e7bb342b6f24f1e Author: Po Lu Date: Tue May 10 21:07:53 2022 +0800 Respect `alpha-background' drawing relief corners * src/xterm.c (x_draw_relief_rect): Respect background alpha for corner rects. diff --git a/src/xterm.c b/src/xterm.c index 40c80eb1f7..d44554df7b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7614,19 +7614,25 @@ x_draw_relief_rect (struct frame *f, int left_x, int top_y, int right_x, { if (left_p && top_p && x_inside_rect_p (clip_rect, 1, left_x, top_y)) - x_clear_rectangle (f, normal_gc, left_x, top_y, 1, 1, false); + /* This should respect `alpha-backgroun' since it's being + cleared with the background color of the frame. */ + x_clear_rectangle (f, normal_gc, left_x, top_y, 1, 1, + true); if (left_p && bot_p && x_inside_rect_p (clip_rect, 1, left_x, bottom_y)) - x_clear_rectangle (f, normal_gc, left_x, bottom_y, 1, 1, false); + x_clear_rectangle (f, normal_gc, left_x, bottom_y, 1, 1, + true); if (right_p && top_p && x_inside_rect_p (clip_rect, 1, right_x, top_y)) - x_clear_rectangle (f, normal_gc, right_x, top_y, 1, 1, false); + x_clear_rectangle (f, normal_gc, right_x, top_y, 1, 1, + true); if (right_p && bot_p && x_inside_rect_p (clip_rect, 1, right_x, bottom_y)) - x_clear_rectangle (f, normal_gc, right_x, bottom_y, 1, 1, false); + x_clear_rectangle (f, normal_gc, right_x, bottom_y, 1, 1, + true); } x_reset_clip_rectangles (f, white_gc); commit 68dd94448f0b46cced59c7fe33f77f74ddf656ad Author: Eli Zaretskii Date: Tue May 10 16:06:10 2022 +0300 ; Fix recent documentation changes * src/fileio.c (Fdo_auto_save): * src/buffer.c (Fbuffer_modified_p, Frestore_buffer_modified_p): * doc/lispref/buffers.texi (Buffer Modification): Improve documentation of 'do-auto-save', 'buffer-modified-p' and 'restore-buffer-modified-p'. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 8d1d9f5ddb..2e5771f347 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -541,12 +541,12 @@ file formerly visited. @ref{Text}. @defun buffer-modified-p &optional buffer -This function returns non-@code{nil} if the buffer @var{buffer} has +This function returns non-@code{nil} if @var{buffer} has been modified since it was last read in from a file or saved, or -@code{nil} otherwise. If @var{buffer} has been autosaved after -@var{buffer} was last modified, the symbol @code{autosaved} is -returned. If @var{buffer} is not supplied, the current buffer is -tested. +@code{nil} otherwise. If @var{buffer} has been auto-saved since the +time it was last modified, this function returns the symbol +@code{autosaved}. If @var{buffer} is @code{nil} or omitted, it +defaults to the current buffer. @end defun @defun set-buffer-modified-p flag diff --git a/src/buffer.c b/src/buffer.c index 0f3061b497..0af14a1060 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1379,8 +1379,8 @@ DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p, doc: /* Return non-nil if BUFFER was modified since its file was last read or saved. No argument or nil as argument means use current buffer as BUFFER. -If BUFFER has been autosaved after BUFFER was last modified, the -symbol `autosaved' is returned. */) +If BUFFER was autosaved since it was last modified, this function +returns the symbol `autosaved'. */) (Lisp_Object buffer) { struct buffer *buf = decode_buffer (buffer); @@ -1448,9 +1448,9 @@ DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p, Srestore_buffer_modified_p, 1, 1, 0, doc: /* Like `set-buffer-modified-p', but doesn't redisplay buffer's mode line. A nil FLAG means to mark the buffer as unmodified. A non-nil FLAG -means mark the buffer as modified, except the special value -`autosaved', which will instead mark the buffer as having been -autosaved. +means mark the buffer as modified, but the special value +`autosaved' will instead mark the buffer as having been +autosaved since it was last modified. This function also locks or unlocks the file visited by the buffer, if both `buffer-file-truename' and `buffer-file-name' are non-nil. diff --git a/src/fileio.c b/src/fileio.c index 9da14c8f54..094516bfef 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5972,13 +5972,15 @@ do_auto_save_eh (Lisp_Object ignore) DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", doc: /* Auto-save all buffers that need it. -This is all buffers that have auto-saving enabled and are changed -since last auto-saved. +This auto-saves all buffers that have auto-saving enabled and +were changed since last auto-saved. -Auto-saving writes the buffer into a file so that your editing is not -lost if the system crashes. +Auto-saving writes the buffer into a file so that your edits are +not lost if the system crashes. + +The auto-save file is not the file you visited; that changes only +when you save. -This file is not the file you visited; that changes only when you save. Normally, run the normal hook `auto-save-hook' before saving. A non-nil NO-MESSAGE argument means do not print any message if successful. commit 000f13a2bc60428bf02157956b22ba23570b0725 Author: Lars Ingebrigtsen Date: Tue May 10 15:01:00 2022 +0200 Make `apropos-variable' include values in output * lisp/apropos.el (apropos-print): Include variable values in the output (bug#13842). diff --git a/etc/NEWS b/etc/NEWS index 212253d3db..13c8aacb2b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -476,6 +476,9 @@ This allows you to enter emoji using short strings, eg :face_palm: or ** Help +--- +*** 'M-x apropos-variable' output now includes values of variables. + +++ *** New doc string syntax to indicate that symbols shouldn't be links. When displaying doc strings in *Help* buffers, strings that are diff --git a/lisp/apropos.el b/lisp/apropos.el index 79c4df10d2..28184476e6 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -1247,6 +1247,19 @@ as a heading." 'apropos-user-option 'apropos-variable) (not nosubst)) + ;; Insert an excerpt of variable values. + (when (boundp symbol) + (insert " Value: ") + (let* ((print-escape-newlines t) + (value (prin1-to-string (symbol-value symbol))) + (truncated (truncate-string-to-width + value (- (window-width) 20) nil nil t))) + (insert truncated) + (unless (equal value truncated) + (buttonize-region (1- (point)) (point) + (lambda (_) + (message "Value: %s" value)))) + (insert "\n"))) (apropos-print-doc 7 'apropos-group t) (apropos-print-doc 6 'apropos-face t) (apropos-print-doc 5 'apropos-widget t) commit 66e4bf2bcb2c142c023837ce57d5763deffc7d8d Author: Eli Zaretskii Date: Tue May 10 15:53:51 2022 +0300 ; * etc/NEWS: Clarify recently-added entries. diff --git a/etc/NEWS b/etc/NEWS index 45682998db..212253d3db 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1583,7 +1583,7 @@ Emacs buffers, like indentation and the like. The new ert function This function was previously documented to return only nil or t. This has been changed to nil/'autosaved'/non-nil. The new 'autosaved' value means that the buffer is modified, but that it hasn't been -modified after the last auto-save. +modified since the time of last auto-save. --- ** 'with-silent-modifications' also restores buffer autosave status. @@ -1733,7 +1733,7 @@ functions. +++ *** 'restore-buffer-modified-p' can now alter buffer auto-save state. With a FLAG value of 'autosaved', it will mark the buffer as having -been auto-saved after the last modification. +been auto-saved since the time of last modification. --- *** New minor mode 'isearch-fold-quotes-mode'. commit 9beb04dd0700a63fdce65351465045587d10e064 Author: Eli Zaretskii Date: Tue May 10 15:47:06 2022 +0300 ; * doc/emacs/building.texi (Compilation Mode): Fix typo. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 892117e2e8..8f972de568 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -180,7 +180,7 @@ list of customization variables and faces. Emacs automatically visits the locus of the first error message that appears in the @file{*compilation*} buffer. (This variable can also have the values @code{if-location-known} and @code{first-known}, which -modifies whether to automatically visit.) +modify the conditions for automatically visiting the error locus.) Compilation mode provides the following additional commands. These commands can also be used in @file{*grep*} buffers, where the commit 145727df29d2e067b062cb44548dd97b076567fa Author: Po Lu Date: Tue May 10 17:38:53 2022 +0800 Fix display of depressed buttons * src/xterm.c (x_draw_relief_rect): Fix typo. diff --git a/src/xterm.c b/src/xterm.c index 3e5cd45b43..40c80eb1f7 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7588,7 +7588,7 @@ x_draw_relief_rect (struct frame *f, int left_x, int top_y, int right_x, if (top_p && left_p && bot_p && right_p && hwidth > 1 && vwidth > 1) x_draw_rectangle (f, black_gc, left_x, top_y, - right_x - left_x, top_y - bottom_y); + right_x - left_x, bottom_y - top_y); else { if (top_p && hwidth > 1) commit 773c5c00d23ccb78f491b30e67f77ebe5d38be1a Author: Po Lu Date: Tue May 10 09:00:39 2022 +0000 Improve relief rect handling on Haiku * haikuterm.c (haiku_calculate_relief_colors): Calculate backgrounds for image glyphs like on X. (haiku_draw_relief_rect): Remove extra parameter. (haiku_draw_string_box, haiku_draw_image_relief): Adjust accordingly. diff --git a/src/haikuterm.c b/src/haikuterm.c index 802d7d2ac2..26ea69758b 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -586,9 +586,9 @@ haiku_defined_color (struct frame *f, /* Adapted from xterm `x_draw_box_rect'. */ static void -haiku_draw_box_rect (struct glyph_string *s, - int left_x, int top_y, int right_x, int bottom_y, int hwidth, - int vwidth, bool left_p, bool right_p, struct haiku_rect *clip_rect) +haiku_draw_box_rect (struct glyph_string *s, int left_x, int top_y, + int right_x, int bottom_y, int hwidth, int vwidth, + bool left_p, bool right_p, struct haiku_rect *clip_rect) { void *view = FRAME_HAIKU_VIEW (s->f); struct face *face = s->face; @@ -612,13 +612,19 @@ static void haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, uint32_t *rgbout_b) { - struct face *face = s->face; double h, cs, l; uint32_t rgbin; struct haiku_output *di; - rgbin = (face->use_box_color_for_shadows_p - ? face->box_color : face->background); + if (s->face->use_box_color_for_shadows_p) + rgbin = s->face->box_color; + else if (s->first_glyph->type == IMAGE_GLYPH + && s->img->pixmap + && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0)) + rgbin = IMAGE_BACKGROUND (s->img, s->f, 0); + else + rgbin = s->face->background; + di = FRAME_OUTPUT_DATA (s->f); if (s->hl == DRAW_CURSOR) @@ -640,30 +646,35 @@ haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, } static void -haiku_draw_relief_rect (struct glyph_string *s, - int left_x, int top_y, int right_x, int bottom_y, - int hwidth, int vwidth, bool raised_p, bool top_p, - bool bot_p, bool left_p, bool right_p, - struct haiku_rect *clip_rect, bool fancy_p) +haiku_draw_relief_rect (struct glyph_string *s, int left_x, int top_y, + int right_x, int bottom_y, int hwidth, int vwidth, + bool raised_p, bool top_p, bool bot_p, bool left_p, + bool right_p, struct haiku_rect *clip_rect) { uint32_t color_white, color_black; void *view; + view = FRAME_HAIKU_VIEW (s->f); haiku_calculate_relief_colors (s, &color_white, &color_black); - view = FRAME_HAIKU_VIEW (s->f); BView_SetHighColor (view, raised_p ? color_white : color_black); + if (clip_rect) { BView_StartClip (view); haiku_clip_to_string (s); - BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width, - clip_rect->height); + BView_ClipToRect (view, clip_rect->x, clip_rect->y, + clip_rect->width, clip_rect->height); } + if (top_p) - BView_FillRectangle (view, left_x, top_y, right_x - left_x + 1, hwidth); + BView_FillRectangle (view, left_x, top_y, + right_x - left_x + 1, hwidth); + if (left_p) - BView_FillRectangle (view, left_x, top_y, vwidth, bottom_y - top_y + 1); + BView_FillRectangle (view, left_x, top_y, + vwidth, bottom_y - top_y + 1); + BView_SetHighColor (view, !raised_p ? color_white : color_black); if (bot_p) @@ -707,7 +718,7 @@ haiku_draw_relief_rect (struct glyph_string *s, BView_SetHighColor (view, s->face->background); /* Omit corner pixels. */ - if (hwidth > 1 || vwidth > 1) + if (hwidth > 1 && vwidth > 1) { if (left_p && top_p) BView_FillRectangle (view, left_x, top_y, 1, 1); @@ -989,7 +1000,7 @@ haiku_draw_string_box (struct glyph_string *s) else haiku_draw_relief_rect (s, left_x, top_y, right_x, bottom_y, hwidth, vwidth, raised_p, true, true, left_p, right_p, - NULL, 1); + NULL); } static void @@ -1611,7 +1622,7 @@ haiku_draw_image_relief (struct glyph_string *s) get_glyph_string_clip_rect (s, &r); haiku_draw_relief_rect (s, x, y, x1, y1, thick, thick, raised_p, - top_p, bot_p, left_p, right_p, &r, 0); + top_p, bot_p, left_p, right_p, &r); } static void commit e8d643eb835e2883e12032a7f25e94a8a3335c87 Author: Po Lu Date: Tue May 10 16:50:10 2022 +0800 Fix X11 relief background clearning when hwidth is larger than vwidth * src/xterm.c (x_fill_triangle, x_make_point, x_inside_rect_p): New functions. (x_draw_relief_rect): Complete rewrite. Use more sensible primitives. diff --git a/src/xterm.c b/src/xterm.c index c22a901ff4..3e5cd45b43 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7390,20 +7390,62 @@ x_setup_relief_colors (struct glyph_string *s) } } +#ifndef USE_CAIRO +static void +x_fill_triangle (struct frame *f, GC gc, XPoint point1, + XPoint point2, XPoint point3) +{ + XPoint abc[3]; + + abc[0] = point1; + abc[1] = point2; + abc[2] = point3; + + XFillPolygon (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), + gc, abc, 3, Convex, CoordModeOrigin); +} + +static XPoint +x_make_point (int x, int y) +{ + XPoint pt; + + pt.x = x; + pt.y = y; + + return pt; +} + +static bool +x_inside_rect_p (XRectangle *rects, int nrects, int x, int y) +{ + int i; + + for (i = 0; i < nrects; ++i) + { + if (x >= rects[i].x && y >= rects[i].y + && x < rects[i].x + rects[i].width + && y < rects[i].y + rects[i].height) + return true; + } + + return false; +} +#endif /* Draw a relief on frame F inside the rectangle given by LEFT_X, - TOP_Y, RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the relief - to draw, it must be >= 0. RAISED_P means draw a raised - relief. LEFT_P means draw a relief on the left side of - the rectangle. RIGHT_P means draw a relief on the right - side of the rectangle. CLIP_RECT is the clipping rectangle to use - when drawing. */ + TOP_Y, RIGHT_X, and BOTTOM_Y. VWIDTH and HWIDTH are respectively + the thickness of the vertical relief (left and right) and + horizontal relief (top and bottom) to draw, it must be >= 0. + RAISED_P means draw a raised relief. LEFT_P means draw a relief on + the left side of the rectangle. RIGHT_P means draw a relief on the + right side of the rectangle. CLIP_RECT is the clipping rectangle + to use when drawing. */ static void -x_draw_relief_rect (struct frame *f, - int left_x, int top_y, int right_x, int bottom_y, - int hwidth, int vwidth, bool raised_p, bool top_p, bool bot_p, - bool left_p, bool right_p, +x_draw_relief_rect (struct frame *f, int left_x, int top_y, int right_x, + int bottom_y, int hwidth, int vwidth, bool raised_p, + bool top_p, bool bot_p, bool left_p, bool right_p, XRectangle *clip_rect) { #ifdef USE_CAIRO @@ -7479,90 +7521,116 @@ x_draw_relief_rect (struct frame *f, x_reset_clip_rectangles (f, top_left_gc); x_reset_clip_rectangles (f, bottom_right_gc); #else - Display *dpy = FRAME_X_DISPLAY (f); - Drawable drawable = FRAME_X_DRAWABLE (f); - int i; - GC gc; - - if (raised_p) - gc = f->output_data.x->white_relief.gc; - else - gc = f->output_data.x->black_relief.gc; - XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted); + GC gc, white_gc, black_gc, normal_gc; + Drawable drawable; + Display *dpy; /* This code is more complicated than it has to be, because of two minor hacks to make the boxes look nicer: (i) if width > 1, draw the outermost line using the black relief. (ii) Omit the four corner pixels. */ - /* Top. */ - if (top_p) - { - if (hwidth == 1) - XDrawLine (dpy, drawable, gc, - left_x + left_p, top_y, - right_x + !right_p, top_y); + white_gc = f->output_data.x->white_relief.gc; + black_gc = f->output_data.x->black_relief.gc; + normal_gc = f->output_data.x->normal_gc; - for (i = 1; i < hwidth; ++i) - XDrawLine (dpy, drawable, gc, - left_x + i * left_p, top_y + i, - right_x + 1 - i * right_p, top_y + i); - } + drawable = FRAME_X_DRAWABLE (f); + dpy = FRAME_X_DISPLAY (f); - /* Left. */ - if (left_p) - { - if (vwidth == 1) - XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y); + x_set_clip_rectangles (f, white_gc, clip_rect, 1); + x_set_clip_rectangles (f, black_gc, clip_rect, 1); - for (i = 1; i < vwidth; ++i) - XDrawLine (dpy, drawable, gc, - left_x + i, top_y + (i + 1) * top_p, - left_x + i, bottom_y + 1 - (i + 1) * bot_p); - } - - XSetClipMask (dpy, gc, None); if (raised_p) - gc = f->output_data.x->black_relief.gc; + gc = white_gc; else - gc = f->output_data.x->white_relief.gc; - XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted); + gc = black_gc; - /* Outermost top line. */ - if (top_p && hwidth > 1) - XDrawLine (dpy, drawable, gc, - left_x + left_p, top_y, - right_x + !right_p, top_y); + /* Draw lines. */ - /* Outermost left line. */ - if (left_p && vwidth > 1) - XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y); + if (top_p) + x_fill_rectangle (f, gc, left_x, top_y, + right_x - left_x + 1, hwidth, + false); + + if (left_p) + x_fill_rectangle (f, gc, left_x, top_y, vwidth, + bottom_y - top_y + 1, false); + + if (raised_p) + gc = black_gc; + else + gc = white_gc; - /* Bottom. */ if (bot_p) + x_fill_rectangle (f, gc, left_x, bottom_y - hwidth + 1, + right_x - left_x + 1, hwidth, false); + + if (right_p) + x_fill_rectangle (f, gc, right_x - vwidth + 1, top_y, + vwidth, bottom_y - top_y + 1, false); + + /* Draw corners. */ + + if (bot_p && left_p) + x_fill_triangle (f, raised_p ? white_gc : black_gc, + x_make_point (left_x, bottom_y - hwidth), + x_make_point (left_x + vwidth, bottom_y - hwidth), + x_make_point (left_x, bottom_y)); + + if (top_p && right_p) + x_fill_triangle (f, raised_p ? white_gc : black_gc, + x_make_point (right_x - vwidth, top_y), + x_make_point (right_x, top_y), + x_make_point (right_x - vwidth, top_y + hwidth)); + + /* Draw outer line. */ + + if (top_p && left_p && bot_p && right_p + && hwidth > 1 && vwidth > 1) + x_draw_rectangle (f, black_gc, left_x, top_y, + right_x - left_x, top_y - bottom_y); + else { - if (hwidth >= 1) - XDrawLine (dpy, drawable, gc, - left_x + left_p, bottom_y, - right_x + !right_p, bottom_y); + if (top_p && hwidth > 1) + XDrawLine (dpy, drawable, black_gc, left_x, top_y, + right_x + 1, top_y); + + if (bot_p && hwidth > 1) + XDrawLine (dpy, drawable, black_gc, left_x, bottom_y, + right_x + 1, bottom_y); + + if (left_p && vwidth > 1) + XDrawLine (dpy, drawable, black_gc, left_x, top_y, + left_x, bottom_y + 1); - for (i = 1; i < hwidth; ++i) - XDrawLine (dpy, drawable, gc, - left_x + i * left_p, bottom_y - i, - right_x + 1 - i * right_p, bottom_y - i); + if (right_p && vwidth > 1) + XDrawLine (dpy, drawable, black_gc, right_x, top_y, + right_x, bottom_y + 1); } - /* Right. */ - if (right_p) + /* Erase corners. */ + + if (hwidth > 1 && vwidth > 1) { - for (i = 0; i < vwidth; ++i) - XDrawLine (dpy, drawable, gc, - right_x - i, top_y + (i + 1) * top_p, - right_x - i, bottom_y + 1 - (i + 1) * bot_p); - } + if (left_p && top_p && x_inside_rect_p (clip_rect, 1, + left_x, top_y)) + x_clear_rectangle (f, normal_gc, left_x, top_y, 1, 1, false); - x_reset_clip_rectangles (f, gc); + if (left_p && bot_p && x_inside_rect_p (clip_rect, 1, + left_x, bottom_y)) + x_clear_rectangle (f, normal_gc, left_x, bottom_y, 1, 1, false); + + if (right_p && top_p && x_inside_rect_p (clip_rect, 1, + right_x, top_y)) + x_clear_rectangle (f, normal_gc, right_x, top_y, 1, 1, false); + + if (right_p && bot_p && x_inside_rect_p (clip_rect, 1, + right_x, bottom_y)) + x_clear_rectangle (f, normal_gc, right_x, bottom_y, 1, 1, false); + } + x_reset_clip_rectangles (f, white_gc); + x_reset_clip_rectangles (f, black_gc); #endif } commit c7b48b61d08f0b6a08584080badc60fe62ba1db1 Author: Po Lu Date: Tue May 10 16:01:00 2022 +0800 Improve display of reliefs on NS * src/nsfont.m (nsfont_draw): Don't compensate for left box twice. * src/nsterm.m (ns_draw_relief): Draw outer edges of box like on X. diff --git a/src/nsfont.m b/src/nsfont.m index e913a50cb6..ae5e134e15 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1177,9 +1177,6 @@ is false when (FROM > 0 || TO < S->nchars). */ face = s->face; r.origin.x = x; - if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - r.origin.x += max (s->face->box_vertical_line_width, 0); - r.origin.y = y; r.size.height = FONT_HEIGHT (font); diff --git a/src/nsterm.m b/src/nsterm.m index 8206203333..238a842d78 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3450,36 +3450,32 @@ larger if there are taller display elements (e.g., characters static void ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p, - char top_p, char bottom_p, char left_p, char right_p, - struct glyph_string *s) + char top_p, char bottom_p, char left_p, char right_p, + struct glyph_string *s) /* -------------------------------------------------------------------------- Draw a relief rect inside r, optionally leaving some sides open. Note we can't just use an NSDrawBezel command, because of the possibility of some sides not being drawn, and because the rect will be filled. -------------------------------------------------------------------------- */ { - static NSColor *baseCol = nil, *lightCol = nil, *darkCol = nil; - NSColor *newBaseCol = nil; + static NSColor *baseCol, *lightCol, *darkCol; + NSColor *newBaseCol; NSRect inner; + NSBezierPath *p; + + baseCol = nil; + lightCol = nil; + newBaseCol = nil; + p = nil; NSTRACE ("ns_draw_relief"); /* set up colors */ if (s->face->use_box_color_for_shadows_p) - { - newBaseCol = [NSColor colorWithUnsignedLong:s->face->box_color]; - } -/* else if (s->first_glyph->type == IMAGE_GLYPH - && s->img->pixmap - && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0)) - { - newBaseCol = IMAGE_BACKGROUND (s->img, s->f, 0); - } */ + newBaseCol = [NSColor colorWithUnsignedLong: s->face->box_color]; else - { - newBaseCol = [NSColor colorWithUnsignedLong:s->face->background]; - } + newBaseCol = [NSColor colorWithUnsignedLong: s->face->background]; if (newBaseCol == nil) newBaseCol = [NSColor grayColor]; @@ -3498,26 +3494,27 @@ larger if there are taller display elements (e.g., characters inner = NSMakeRect (NSMinX (outer) + (left_p ? hthickness : 0), NSMinY (outer) + (top_p ? vthickness : 0), NSWidth (outer) - (left_p ? hthickness : 0) - - (right_p ? hthickness : 0), + - (right_p ? hthickness : 0), NSHeight (outer) - (top_p ? vthickness : 0) - - (bottom_p ? vthickness : 0)); + - (bottom_p ? vthickness : 0)); [(raised_p ? lightCol : darkCol) set]; if (top_p || left_p) { - NSBezierPath *p = [NSBezierPath bezierPath]; - [p moveToPoint:NSMakePoint (NSMinX (outer), NSMinY (outer))]; + p = [NSBezierPath bezierPath]; + + [p moveToPoint: NSMakePoint (NSMinX (outer), NSMinY (outer))]; if (top_p) { - [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))]; - [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), NSMinY (outer))]; + [p lineToPoint :NSMakePoint (NSMaxX (inner), NSMinY (inner))]; } - [p lineToPoint:NSMakePoint (NSMinX (inner), NSMinY (inner))]; + [p lineToPoint: NSMakePoint (NSMinX (inner), NSMinY (inner))]; if (left_p) { - [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))]; - [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))]; + [p lineToPoint: NSMakePoint (NSMinX (inner), NSMaxY (inner))]; + [p lineToPoint: NSMakePoint (NSMinX (outer), NSMaxY (outer))]; } [p closePath]; [p fill]; @@ -3525,24 +3522,68 @@ larger if there are taller display elements (e.g., characters [(raised_p ? darkCol : lightCol) set]; - if (bottom_p || right_p) + if (bottom_p || right_p) { - NSBezierPath *p = [NSBezierPath bezierPath]; - [p moveToPoint:NSMakePoint (NSMaxX (outer), NSMaxY (outer))]; + p = [NSBezierPath bezierPath]; + + [p moveToPoint: NSMakePoint (NSMaxX (outer), NSMaxY (outer))]; if (right_p) { - [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))]; - [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), NSMinY (outer))]; + [p lineToPoint: NSMakePoint (NSMaxX (inner), NSMinY (inner))]; } [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMaxY (inner))]; if (bottom_p) { - [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))]; - [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))]; + [p lineToPoint: NSMakePoint (NSMinX (inner), NSMaxY (inner))]; + [p lineToPoint: NSMakePoint (NSMinX (outer), NSMaxY (outer))]; } [p closePath]; [p fill]; } + + /* If one of h/vthickness are more than 1, draw the outermost line + on the respective sides in the black relief color. */ + + if (p) + [p removeAllPoints]; + else + p = [NSBezierPath bezierPath]; + + if (hthickness > 1 && top_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer), + NSMinY (outer) + 0.5)]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), + NSMinY (outer) + 0.5)]; + } + + if (hthickness > 1 && bottom_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer), + NSMaxY (outer) - 0.5)]; + [p lineToPoint: NSMakePoint (NSMaxX (outer), + NSMaxY (outer) - 0.5)]; + } + + if (vthickness > 1 && left_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMinY (outer) + 0.5)]; + [p lineToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMaxY (outer) - 0.5)]; + } + + if (vthickness > 1 && left_p) + { + [p moveToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMinY (outer) + 0.5)]; + [p lineToPoint: NSMakePoint (NSMinX (outer) + 0.5, + NSMaxY (outer) - 0.5)]; + } + + [darkCol set]; + [p stroke]; } @@ -3624,6 +3665,7 @@ Function modeled after x_draw_glyph_string_box (). if (!s->background_filled_p/* || s->hl == DRAW_MOUSE_FACE*/) { int box_line_width = max (s->face->box_horizontal_line_width, 0); + if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font dimensions, since the actual glyphs might be much @@ -3650,7 +3692,7 @@ Function modeled after x_draw_glyph_string_box (). NSRect r = NSMakeRect (s->x, s->y + box_line_width, s->background_width, - s->height-2*box_line_width); + s->height - 2 * box_line_width); NSRectFill (r); s->background_filled_p = 1; commit 88545428f0962081e776d903e05dd787677b320a Author: Po Lu Date: Tue May 10 14:40:26 2022 +0800 Handle deletion of opacity property too * src/xterm.c (handle_one_xevent): Clear `alpha' frame parameter when opacity prop is gone or invalid. diff --git a/src/xterm.c b/src/xterm.c index 5818eb1d02..c22a901ff4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14856,6 +14856,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, { f->alpha[0] = 1.0; f->alpha[1] = 1.0; + + store_frame_param (f, Qalpha, Qnil); } else { @@ -14878,6 +14880,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, store_frame_param (f, Qalpha, make_float (f->alpha[0])); } + else + { + f->alpha[0] = 1.0; + f->alpha[1] = 1.0; + + store_frame_param (f, Qalpha, Qnil); + } } if (tmp_data) commit 58f6cbeb58c2394f6360e97d1a6e49c1c1df3166 Author: Po Lu Date: Tue May 10 14:38:22 2022 +0800 Work around some broken programs when reading opacity prop * src/xterm.c (handle_one_xevent): Accept some other types that property is set to by thoughtless programs. diff --git a/src/xterm.c b/src/xterm.c index de3129fd87..5818eb1d02 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14861,11 +14861,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, { rc = XGetWindowProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), dpyinfo->Xatom_net_wm_window_opacity, - 0, 1, False, XA_CARDINAL, &actual, + 0, 1, False, AnyPropertyType, &actual, &actual_format, &n, &left, &tmp_data); if (rc == Success && actual_format == 32 - && actual == XA_CARDINAL && n) + && (actual == XA_CARDINAL + /* Some broken programs set the opacity property + to those types, but window managers accept + them anyway. */ + || actual == XA_ATOM + || actual == XA_WINDOW) && n) { opacity = *(unsigned long *) tmp_data & OPAQUE; f->alpha[0] = (double) opacity / (double) OPAQUE; commit d221c02fa1db17e1275687f0bbce4ff1499119a1 Author: Lars Ingebrigtsen Date: Tue May 10 07:05:43 2022 +0200 Fix bibtex-map-entries regression at bobp * lisp/textmodes/bibtex.el (bibtex-map-entries): Fix regression introduced by c32e8b33f (bug#55342) -- don't fail when the first entry is at bobp. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 62a4af1377..544e0da827 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -2298,11 +2298,11 @@ is non-nil, FUN is not called for @String entries." (set-marker-insertion-type end-marker t) (save-excursion (goto-char (point-min)) - (let ((prev (point))) + (let ((prev nil)) (while (setq found (bibtex-skip-to-valid-entry)) ;; If we have invalid entries, ensure that we have forward ;; progress so that we don't infloop. - (if (= (point) prev) + (if (equal (point) prev) (forward-line 1) (setq prev (point)) (set-marker end-marker (cdr found)) commit 93a74773b61334905ff174537b63647e495fef95 Merge: 3c5e1f8ec8 7b4bdf7b9b Author: Stefan Kangas Date: Tue May 10 06:30:34 2022 +0200 Merge from origin/emacs-28 7b4bdf7b9b Remove the AUCTeX subsection from MS-Windows FAQ d2a5631552 Update AUCTeX FAQ entry 177718bc6d Update string-to-number documentation to bignum Emacs 74cc3b525f Fix doc string references to tags-loop-continue commit 3c5e1f8ec8d5d52e5bbf185d9618852e7d04e3ca Author: Po Lu Date: Tue May 10 04:11:32 2022 +0000 Simplify Haiku selection code * src/haiku_select.cc (get_clipboard_object): New function. (BClipboard_find_data, BClipboard_get_targets, BClipboard_set_data) (BClipboard_find_system_data) (BClipboard_find_primary_selection_data) (BClipboard_find_secondary_selection_data) (BClipboard_set_system_data, BClipboard_set_primary_selection_data) (BClipboard_set_secondary_selection_data, BClipboard_free_data) (BClipboard_system_targets, BClipboard_primary_targets) (BClipboard_secondary_targets): Delete functions. (be_find_clipboard_data_1, be_set_clipboard_data_1) (be_get_clipboard_targets_1, be_find_clipboard_data) (be_set_clipboard_data, be_get_clipboard_targets): New functions. (be_lock_clipboard_message, be_unlock_clipboard): Use `get_clipboard_object' to get clipboard from ID. * src/haikuselect.c (haiku_get_clipboard_name): New function. (Fhaiku_selection_data, Fhaiku_selection_put) (Fhaiku_selection_owner_p): Adjust to use new simplified functions. * src/haikuselect.h: Update prototypes. diff --git a/src/haiku_select.cc b/src/haiku_select.cc index a26a0049cb..43b71138b3 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -35,22 +35,45 @@ static int64 count_clipboard = -1; static int64 count_primary = -1; static int64 count_secondary = -1; +static BClipboard * +get_clipboard_object (enum haiku_clipboard clipboard) +{ + switch (clipboard) + { + case CLIPBOARD_PRIMARY: + return primary; + + case CLIPBOARD_SECONDARY: + return secondary; + + case CLIPBOARD_CLIPBOARD: + return system_clipboard; + } + + abort (); +} + static char * -BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) +be_find_clipboard_data_1 (BClipboard *cb, const char *type, ssize_t *len) { + BMessage *data; + const char *ptr; + ssize_t nbytes; + void *value; + if (!cb->Lock ()) - return 0; + return NULL; - BMessage *dat = cb->Data (); - if (!dat) + data = cb->Data (); + + if (!data) { cb->Unlock (); - return 0; + return NULL; } - const char *ptr; - ssize_t bt; - dat->FindData (type, B_MIME_TYPE, (const void **) &ptr, &bt); + data->FindData (type, B_MIME_TYPE, (const void **) &ptr, + &nbytes); if (!ptr) { @@ -59,9 +82,9 @@ BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) } if (len) - *len = bt; + *len = nbytes; - void *data = malloc (bt); + value = malloc (nbytes); if (!data) { @@ -69,13 +92,14 @@ BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) return NULL; } - memcpy (data, ptr, bt); + memcpy (value, ptr, nbytes); cb->Unlock (); - return (char *) data; + + return (char *) value; } static void -BClipboard_get_targets (BClipboard *cb, char **buf, int buf_size) +be_get_clipboard_targets_1 (BClipboard *cb, char **buf, int buf_size) { BMessage *data; char *name; @@ -122,116 +146,60 @@ BClipboard_get_targets (BClipboard *cb, char **buf, int buf_size) } static void -BClipboard_set_data (BClipboard *cb, const char *type, const char *dat, - ssize_t len, bool clear) +be_set_clipboard_data_1 (BClipboard *cb, const char *type, const char *data, + ssize_t len, bool clear) { + BMessage *message_data; + if (!cb->Lock ()) return; if (clear) cb->Clear (); - BMessage *mdat = cb->Data (); - if (!mdat) + message_data = cb->Data (); + + if (!message_data) { cb->Unlock (); return; } - if (dat) + if (data) { - if (mdat->ReplaceData (type, B_MIME_TYPE, dat, len) + if (message_data->ReplaceData (type, B_MIME_TYPE, data, len) == B_NAME_NOT_FOUND) - mdat->AddData (type, B_MIME_TYPE, dat, len); + message_data->AddData (type, B_MIME_TYPE, data, len); } else - mdat->RemoveName (type); + message_data->RemoveName (type); + cb->Commit (); cb->Unlock (); } char * -BClipboard_find_system_data (const char *type, ssize_t *len) -{ - if (!system_clipboard) - return 0; - - return BClipboard_find_data (system_clipboard, type, len); -} - -char * -BClipboard_find_primary_selection_data (const char *type, ssize_t *len) -{ - if (!primary) - return 0; - - return BClipboard_find_data (primary, type, len); -} - -char * -BClipboard_find_secondary_selection_data (const char *type, ssize_t *len) -{ - if (!secondary) - return 0; - - return BClipboard_find_data (secondary, type, len); -} - -void -BClipboard_set_system_data (const char *type, const char *data, - ssize_t len, bool clear) -{ - if (!system_clipboard) - return; - - count_clipboard = system_clipboard->SystemCount (); - BClipboard_set_data (system_clipboard, type, data, len, clear); -} - -void -BClipboard_set_primary_selection_data (const char *type, const char *data, - ssize_t len, bool clear) -{ - if (!primary) - return; - - count_primary = primary->SystemCount (); - BClipboard_set_data (primary, type, data, len, clear); -} - -void -BClipboard_set_secondary_selection_data (const char *type, const char *data, - ssize_t len, bool clear) +be_find_clipboard_data (enum haiku_clipboard id, const char *type, + ssize_t *len) { - if (!secondary) - return; - - count_secondary = secondary->SystemCount (); - BClipboard_set_data (secondary, type, data, len, clear); + return be_find_clipboard_data_1 (get_clipboard_object (id), + type, len); } void -BClipboard_free_data (void *ptr) +be_set_clipboard_data (enum haiku_clipboard id, const char *type, + const char *data, ssize_t len, bool clear) { - std::free (ptr); + be_set_clipboard_data_1 (get_clipboard_object (id), type, + data, len, clear); } void -BClipboard_system_targets (char **buf, int len) +be_get_clipboard_targets (enum haiku_clipboard id, char **targets, + int len) { - BClipboard_get_targets (system_clipboard, buf, len); -} - -void -BClipboard_primary_targets (char **buf, int len) -{ - BClipboard_get_targets (primary, buf, len); -} - -void -BClipboard_secondary_targets (char **buf, int len) -{ - BClipboard_get_targets (secondary, buf, len); + be_get_clipboard_targets_1 (get_clipboard_object (id), targets, + len); } bool @@ -443,12 +411,7 @@ be_lock_clipboard_message (enum haiku_clipboard clipboard, { BClipboard *board; - if (clipboard == CLIPBOARD_PRIMARY) - board = primary; - else if (clipboard == CLIPBOARD_SECONDARY) - board = secondary; - else - board = system_clipboard; + board = get_clipboard_object (clipboard); if (!board->Lock ()) return 1; @@ -465,12 +428,7 @@ be_unlock_clipboard (enum haiku_clipboard clipboard, bool discard) { BClipboard *board; - if (clipboard == CLIPBOARD_PRIMARY) - board = primary; - else if (clipboard == CLIPBOARD_SECONDARY) - board = secondary; - else - board = system_clipboard; + board = get_clipboard_object (clipboard); if (discard) board->Revert (); diff --git a/src/haikuselect.c b/src/haikuselect.c index 8ce7182298..0c808bdb93 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -35,6 +35,21 @@ struct frame *haiku_dnd_frame; static void haiku_lisp_to_message (Lisp_Object, void *); +static enum haiku_clipboard +haiku_get_clipboard_name (Lisp_Object clipboard) +{ + if (EQ (clipboard, QPRIMARY)) + return CLIPBOARD_PRIMARY; + + if (EQ (clipboard, QSECONDARY)) + return CLIPBOARD_SECONDARY; + + if (EQ (clipboard, QCLIPBOARD)) + return CLIPBOARD_CLIPBOARD; + + signal_error ("Invalid clipboard", clipboard); +} + DEFUN ("haiku-selection-data", Fhaiku_selection_data, Shaiku_selection_data, 2, 2, 0, doc: /* Retrieve content typed as NAME from the clipboard @@ -53,22 +68,15 @@ message in the format accepted by `haiku-drag-message', which see. */) int rc; CHECK_SYMBOL (clipboard); - - if (!EQ (clipboard, QPRIMARY) && !EQ (clipboard, QSECONDARY) - && !EQ (clipboard, QCLIPBOARD)) - signal_error ("Invalid clipboard", clipboard); + clipboard_name = haiku_get_clipboard_name (clipboard); if (!NILP (name)) { CHECK_STRING (name); block_input (); - if (EQ (clipboard, QPRIMARY)) - dat = BClipboard_find_primary_selection_data (SSDATA (name), &len); - else if (EQ (clipboard, QSECONDARY)) - dat = BClipboard_find_secondary_selection_data (SSDATA (name), &len); - else - dat = BClipboard_find_system_data (SSDATA (name), &len); + dat = be_find_clipboard_data (clipboard_name, + SSDATA (name), &len); unblock_input (); if (!dat) @@ -83,18 +91,11 @@ message in the format accepted by `haiku-drag-message', which see. */) Qforeign_selection, Qt, str); block_input (); - BClipboard_free_data (dat); + free (dat); unblock_input (); } else { - if (EQ (clipboard, QPRIMARY)) - clipboard_name = CLIPBOARD_PRIMARY; - else if (EQ (clipboard, QSECONDARY)) - clipboard_name = CLIPBOARD_SECONDARY; - else - clipboard_name = CLIPBOARD_CLIPBOARD; - block_input (); rc = be_lock_clipboard_message (clipboard_name, &message, false); unblock_input (); @@ -139,17 +140,11 @@ In that case, the arguments after NAME are ignored. */) int rc; void *message; + CHECK_SYMBOL (clipboard); + clipboard_name = haiku_get_clipboard_name (clipboard); + if (CONSP (name) || NILP (name)) { - if (EQ (clipboard, QPRIMARY)) - clipboard_name = CLIPBOARD_PRIMARY; - else if (EQ (clipboard, QSECONDARY)) - clipboard_name = CLIPBOARD_SECONDARY; - else if (EQ (clipboard, QCLIPBOARD)) - clipboard_name = CLIPBOARD_CLIPBOARD; - else - signal_error ("Invalid clipboard", clipboard); - rc = be_lock_clipboard_message (clipboard_name, &message, true); @@ -164,7 +159,6 @@ In that case, the arguments after NAME are ignored. */) return unbind_to (ref, Qnil); } - CHECK_SYMBOL (clipboard); CHECK_STRING (name); if (!NILP (data)) CHECK_STRING (data); @@ -172,20 +166,8 @@ In that case, the arguments after NAME are ignored. */) dat = !NILP (data) ? SSDATA (data) : NULL; len = !NILP (data) ? SBYTES (data) : 0; - if (EQ (clipboard, QPRIMARY)) - BClipboard_set_primary_selection_data (SSDATA (name), dat, len, - !NILP (clear)); - else if (EQ (clipboard, QSECONDARY)) - BClipboard_set_secondary_selection_data (SSDATA (name), dat, len, - !NILP (clear)); - else if (EQ (clipboard, QCLIPBOARD)) - BClipboard_set_system_data (SSDATA (name), dat, len, !NILP (clear)); - else - { - unblock_input (); - signal_error ("Bad clipboard", clipboard); - } - + be_set_clipboard_data (clipboard_name, SSDATA (name), dat, len, + !NILP (clear)); return Qnil; } @@ -193,18 +175,11 @@ DEFUN ("haiku-selection-owner-p", Fhaiku_selection_owner_p, Shaiku_selection_own 0, 1, 0, doc: /* Whether the current Emacs process owns the given SELECTION. The arg should be the name of the selection in question, typically one -of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. For -convenience, the symbol nil is the same as `PRIMARY', and t is the -same as `SECONDARY'. */) +of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. */) (Lisp_Object selection) { bool value; - if (NILP (selection)) - selection = QPRIMARY; - else if (EQ (selection, Qt)) - selection = QSECONDARY; - block_input (); if (EQ (selection, QPRIMARY)) value = BClipboard_owns_primary (); diff --git a/src/haikuselect.h b/src/haikuselect.h index d4f331a9cc..b63d3c3653 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -41,28 +41,15 @@ extern void init_haiku_select (void); #endif /* Whether or not the selection was recently changed. */ -/* Find a string with the MIME type TYPE in the system clipboard. */ -extern char *BClipboard_find_system_data (const char *, ssize_t *); -extern char *BClipboard_find_primary_selection_data (const char *, ssize_t *); -extern char *BClipboard_find_secondary_selection_data (const char *, ssize_t *); - -extern void BClipboard_set_system_data (const char *, const char *, ssize_t, bool); -extern void BClipboard_set_primary_selection_data (const char *, const char *, - ssize_t, bool); -extern void BClipboard_set_secondary_selection_data (const char *, const char *, - ssize_t, bool); - -extern void BClipboard_system_targets (char **, int); -extern void BClipboard_primary_targets (char **, int); -extern void BClipboard_secondary_targets (char **, int); +extern char *be_find_clipboard_data (enum haiku_clipboard, const char *, ssize_t *); +extern void be_set_clipboard_data (enum haiku_clipboard, const char *, const char *, + ssize_t, bool); +extern void be_get_clipboard_targets (enum haiku_clipboard, char **, int); extern bool BClipboard_owns_clipboard (void); extern bool BClipboard_owns_primary (void); extern bool BClipboard_owns_secondary (void); -/* Free the returned data. */ -extern void BClipboard_free_data (void *); - extern int be_enum_message (void *, int32 *, int32, int32 *, const char **); extern int be_get_message_data (void *, const char *, int32, int32, const void **, ssize_t *); commit e568c3845cd98b702ce23bdef1b22e088769c9cd Author: Lars Ingebrigtsen Date: Tue May 10 05:58:33 2022 +0200 Add more compilation-auto-jump-to-first-error options * doc/emacs/building.texi (Compilation Mode): Document it. * lisp/progmodes/compile.el (compilation-auto-jump-to-first-error): Extend type. (compilation--file-known-p): New function. (compilation-auto-jump): Use it to support the new values (bug#8228). (compilation-find-file-1): Factored out into own function. (compilation-find-file): Factored out from here. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 994ad46033..892117e2e8 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -178,7 +178,9 @@ list of customization variables and faces. If you change the variable @code{compilation-auto-jump-to-first-error} to a non-@code{nil} value, Emacs automatically visits the locus of the first error message that -appears in the @file{*compilation*} buffer. +appears in the @file{*compilation*} buffer. (This variable can also +have the values @code{if-location-known} and @code{first-known}, which +modifies whether to automatically visit.) Compilation mode provides the following additional commands. These commands can also be used in @file{*grep*} buffers, where the diff --git a/etc/NEWS b/etc/NEWS index 8404a3616e..45682998db 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -810,6 +810,12 @@ which is a change in behaviour from previous Emacs versions. ** Compile ++++ +*** The 'compilation-auto-jump-to-first-error' has been extended. +It can now have the additional values 'if-location-known' (which will +only jump if the location of the first error is known), and +'first-known' (which will jump to the first known error location). + +++ *** New user option 'compilation-max-output-line-length'. Lines longer than this will have the ends hidden, with a button to diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 2c5f4687ac..5545b4cd4a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -951,7 +951,10 @@ Faces `compilation-error-face', `compilation-warning-face', (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error during compilation." - :type 'boolean + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "If location known" if-location-known) + (const :tag "First known location" first-known)) :version "23.1") (defvar-local compilation-auto-jump-to-next nil @@ -1182,14 +1185,39 @@ POS and RES.") l2 (setcdr l1 (cons (list ,key) l2))))))) +(defun compilation--file-known-p () + "Say whether the file under point can be found." + (when-let* ((msg (get-text-property (point) 'compilation-message)) + (loc (compilation--message->loc msg)) + (elem (compilation-find-file-1 + (point-marker) + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc))) + (compilation--file-struct->formats + (compilation--loc->file-struct loc))))) + (car elem))) + (defun compilation-auto-jump (buffer pos) (when (buffer-live-p buffer) (with-current-buffer buffer (goto-char pos) (let ((win (get-buffer-window buffer 0))) (if win (set-window-point win pos))) - (if compilation-auto-jump-to-first-error - (compile-goto-error))))) + (when compilation-auto-jump-to-first-error + (cl-case compilation-auto-jump-to-first-error + ('if-location-known + (when (compilation--file-known-p) + (compile-goto-error))) + ('first-known + (let (match) + (while (and (not (compilation--file-known-p)) + (setq match (text-property-search-forward + 'compilation-message nil nil t))) + (goto-char (prop-match-beginning match)))) + (when (compilation--file-known-p) + (compile-goto-error))) + (otherwise + (compile-goto-error))))))) ;; This function is the central driver, called when font-locking to gather ;; all information needed to later jump to corresponding source code. @@ -2974,19 +3002,7 @@ and overlay is highlighted between MK and END-MK." (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) -(defun compilation-find-file (marker filename directory &rest formats) - "Find a buffer for file FILENAME. -If FILENAME is not found at all, ask the user where to find it. -Pop up the buffer containing MARKER and scroll to MARKER if we ask -the user where to find the file. -Search the directories in `compilation-search-path'. -A nil in `compilation-search-path' means to try the -\"current\" directory, which is passed in DIRECTORY. -If DIRECTORY is relative, it is combined with `default-directory'. -If DIRECTORY is nil, that means use `default-directory'. -FORMATS, if given, is a list of formats to reformat FILENAME when -looking for it: for each element FMT in FORMATS, this function -attempts to find a file whose name is produced by (format FMT FILENAME)." +(defun compilation-find-file-1 (marker filename directory &optional formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) (spec-dir (if directory @@ -3035,6 +3051,23 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (find-file-noselect name)) fmts (cdr fmts))) (setq dirs (cdr dirs)))) + (list buffer spec-dir))) + +(defun compilation-find-file (marker filename directory &rest formats) + "Find a buffer for file FILENAME. +If FILENAME is not found at all, ask the user where to find it. +Pop up the buffer containing MARKER and scroll to MARKER if we ask +the user where to find the file. +Search the directories in `compilation-search-path'. +A nil in `compilation-search-path' means to try the +\"current\" directory, which is passed in DIRECTORY. +If DIRECTORY is relative, it is combined with `default-directory'. +If DIRECTORY is nil, that means use `default-directory'. +FORMATS, if given, is a list of formats to reformat FILENAME when +looking for it: for each element FMT in FORMATS, this function +attempts to find a file whose name is produced by (format FMT FILENAME)." + (pcase-let ((`(,buffer ,spec-dir) + (compilation-find-file-1 marker filename directory formats))) (while (null buffer) ;Repeat until the user selects an existing file. ;; The file doesn't exist. Ask the user where to find it. (save-excursion ;This save-excursion is probably not right. commit 2d0085f756572856a2ed8d1bf043b59195a3e3f3 Author: Lars Ingebrigtsen Date: Tue May 10 05:09:15 2022 +0200 Make dabbrev use the buffer's file name as a source for completions * lisp/dabbrev.el (dabbrev--find-expansion): Include the buffer's file name in the completions (bug#8163). diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index b04128cf67..8f8d553cda 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -551,8 +551,9 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." (if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found) (minibuffer-window-active-p (selected-window)))) (progn - (message "Expansion found in `%s'" - (buffer-name dabbrev--last-buffer)) + (when (buffer-name dabbrev--last-buffer) + (message "Expansion found in `%s'" + (buffer-name dabbrev--last-buffer))) (setq dabbrev--last-buffer-found dabbrev--last-buffer)) (message nil)) (if (and (or (eq (current-buffer) dabbrev--last-buffer) @@ -770,17 +771,38 @@ of the start of the occurrence." (make-progress-reporter "Scanning for dabbrevs..." (- (length dabbrev--friend-buffer-list)) 0 0 1 1.5)))) - ;; Walk through the buffers till we find a match. - (let (expansion) - (while (and (not expansion) dabbrev--friend-buffer-list) - (setq dabbrev--last-buffer (pop dabbrev--friend-buffer-list)) - (set-buffer dabbrev--last-buffer) - (progress-reporter-update dabbrev--progress-reporter - (- (length dabbrev--friend-buffer-list))) - (setq dabbrev--last-expansion-location (point-min)) - (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case))) - (progress-reporter-done dabbrev--progress-reporter) - expansion))))) + (let ((file-name (buffer-file-name)) + file-name-buffer) + (unwind-protect + (progn + ;; Include the file name components into the abbrev + ;; list (because if you have a file name "foobar", it's + ;; somewhat likely that you'll be talking about foobar + ;; stuff in the file itself). + (when file-name + (setq file-name-buffer (generate-new-buffer " *abbrev-file*")) + (with-current-buffer file-name-buffer + (dolist (part (file-name-split file-name)) + (insert part "\n"))) + (setq dabbrev--friend-buffer-list + (append dabbrev--friend-buffer-list + (list file-name-buffer)))) + ;; Walk through the buffers till we find a match. + (let (expansion) + (while (and (not expansion) dabbrev--friend-buffer-list) + (setq dabbrev--last-buffer + (pop dabbrev--friend-buffer-list)) + (set-buffer dabbrev--last-buffer) + (progress-reporter-update + dabbrev--progress-reporter + (- (length dabbrev--friend-buffer-list))) + (setq dabbrev--last-expansion-location (point-min)) + (setq expansion (dabbrev--try-find + abbrev nil 1 ignore-case))) + (progress-reporter-done dabbrev--progress-reporter) + expansion)) + (when (buffer-live-p file-name-buffer) + (kill-buffer file-name-buffer)))))))) ;; Compute the list of buffers to scan. ;; If dabbrev-search-these-buffers-only, then the current buffer commit 4c4eda4c314e1226a9e95f4c733416de4df21245 Author: Lars Ingebrigtsen Date: Tue May 10 04:41:31 2022 +0200 Make imenu find defalias entries * lisp/emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): Also find defalias (bug#7855). diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index e7c3a4b64f..5dd2f5162e 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -119,6 +119,15 @@ t)) "\\s-+\\(" lisp-mode-symbol-regexp "\\)")) 2) + ;; Like the previous, but uses a quoted symbol as the name. + (list nil + (purecopy (concat "^\\s-*(" + (eval-when-compile + (regexp-opt + '("defalias" "define-obsolete-function-alias") + t)) + "\\s-+'\\(" lisp-mode-symbol-regexp "\\)")) + 2) (list (purecopy "Variables") (purecopy (concat "^\\s-*(" (eval-when-compile commit 20b27d475f1c2de97c7cd94eece986ed16e83cc8 Author: Po Lu Date: Tue May 10 10:38:08 2022 +0800 Simplify XDND code * src/xfns.c (Fx_begin_drag): Use SAFE_ALLOCA_STRING and encode strings in the right coding system. diff --git a/src/xfns.c b/src/xfns.c index 7dbf1e16c3..5522684170 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6822,14 +6822,12 @@ mouse buttons are released on top of FRAME. */) { struct frame *f = decode_window_system_frame (frame); int ntargets = 0, nnames = 0; - ptrdiff_t len; char *target_names[2048]; Atom *target_atoms; Lisp_Object lval, original, tem, t1, t2; Atom xaction; Atom action_list[2048]; char *name_list[2048]; - char *scratch; USE_SAFE_ALLOCA; @@ -6843,10 +6841,8 @@ mouse buttons are released on top of FRAME. */) if (ntargets < 2048) { - scratch = SSDATA (XCAR (targets)); - len = strlen (scratch); - target_names[ntargets] = SAFE_ALLOCA (len + 1); - strncpy (target_names[ntargets], scratch, len + 1); + SAFE_ALLOCA_STRING (target_names[ntargets], + XCAR (targets)); ntargets++; } else @@ -6896,10 +6892,8 @@ mouse buttons are released on top of FRAME. */) else signal_error ("Invalid drag-and-drop action", tem); - scratch = SSDATA (ENCODE_UTF_8 (t2)); - len = strlen (scratch); - name_list[nnames] = SAFE_ALLOCA (len + 1); - strncpy (name_list[nnames], scratch, len + 1); + SAFE_ALLOCA_STRING (name_list[nnames], + ENCODE_SYSTEM (t2)); nnames++; } commit 054062060e9f57fd037578378c23ad9ec294edac Author: Sean Whitton Date: Thu May 5 13:03:06 2022 -0700 Factor out *scratch* initialization * lisp/simple.el (get-scratch-buffer-create): New function, factored out of scratch-buffer, and additionally clearing the modification flag and calling substitute-command-keys (bug#55257). (scratch-buffer): * lisp/server.el (server-execute): * lisp/startup.el (normal-no-mouse-startup-screen, command-line-1): * lisp/window.el (last-buffer, window-normalize-buffer-to-switch-to): * src/buffer.c (Fother_buffer, other_buffer_safely): Use it. (syms_of_buffer): Add Qget_scratch_buffer_create. * lisp/startup.el (startup--get-buffer-create-scratch): Delete now-unused function. * doc/lispref/os.texi (Summary: Sequence of Actions at Startup): * NEWS (Incompatible changes in Emacs 29.1): Document the change. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 9df708532d..f4dd2e7072 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -329,10 +329,10 @@ file will not inhibit the message for someone else. @end defopt @defopt initial-scratch-message -This variable, if non-@code{nil}, should be a string, which is -treated as documentation to be -inserted into the @file{*scratch*} buffer when Emacs starts up. If it -is @code{nil}, the @file{*scratch*} buffer is empty. +This variable, if non-@code{nil}, should be a string, which is treated +as documentation to be inserted into the @file{*scratch*} buffer when +Emacs starts up or when that buffer is recreated. If it is +@code{nil}, the @file{*scratch*} buffer is empty. @end defopt @noindent diff --git a/etc/NEWS b/etc/NEWS index 8306136e5d..8404a3616e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -245,6 +245,14 @@ encouraged to test timestamp-related code with this variable set to nil, as it will default to nil in a future Emacs version and will be removed some time after that. ++++ +** Functions which recreate the *scratch* buffer now also initialize it. +When functions like 'other-buffer' and 'server-execute' recreate +*scratch*, they now also insert 'initial-scratch-message' and set +the major mode according to 'initial-major-mode', like at Emacs +startup. Previously, these functions ignored +'initial-scratch-message' and left *scratch* in 'fundamental-mode'. + * Changes in Emacs 29.1 diff --git a/lisp/server.el b/lisp/server.el index 763cf27f7a..8f47a99a31 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1367,7 +1367,7 @@ The following commands are accepted by the client: ((functionp initial-buffer-choice) (funcall initial-buffer-choice))))) (switch-to-buffer - (if (buffer-live-p buf) buf (get-buffer-create "*scratch*")) + (if (buffer-live-p buf) buf (get-scratch-buffer-create)) 'norecord))) ;; Delete the client if necessary. diff --git a/lisp/simple.el b/lisp/simple.el index 861d9eefde..edcc226bfa 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10213,16 +10213,24 @@ This is an integer indicating the UTC offset in seconds, i.e., the number of seconds east of Greenwich.") ) +(defun get-scratch-buffer-create () + "Return the \*scratch\* buffer, creating a new one if needed." + (or (get-buffer "*scratch*") + (let ((scratch (get-buffer-create "*scratch*"))) + ;; Don't touch the buffer contents or mode unless we know that + ;; we just created it. + (with-current-buffer scratch + (when initial-scratch-message + (insert (substitute-command-keys initial-scratch-message)) + (set-buffer-modified-p nil)) + (funcall initial-major-mode)) + scratch))) + (defun scratch-buffer () "Switch to the \*scratch\* buffer. If the buffer doesn't exist, create it first." (interactive) - (if (get-buffer "*scratch*") - (pop-to-buffer-same-window "*scratch*") - (pop-to-buffer-same-window (get-buffer-create "*scratch*")) - (when initial-scratch-message - (insert initial-scratch-message)) - (funcall initial-major-mode))) + (pop-to-buffer-same-window (get-scratch-buffer-create))) diff --git a/lisp/startup.el b/lisp/startup.el index 0b7d90ecf2..433a58bf2c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2358,7 +2358,7 @@ If you have no Meta key, you may instead type ESC followed by the character.)")) (insert "\t\t") (insert-button "Open *scratch* buffer" 'action (lambda (_button) (switch-to-buffer - (startup--get-buffer-create-scratch))) + (get-scratch-buffer-create))) 'follow-link t) (insert "\n") (save-restriction @@ -2490,12 +2490,6 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'about-emacs 'display-about-screen) (defalias 'display-splash-screen 'display-startup-screen) -(defun startup--get-buffer-create-scratch () - (or (get-buffer "*scratch*") - (with-current-buffer (get-buffer-create "*scratch*") - (set-buffer-major-mode (current-buffer)) - (current-buffer)))) - ;; This avoids byte-compiler warning in the unexec build. (declare-function pdumper-stats "pdumper.c" ()) @@ -2787,7 +2781,7 @@ nil default-directory" name) (when (eq initial-buffer-choice t) ;; When `initial-buffer-choice' equals t make sure that *scratch* ;; exists. - (startup--get-buffer-create-scratch)) + (get-scratch-buffer-create)) ;; If *scratch* exists and is empty, insert initial-scratch-message. ;; Do this before switching to *scratch* below to handle bug#9605. @@ -2811,7 +2805,7 @@ nil default-directory" name) ((functionp initial-buffer-choice) (funcall initial-buffer-choice)) ((eq initial-buffer-choice t) - (startup--get-buffer-create-scratch)) + (get-scratch-buffer-create)) (t (error "`initial-buffer-choice' must be a string, a function, or t"))))) (unless (buffer-live-p buf) diff --git a/lisp/window.el b/lisp/window.el index 52003f7b7b..dd16b83377 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4886,10 +4886,7 @@ the buffer `*scratch*', creating it if necessary." (setq frame (or frame (selected-frame))) (or (get-next-valid-buffer (nreverse (buffer-list frame)) buffer visible-ok frame) - (get-buffer "*scratch*") - (let ((scratch (get-buffer-create "*scratch*"))) - (set-buffer-major-mode scratch) - scratch))) + (get-scratch-buffer-create))) (defcustom frame-auto-hide-function #'iconify-frame "Function called to automatically hide frames. @@ -8621,12 +8618,13 @@ If BUFFER-OR-NAME is nil, return the buffer returned by `other-buffer'. Else, if a buffer specified by BUFFER-OR-NAME exists, return that buffer. If no such buffer exists, create a buffer with the name BUFFER-OR-NAME and return that buffer." - (if buffer-or-name - (or (get-buffer buffer-or-name) - (let ((buffer (get-buffer-create buffer-or-name))) - (set-buffer-major-mode buffer) - buffer)) - (other-buffer))) + (pcase buffer-or-name + ('nil (other-buffer)) + ("*scratch*" (get-scratch-buffer-create)) + (_ (or (get-buffer buffer-or-name) + (let ((buffer (get-buffer-create buffer-or-name))) + (set-buffer-major-mode buffer) + buffer))))) (defcustom switch-to-buffer-preserve-window-point t "If non-nil, `switch-to-buffer' tries to preserve `window-point'. diff --git a/src/buffer.c b/src/buffer.c index f54714675e..0f3061b497 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1665,16 +1665,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) if (!NILP (notsogood)) return notsogood; else - { - AUTO_STRING (scratch, "*scratch*"); - buf = Fget_buffer (scratch); - if (NILP (buf)) - { - buf = Fget_buffer_create (scratch, Qnil); - Fset_buffer_major_mode (buf); - } - return buf; - } + return safe_call (1, Qget_scratch_buffer_create); } /* The following function is a safe variant of Fother_buffer: It doesn't @@ -1690,15 +1681,7 @@ other_buffer_safely (Lisp_Object buffer) if (candidate_buffer (buf, buffer)) return buf; - AUTO_STRING (scratch, "*scratch*"); - buf = Fget_buffer (scratch); - if (NILP (buf)) - { - buf = Fget_buffer_create (scratch, Qnil); - Fset_buffer_major_mode (buf); - } - - return buf; + return safe_call (1, Qget_scratch_buffer_create); } DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo, @@ -5583,6 +5566,7 @@ syms_of_buffer (void) DEFSYM (Qbefore_change_functions, "before-change-functions"); DEFSYM (Qafter_change_functions, "after-change-functions"); DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions"); + DEFSYM (Qget_scratch_buffer_create, "get-scratch-buffer-create"); DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar"); Fput (Qvertical_scroll_bar, Qchoice, list4 (Qnil, Qt, Qleft, Qright)); commit 54ab2b36740166d379c713e843870310f1ccf7a1 Author: Lars Ingebrigtsen Date: Tue May 10 03:46:34 2022 +0200 Add NEWS entries for recent autosaved buffer modification status * doc/lispref/buffers.texi (Buffer Modification): Note 'autosaved' value. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 3e3b0bd9f0..8d1d9f5ddb 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -566,7 +566,9 @@ function @code{force-mode-line-update} works by doing this: @defun restore-buffer-modified-p flag Like @code{set-buffer-modified-p}, but does not force redisplay -of mode lines. +of mode lines. This function also allows a @var{flag} value of +@code{autosaved}, which marks the buffer as having been autosaved +after the last modification. @end defun @deffn Command not-modified &optional arg diff --git a/etc/NEWS b/etc/NEWS index 5cdc9a4b3e..8306136e5d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1564,14 +1564,21 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 ++++ +** 'buffer-modified-p' has been extended. +This function was previously documented to return only nil or t. This +has been changed to nil/'autosaved'/non-nil. The new 'autosaved' +value means that the buffer is modified, but that it hasn't been +modified after the last auto-save. + --- -** 'with-silent-modifications' also restores buffer modification ticks. +** 'with-silent-modifications' also restores buffer autosave status. 'with-silent-modifications' is a macro meant to be used by the font locking machinery to allow applying text properties without changing the modification status of the buffer. However, it didn't restore the -buffer modification ticks, so applying font locking to a modified -buffer that had already been auto-saved would trigger another -auto-saving. This is no longer the case. +buffer autosave status, so applying font locking to a modified buffer +that had already been auto-saved would trigger another auto-saving. +This is no longer the case. --- ** 'prin1' doesn't always escape "." and "?" in symbols any more. @@ -1709,6 +1716,11 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +*** 'restore-buffer-modified-p' can now alter buffer auto-save state. +With a FLAG value of 'autosaved', it will mark the buffer as having +been auto-saved after the last modification. + --- *** New minor mode 'isearch-fold-quotes-mode'. This sets up 'search-default-mode' so that quote characters are commit 0bee4cda881f7db4113cba541b684c334e828c4a Author: Lars Ingebrigtsen Date: Tue May 10 03:38:01 2022 +0200 Reimplement recent with-silent-modifications auto-save changes * doc/lispref/buffers.texi (Buffer Modification): Document buffer-modified-p returning `autosaved'. * lisp/subr.el (with-silent-modifications): Use restore-buffer-modified-p instead of altering the buffer modiff (since this has other side effects like not updating after async `display' changes. * src/buffer.c (Fbuffer_modified_p): Allow returning whether the buffer has been autosaved after changes. (Frestore_buffer_modified_p): Allow adjusting whether the buffer has been autosaved after changes. * src/fileio.c (Fdo_auto_save): Refill the doc string. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index d8cf3d7919..3e3b0bd9f0 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -541,10 +541,12 @@ file formerly visited. @ref{Text}. @defun buffer-modified-p &optional buffer -This function returns @code{t} if the buffer @var{buffer} has been modified -since it was last read in from a file or saved, or @code{nil} -otherwise. If @var{buffer} is not supplied, the current buffer -is tested. +This function returns non-@code{nil} if the buffer @var{buffer} has +been modified since it was last read in from a file or saved, or +@code{nil} otherwise. If @var{buffer} has been autosaved after +@var{buffer} was last modified, the symbol @code{autosaved} is +returned. If @var{buffer} is not supplied, the current buffer is +tested. @end defun @defun set-buffer-modified-p flag diff --git a/lisp/subr.el b/lisp/subr.el index 01549cc6f7..54c9f35264 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4594,21 +4594,17 @@ like `buffer-modified-p', checking whether the file is locked by someone else, running buffer modification hooks, and other things of that nature." (declare (debug t) (indent 0)) - (let ((modified (make-symbol "modified")) - (tick (make-symbol "tick"))) + (let ((modified (make-symbol "modified"))) `(let* ((,modified (buffer-modified-p)) - (,tick (buffer-modified-tick)) (buffer-undo-list t) (inhibit-read-only t) (inhibit-modification-hooks t)) (unwind-protect (progn ,@body) - ;; We restore the buffer tick count, too, because otherwise - ;; we'll trigger a new auto-save. - (internal--set-buffer-modified-tick ,tick) - (unless ,modified - (restore-buffer-modified-p nil)))))) + (when (or (not ,modified) + (eq ,modified 'autosaved)) + (restore-buffer-modified-p ,modified)))))) (defmacro with-output-to-string (&rest body) "Execute BODY, return the text it sent to `standard-output', as a string." diff --git a/src/buffer.c b/src/buffer.c index 6334e197f0..f54714675e 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1376,12 +1376,23 @@ No argument or nil as argument means use current buffer as BUFFER. */) DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p, 0, 1, 0, - doc: /* Return t if BUFFER was modified since its file was last read or saved. -No argument or nil as argument means use current buffer as BUFFER. */) + doc: /* Return non-nil if BUFFER was modified since its file was last read or saved. +No argument or nil as argument means use current buffer as BUFFER. + +If BUFFER has been autosaved after BUFFER was last modified, the +symbol `autosaved' is returned. */) (Lisp_Object buffer) { struct buffer *buf = decode_buffer (buffer); - return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil; + if (BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf)) + { + if (BUF_AUTOSAVE_MODIFF (buf) == BUF_MODIFF (buf)) + return Qautosaved; + else + return Qt; + } + else + return Qnil; } DEFUN ("force-mode-line-update", Fforce_mode_line_update, @@ -1436,6 +1447,11 @@ and `buffer-file-truename' are non-nil. */) DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p, Srestore_buffer_modified_p, 1, 1, 0, doc: /* Like `set-buffer-modified-p', but doesn't redisplay buffer's mode line. +A nil FLAG means to mark the buffer as unmodified. A non-nil FLAG +means mark the buffer as modified, except the special value +`autosaved', which will instead mark the buffer as having been +autosaved. + This function also locks or unlocks the file visited by the buffer, if both `buffer-file-truename' and `buffer-file-name' are non-nil. @@ -1475,16 +1491,19 @@ state of the current buffer. Use with care. */) recent-auto-save-p from t to nil. Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified we risk changing recent-auto-save-p from nil to t. */ - SAVE_MODIFF = (NILP (flag) - /* FIXME: This unavoidably sets recent-auto-save-p to nil. */ - ? MODIFF - /* Let's try to preserve recent-auto-save-p. */ - : SAVE_MODIFF < MODIFF ? SAVE_MODIFF - /* If SAVE_MODIFF == auto_save_modified == MODIFF, - we can either decrease SAVE_MODIFF and auto_save_modified - or increase MODIFF. */ - : modiff_incr (&MODIFF)); - + if (NILP (flag)) + /* This unavoidably sets recent-auto-save-p to nil. */ + SAVE_MODIFF = MODIFF; + else + { + if (EQ (flag, Qautosaved)) + BUF_AUTOSAVE_MODIFF (b) = MODIFF; + /* If SAVE_MODIFF == auto_save_modified == MODIFF, we can either + decrease SAVE_MODIFF and auto_save_modified or increase + MODIFF. */ + else if (SAVE_MODIFF >= MODIFF) + SAVE_MODIFF = modiff_incr (&MODIFF); + } return flag; } @@ -6465,5 +6484,7 @@ will run for `clone-indirect-buffer' calls as well. */); defsubr (&Soverlay_put); defsubr (&Srestore_buffer_modified_p); + DEFSYM (Qautosaved, "autosaved"); + Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt); } diff --git a/src/fileio.c b/src/fileio.c index 0610f7235a..9da14c8f54 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5972,14 +5972,17 @@ do_auto_save_eh (Lisp_Object ignore) DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", doc: /* Auto-save all buffers that need it. -This is all buffers that have auto-saving enabled -and are changed since last auto-saved. -Auto-saving writes the buffer into a file -so that your editing is not lost if the system crashes. +This is all buffers that have auto-saving enabled and are changed +since last auto-saved. + +Auto-saving writes the buffer into a file so that your editing is not +lost if the system crashes. + This file is not the file you visited; that changes only when you save. Normally, run the normal hook `auto-save-hook' before saving. A non-nil NO-MESSAGE argument means do not print any message if successful. + A non-nil CURRENT-ONLY argument means save only current buffer. */) (Lisp_Object no_message, Lisp_Object current_only) { diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index c1e5d0ebed..10dac68f9f 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1482,4 +1482,39 @@ with parameters from the *Messages* buffer modification." (when auto-save (ignore-errors (delete-file auto-save)))))))) +(ert-deftest test-buffer-modifications () + (ert-with-temp-file file + (with-current-buffer (find-file file) + (auto-save-mode 1) + (should-not (buffer-modified-p)) + (insert "foo") + (should (buffer-modified-p)) + (should-not (eq (buffer-modified-p) 'autosaved)) + (do-auto-save nil t) + (should (eq (buffer-modified-p) 'autosaved)) + (with-silent-modifications + (put-text-property 1 3 'face 'bold)) + (should (eq (buffer-modified-p) 'autosaved)) + (save-buffer) + (should-not (buffer-modified-p)) + (with-silent-modifications + (put-text-property 1 3 'face 'italic)) + (should-not (buffer-modified-p))))) + +(ert-deftest test-restore-buffer-modified-p () + (ert-with-temp-file file + (with-current-buffer (find-file file) + (auto-save-mode 1) + (should-not (buffer-modified-p)) + (insert "foo") + (should (buffer-modified-p)) + (restore-buffer-modified-p nil) + (should-not (buffer-modified-p)) + (insert "bar") + (do-auto-save nil t) + (should (eq (buffer-modified-p) 'autosaved)) + (insert "zot") + (restore-buffer-modified-p 'autosaved) + (should (eq (buffer-modified-p) 'autosaved))))) + ;;; buffer-tests.el ends here commit 0b2f550e3229c7a1b001fb1a09e7a5b4e3ecfb3e Author: Andrea Corallo Date: Mon May 9 15:53:45 2022 +0200 Fix syntax descriptor comparison in python-indent-region * lisp/progmodes/python.el (python-indent-region): Compare raw syntax descriptors with equal (bug#45328) (because comparing them with eq will always be false). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 825e94572a..cb4be10f5c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1297,7 +1297,7 @@ Called from a program, START and END specify the region to indent." ;; Don't mess with strings, unless it's the ;; enclosing set of quotes or a docstring. (or (not (python-syntax-context 'string)) - (eq + (equal (syntax-after (+ (1- (point)) (current-indentation) commit b299f173490f5c51476ad3c8436b19bb091c1b00 Author: Po Lu Date: Tue May 10 09:32:59 2022 +0800 Update alpha frame parameter when the window manager changes it * src/xfns.c (x_set_alpha): New function. Set `alpha_identical_p' flag. (x_frame_parm_handlers): Use it to handle `alpha' instead. * src/xterm.c (x_set_frame_alpha): Make tests against current alpha safer. (handle_one_xevent): Set frame alpha when alpha property changes. * src/xterm.h (struct x_output): New flag `alpha_identical_p'. diff --git a/src/xfns.c b/src/xfns.c index dc8f02780c..7dbf1e16c3 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2372,6 +2372,63 @@ x_set_scroll_bar_default_height (struct frame *f) #endif } +static void +x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + double alpha = 1.0; + double newval[2]; + int i; + Lisp_Object item; + bool alpha_identical_p; + + alpha_identical_p = true; + + for (i = 0; i < 2; i++) + { + newval[i] = 1.0; + if (CONSP (arg)) + { + item = CAR (arg); + arg = CDR (arg); + + alpha_identical_p = false; + } + else + item = arg; + + if (NILP (item)) + alpha = - 1.0; + else if (FLOATP (item)) + { + alpha = XFLOAT_DATA (item); + if (! (0 <= alpha && alpha <= 1.0)) + args_out_of_range (make_float (0.0), make_float (1.0)); + } + else if (FIXNUMP (item)) + { + EMACS_INT ialpha = XFIXNUM (item); + if (! (0 <= ialpha && ialpha <= 100)) + args_out_of_range (make_fixnum (0), make_fixnum (100)); + alpha = ialpha / 100.0; + } + else + wrong_type_argument (Qnumberp, item); + newval[i] = alpha; + } + + for (i = 0; i < 2; i++) + f->alpha[i] = newval[i]; + + FRAME_X_OUTPUT (f)->alpha_identical_p = alpha_identical_p; + + if (FRAME_TERMINAL (f)->set_frame_alpha_hook) + { + block_input (); + FRAME_TERMINAL (f)->set_frame_alpha_hook (f); + unblock_input (); + } +} + /* Record in frame F the specified or default value according to ALIST of the parameter named PROP (a Lisp symbol). If no value is @@ -9368,7 +9425,7 @@ frame_parm_handler x_frame_parm_handlers[] = x_set_wait_for_wm, gui_set_fullscreen, gui_set_font_backend, - gui_set_alpha, + x_set_alpha, x_set_sticky, x_set_tool_bar_position, #ifdef HAVE_XDBE diff --git a/src/xterm.c b/src/xterm.c index 10d268dc93..de3129fd87 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5358,9 +5358,16 @@ x_set_frame_alpha (struct frame *f) &actual, &format, &n, &left, &data); - if (rc == Success && actual != None && data) + if (rc == Success && actual != None + && n && format == XA_CARDINAL && data) { unsigned long value = *(unsigned long *) data; + + /* Xlib sign-extends values greater than 0x7fffffff on 64-bit + machines. Get the low bits by ourself. */ + + value &= 0xffffffff; + if (value == opac) { x_uncatch_errors (); @@ -14746,7 +14753,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, unsigned long nitems, bytesafter; unsigned char *data = NULL; - if (event->xproperty.state == PropertyDelete) { if (!last) @@ -14835,6 +14841,44 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } + if (f && FRAME_X_OUTPUT (f)->alpha_identical_p + && (event->xproperty.atom + == dpyinfo->Xatom_net_wm_window_opacity)) + { + int rc, actual_format; + Atom actual; + unsigned char *tmp_data; + unsigned long n, left, opacity; + + tmp_data = NULL; + + if (event->xproperty.state == PropertyDelete) + { + f->alpha[0] = 1.0; + f->alpha[1] = 1.0; + } + else + { + rc = XGetWindowProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_window_opacity, + 0, 1, False, XA_CARDINAL, &actual, + &actual_format, &n, &left, &tmp_data); + + if (rc == Success && actual_format == 32 + && actual == XA_CARDINAL && n) + { + opacity = *(unsigned long *) tmp_data & OPAQUE; + f->alpha[0] = (double) opacity / (double) OPAQUE; + f->alpha[1] = (double) opacity / (double) OPAQUE; + + store_frame_param (f, Qalpha, make_float (f->alpha[0])); + } + } + + if (tmp_data) + XFree (tmp_data); + } + if (event->xproperty.window == dpyinfo->root_window && (event->xproperty.atom == dpyinfo->Xatom_net_client_list_stacking || event->xproperty.atom == dpyinfo->Xatom_net_current_desktop) diff --git a/src/xterm.h b/src/xterm.h index 16635053be..98c4c5f01c 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -932,6 +932,10 @@ struct x_output false, tell Xt not to wait. */ bool_bf wait_for_wm : 1; + /* True if this frame's alpha value is the same for both the active + and inactive states. */ + bool_bf alpha_identical_p : 1; + #ifdef HAVE_X_I18N /* Input context (currently, this means Compose key handler setup). */ XIC xic; commit b7167ba8d14ad722452c297e33ae5e496f17f72c Author: Po Lu Date: Tue May 10 08:48:36 2022 +0800 ; * src/xdisp.c (mark_window_display_accurate_1): Clear vscroll flag. diff --git a/src/xdisp.c b/src/xdisp.c index b9b3c6d1bf..82a018485d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -17006,6 +17006,7 @@ mark_window_display_accurate_1 (struct window *w, bool accurate_p) w->window_end_valid = true; w->update_mode_line = false; + w->preserve_vscroll_p = false; } w->redisplay = !accurate_p; commit 75f57e4c9e19441665fe5643f010e41d4895fd54 Author: Alan Third Date: Mon May 9 21:56:42 2022 +0100 ; * admin/MAINTAINERS: Remove myself as NS port maintainer. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 092978f6d2..2760a9a42b 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -275,14 +275,6 @@ Vibhav Pant lisp/net/browse-url.el lisp/erc/* -Alan Third - The NS port: - nextstep/* - src/ns* - src/*.m - lisp/term/ns-win.el - doc/emacs/macos.texi - Amin Bandali Eshell lisp/eshell/* commit 57b69ff39c1ec7aa74f2a19bd4c4de9f67a7df84 Author: समीर सिंह Sameer Singh Date: Mon May 9 04:22:57 2022 +0530 Add support for the Sharada script * lisp/language/indian.el ("Sharada"): New language environment. Add composition rules for Sharada. Add sample text and input method. * lisp/international/fontset.el (script-representative-chars) (setup-default-fontset): Support Sharada. * lisp/leim/quail/indian.el ("sharada"): New input method. * etc/HELLO: Add a Sharada greeting. * etc/NEWS: Announce the new language environment and its input method. (Bug#55328) diff --git a/etc/HELLO b/etc/HELLO index f5e2adae94..b64aacfbe5 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -75,6 +75,7 @@ Norwegian (norsk) Hei / God dag Oriya (ଓଡ଼ିଆ) ଶୁଣିବେ Polish (język polski) Dzień dobry! / Cześć! Russian (русский) Здра́вствуйте! +Sharada (𑆯𑆳𑆫𑆢𑆳) 𑆤𑆩𑆱𑇀𑆑𑆳𑆫 Sinhala (සිංහල) ආයුබෝවන් Slovak (slovenčina) Dobrý deň Slovenian (slovenščina) Pozdravljeni! diff --git a/etc/NEWS b/etc/NEWS index 92a956c176..5cdc9a4b3e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -749,6 +749,11 @@ This language environment supports Tirhuta or Mithilaakshar, which is used to write the Maithili language. A new input method, 'tirhuta', is provided to type text in this script. +*** New language environment "Sharada". +This language environment supports the Sharada script. Named after the +goddess of learning, this script is used to write the Kashmiri language. +A new input method, 'sharada', is provided to type text in this script. + --- *** New Greek translation of the Emacs tutorial. Type 'C-u C-h t' to select it in case your language setup does not do diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 2d417d632f..7fa390a34b 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -234,6 +234,7 @@ (brahmi #x11013 #x11045 #x11052 #x11065) (kaithi #x1108D #x110B0 #x110BD) (mahajani #x11150) + (sharada #x11191 #x111B3 #x111CD) (khojki #x11200) (khudawadi #x112B0) (grantha #x11305) @@ -774,6 +775,7 @@ old-uyghur brahmi kaithi + sharada tirhuta makasar dives-akuru diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 922061c3b6..4b6c4744f1 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -158,6 +158,17 @@ Maithili language and its script Tirhuta is supported in this language environment.")) '("Indian")) +(set-language-info-alist + "Sharada" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "sharada") + (sample-text . "Sharada (𑆯𑆳𑆫𑆢𑆳) 𑆤𑆩𑆱𑇀𑆑𑆳𑆫") + (documentation . "\ +Kashmiri language and its script Sharada is supported in this +language environment.")) + '("Indian")) + ;; Replace mnemonic characters in REGEXP according to TABLE. TABLE is ;; an alist of (MNEMONIC-STRING . REPLACEMENT-STRING). @@ -461,17 +472,20 @@ language environment.")) (set-char-table-range composition-function-table '(#x110B0 . #x110BA) (list (vector + ;; Consonant based syllables (concat consonant nukta "?\\(?:" virama zwj "?" consonant nukta "?\\)*\\(?:" virama zwj "?\\|" vowel "*" nukta "?" anusvara-candrabindu "?\\)") 1 'font-shape-gstring))) (set-char-table-range composition-function-table '(#x110BD . #x110BD) (list (vector + ;; Number sign (concat number-sign numerals) 0 'font-shape-gstring))) (set-char-table-range composition-function-table '(#x110CD . #x110CD) (list (vector + ;; Number sign above (concat number-sign-above numerals) 0 'font-shape-gstring)))) @@ -486,8 +500,37 @@ language environment.")) (set-char-table-range composition-function-table '(#x114B0 . #x114C3) (list (vector + ;; Consonant based syllables (concat consonant nukta "?\\(?:" virama consonant nukta "?\\)*\\(?:" virama "\\|" vowel "*" nukta "?" anusvara-candrabindu "?\\)") 1 'font-shape-gstring)))) +;; Sharada composition rules +(let ((consonant "[\x11191-\x111B2]") + (nukta "\x111CA") + (vowel "[\x111B3-\x111BF\x111CE]") + (vowel-modifier "\x111CB") + (extra-short-vowel-mark "\x111CC") + (anusvara-candrabindu "[\x11181\x11180\x111CF]") + (virama "\x111C0") + (fricatives "[\x111C2\x111C3]") + (sandhi-mark "\x111C9") + (misc "[^\x11180-\x111C0\x111C2\x111C3\x111C9-\x111CC\x111CE-\x111CF]")) + (set-char-table-range composition-function-table + '(#x111B3 . #x111CF) + (list (vector + ;; Consonant based syllables + (concat consonant nukta "?" vowel-modifier "?\\(?:" virama + consonant nukta "?" vowel-modifier "?\\)*\\(?:" virama + "\\|" vowel "*" nukta "?" anusvara-candrabindu "?" + extra-short-vowel-mark "?" vowel-modifier "?" sandhi-mark + "?+" misc "?\\)") + 1 'font-shape-gstring))) + (set-char-table-range composition-function-table + '(#x111C2 . #x111C3) + (list (vector + ;; Fricatives with Consonants + (concat fricatives "?" consonant vowel "?") + 0 'font-shape-gstring)))) + ;;; indian.el ends here diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index f730a5ca0f..b1e547a26e 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -1043,5 +1043,124 @@ Full key sequences are listed below:") ("`m" ?𑒿) ) +(quail-define-package + "sharada" "Sharada" "𑆯𑆳" t "Sharada phonetic input method. + + `\\=`' is used to switch levels instead of Alt-Gr. +" nil t t t t nil nil nil nil nil t) + +(quail-define-rules +("``" ?₹) +("1" ?𑇑) +("`1" ?1) +("2" ?𑇒) +("`2" ?2) +("3" ?𑇓) +("`3" ?3) +("4" ?𑇔) +("`4" ?4) +("5" ?𑇕) +("`5" ?5) +("6" ?𑇖) +("`6" ?6) +("7" ?𑇗) +("`7" ?7) +("8" ?𑇘) +("`8" ?8) +("9" ?𑇙) +("`9" ?9) +("0" ?𑇐) +("`0" ?0) +("`\)" ?𑇇) +("`\\" ?𑇅) +("`|" ?𑇆) +("`" ?𑆛) +("q" ?𑆛) +("Q" ?𑆜) +("`q" ?𑇈) +("`Q" ?𑇉) +("w" ?𑆝) +("W" ?𑆞) +("`w" ?𑇋) +("`W" ?𑇍) +("e" ?𑆼) +("E" ?𑆽) +("`e" ?𑆍) +("`E" ?𑆎) +("r" ?𑆫) +("R" ?𑆸) +("`r" ?𑆉) +("`R" ?𑇎) +("t" ?𑆠) +("T" ?𑆡) +("y" ?𑆪) +("u" ?𑆶) +("U" ?𑆷) +("`u" ?𑆇) +("`U" ?𑆈) +("i" ?𑆴) +("I" ?𑆵) +("`i" ?𑆅) +("`I" ?𑆆) +("o" ?𑆾) +("O" ?𑆿) +("`o" ?𑆏) +("`O" ?𑆐) +("p" ?𑆥) +("P" ?𑆦) +("`p" ?𑇃) +("a" ?𑆳) +("A" ?𑆄) +("`a" ?𑆃) +("s" ?𑆱) +("S" ?𑆯) +("d" ?𑆢) +("D" ?𑆣) +("`d" ?𑇚) +("`D" ?𑇛) +("f" ?𑇀) +("F" ?𑆹) +("`f" ?𑆊) +("`F" ?𑇌) +("g" ?𑆓) +("G" ?𑆔) +("`g" ?𑇜) +("`G" ?𑇝) +("h" ?𑆲) +("H" ?𑆂) +("`h" ?𑇞) +("`H" ?𑇟) +("j" ?𑆘) +("J" ?𑆙) +("`j" ?᳘) +("`J" ?᳕) +("k" ?𑆑) +("K" ?𑆒) +("`k" ?𑇂) +("l" ?𑆬) +("L" ?𑆭) +("`l" ?𑆺) +("`L" ?𑆋) +("z" ?𑆚) +("Z" ?𑆕) +("`z" ?𑆻) +("`Z" ?𑆌) +("x" ?𑆰) +("X" ?𑇊) +("c" ?𑆖) +("C" ?𑆗) +("`c" #x200C) ; ZWNJ +("v" ?𑆮) +("b" ?𑆧) +("B" ?𑆨) +("n" ?𑆤) +("N" ?𑆟) +("`n" ?𑇄) +("`N" ?𑇁) +("m" ?𑆩) +("M" ?𑆁) +("`m" ?𑆀) +("`M" ?𑇏) +) ;;; indian.el ends here commit 558286315c908a8be134bec0187c97ceac815b3e Author: Michael Albinus Date: Mon May 9 20:10:10 2022 +0200 Improve Tramp tests * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file): Handle compressed files. * lisp/net/tramp.el (tramp-skeleton-write-region): Handle encrypted VISIT file. (tramp-get-process-attributes): Add backward compatibility. * test/lisp/net/tramp-tests.el (with-connection-local-variables): Declare. (auto-save-file-name-transforms): Don't declare. (ert-resource-directory-format) (ert-resource-directory-trim-left-regexp) (ert-resource-directory-trim-right-regexp, ert-resource-directory) (ert-resource-file): Define if they don't exist. (tramp-test10-write-region-file-precious-flag) (tramp-test10-write-region-other-file-name-handler) (tramp-test31-interrupt-process, tramp-test31-signal-process) (tramp--test-async-shell-command) (tramp-test34-connection-local-variables) (tramp-test39-make-lock-file-name) (tramp-test39-detect-external-change): Extend tests. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 968c1daccb..8037c89829 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -609,7 +609,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (tramp-tramp-file-p filename) filename newname)) 'file-missing filename)) - (if-let ((tmpfile (file-local-copy filename))) + ;; `file-local-copy' returns a file name also for a local file + ;; with `jka-compr-handler', so we cannot trust its result as + ;; indication for a remote file name. + (if-let ((tmpfile + (and (file-remote-p filename) (file-local-copy filename)))) ;; Remote filename. (condition-case err (rename-file tmpfile newname ok-if-already-exists) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index fec4ea68ec..9413f7954f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3386,8 +3386,9 @@ BODY is the backend specific code." (lockname (file-truename (or ,lockname filename))) (handler (and (stringp ,visit) (let ((inhibit-file-name-handlers - (cons 'tramp-file-name-handler - inhibit-file-name-handlers)) + `(tramp-file-name-handler + tramp-crypt-file-name-handler + . inhibit-file-name-handlers)) (inhibit-file-name-operation 'write-region)) (find-file-name-handler ,visit 'write-region))))) (with-parsed-tramp-file-name filename nil @@ -4221,7 +4222,9 @@ Parsing the remote \"ps\" output is controlled by It is not guaranteed, that all process attributes as described in `process-attributes' are returned. The additional attribute `pid' shall be returned always." - (with-tramp-file-property vec "/" "process-attributes" + ;; Since Emacs 27.1. + (when (fboundp 'connection-local-criteria-for-default-directory) + (with-tramp-file-property vec "/" "process-attributes" (ignore-errors (with-temp-buffer (hack-connection-local-variables-apply @@ -4265,7 +4268,7 @@ It is not guaranteed, that all process attributes as described in (push (append res) result)) (forward-line)) ;; Return result. - result)))))) + result))))))) (defun tramp-handle-list-system-processes () "Like `list-system-processes' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2d2bef732e..643e19c1d2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -65,9 +65,6 @@ (declare-function tramp-method-out-of-band-p "tramp-sh") (declare-function tramp-smb-get-localname "tramp-smb") (defvar ange-ftp-make-backup-files) -(defvar auto-save-file-name-transforms) -(defvar lock-file-name-transforms) -(defvar remote-file-name-inhibit-locks) (defvar tramp-connection-properties) (defvar tramp-copy-size-limit) (defvar tramp-display-escape-sequence-regexp) @@ -77,12 +74,59 @@ (defvar tramp-remote-path) (defvar tramp-remote-process-environment) +;; Needed for Emacs 26. +(declare-function with-connection-local-variables "files-x") ;; Needed for Emacs 27. +(defvar lock-file-name-transforms) (defvar process-file-return-signal-string) +(defvar remote-file-name-inhibit-locks) (defvar shell-command-dont-erase-buffer) ;; Needed for Emacs 28. (defvar dired-copy-dereference) +;; `ert-resource-file' was introduced in Emacs 28.1. +(unless (macrop 'ert-resource-file) + (eval-and-compile + (defvar ert-resource-directory-format "%s-resources/" + "Format for `ert-resource-directory'.") + (defvar ert-resource-directory-trim-left-regexp "" + "Regexp for `string-trim' (left) used by `ert-resource-directory'.") + (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el" + "Regexp for `string-trim' (right) used by `ert-resource-directory'.") + + (defmacro ert-resource-directory () + "Return absolute file name of the resource directory for this file. + +The path to the resource directory is the \"resources\" directory +in the same directory as the test file. + +If that directory doesn't exist, use the directory named like the +test file but formatted by `ert-resource-directory-format' and trimmed +using `string-trim' with arguments +`ert-resource-directory-trim-left-regexp' and +`ert-resource-directory-trim-right-regexp'. The default values mean +that if called from a test file named \"foo-tests.el\", return +the absolute file name for \"foo-resources\"." + `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file) + (and load-in-progress load-file-name) + buffer-file-name)) + (default-directory (file-name-directory testfile))) + (file-truename + (if (file-accessible-directory-p "resources/") + (expand-file-name "resources/") + (expand-file-name + (format + ert-resource-directory-format + (string-trim testfile + ert-resource-directory-trim-left-regexp + ert-resource-directory-trim-right-regexp))))))) + + (defmacro ert-resource-file (file) + "Return file name of resource file named FILE. +A resource file is in the resource directory as per +`ert-resource-directory'." + `(expand-file-name ,file (ert-resource-directory))))) + ;; Beautify batch mode. (when noninteractive ;; Suppress nasty messages. @@ -2505,7 +2549,9 @@ This checks also `file-name-as-directory', `file-name-directory', (setq-local file-precious-flag t) (setq-local backup-inhibited t) (insert "bar") + (should (buffer-modified-p)) (should (null (save-buffer))) + (should (not (buffer-modified-p))) (should-not (cl-member tmp-name written-files :test #'string=))) ;; Cleanup. @@ -2518,6 +2564,8 @@ This checks also `file-name-as-directory', `file-name-directory', (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) (skip-unless (executable-find "gzip")) + ;; The function was introduced in Emacs 28.1. + (skip-unless (boundp 'tar-goto-file)) (let* ((default-directory tramp-test-temporary-file-directory) (archive (ert-resource-file "foo.tar.gz")) @@ -2531,20 +2579,26 @@ This checks also `file-name-as-directory', `file-name-directory', (copy-file archive tmp-file 'ok) ;; Read archive. Check contents of foo.txt, and modify it. Save. (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) - (should (tar-goto-file "foo.txt")) + ;; The function was introduced in Emacs 28.1. + (with-no-warnings (should (tar-goto-file "foo.txt"))) (save-current-buffer (setq buffer2 (tar-extract)) (should (string-equal (buffer-string) "foo\n")) (goto-char (point-max)) (insert "bar") - (should (null (save-buffer)))) - (should (null (save-buffer)))) + (should (buffer-modified-p)) + (should (null (save-buffer))) + (should-not (buffer-modified-p))) + (should (buffer-modified-p)) + (should (null (save-buffer))) + (should-not (buffer-modified-p))) (kill-buffer buffer1) (kill-buffer buffer2) ;; Read archive. Check contents of modified foo.txt. (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) - (should (tar-goto-file "foo.txt")) + ;; The function was introduced in Emacs 28.1. + (with-no-warnings (should (tar-goto-file "foo.txt"))) (save-current-buffer (setq buffer2 (tar-extract)) (should (string-equal (buffer-string) "foo\nbar\n"))))) @@ -5032,6 +5086,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) + ;; Since Emacs 27.1. + (skip-unless (macrop 'with-connection-local-variables)) ;; We must use `file-truename' for the temporary directory, in ;; order to establish the connection prior running an asynchronous @@ -5072,6 +5128,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) + ;; Since Emacs 27.1. + (skip-unless (macrop 'with-connection-local-variables)) ;; Since Emacs 29.1. (skip-unless (boundp 'signal-process-functions)) @@ -5117,10 +5175,12 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (should (equal (process-get proc 'remote-command) (with-connection-local-variables `(,shell-file-name ,shell-command-switch ,command)))) - (should - (zerop - (signal-process - (process-get proc 'remote-pid) sigcode default-directory))) + ;; `signal-process' has argument REMOTE since Emacs 29. + (with-no-warnings + (should + (zerop + (signal-process + (process-get proc 'remote-pid) sigcode default-directory)))) ;; Let the process accept the signal. (with-timeout (10 (tramp--test-timeout-handler)) (while (accept-process-output proc 0 nil t))) @@ -5181,9 +5241,11 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." INPUT, if non-nil, is a string sent to the process." (let ((proc (async-shell-command command output-buffer error-buffer)) (delete-exited-processes t)) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command)))) + ;; Since Emacs 27.1. + (when (macrop 'with-connection-local-variables) + (should (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command))))) (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore)) (when (stringp input) (process-send-string proc input)) @@ -5567,7 +5629,7 @@ Use direct async.") :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) ;; Since Emacs 27.1. - (skip-unless (fboundp 'with-connection-local-variables)) + (skip-unless (macrop 'with-connection-local-variables)) (let* ((default-directory tramp-test-temporary-file-directory) (tmp-name1 (tramp--test-make-temp-name)) @@ -5583,6 +5645,8 @@ Use direct async.") (should (file-directory-p tmp-name1)) ;; `local-variable' is buffer-local due to explicit setting. + ;; We need `with-no-warnings', because `defvar-local' is not + ;; called at toplevel. (with-no-warnings (defvar-local local-variable 'buffer)) (with-temp-buffer @@ -6163,7 +6227,9 @@ Use direct async.") (with-temp-buffer (set-visited-file-name tmp-name1) (insert "foo") - (save-buffer)) + (should (buffer-modified-p)) + (save-buffer) + (should-not (buffer-modified-p))) (should-not (with-no-warnings (file-locked-p tmp-name1))) (with-no-warnings (lock-file tmp-name1)) (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) @@ -6285,7 +6351,9 @@ Use direct async.") ;; buffer results in a prompt. (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_) (ert-fail "Test failed unexpectedly")))) - (save-buffer)) + (should (buffer-modified-p)) + (save-buffer) + (should-not (buffer-modified-p))) (should-not (file-locked-p tmp-name)) ;; For local files, just changing the file @@ -6317,7 +6385,9 @@ Use direct async.") (cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always) ((symbol-function 'read-char-choice) (lambda (&rest _) ?y))) - (save-buffer)) + (should (buffer-modified-p)) + (save-buffer) + (should-not (buffer-modified-p))) (should-not (file-locked-p tmp-name)))) ;; Cleanup. commit 7b4bdf7b9b0f4c72dbd1b15f5d134d3176e53a8a (refs/remotes/origin/emacs-28) Author: Eli Zaretskii Date: Mon May 9 16:37:49 2022 +0300 Remove the AUCTeX subsection from MS-Windows FAQ * doc/misc/efaq-w32.texi (AUCTeX): Remove the subsection, it is no longer useful. (Bug#55330) diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index 3b48fb1453..3a49f0a5da 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -1742,22 +1742,6 @@ You will need an implementation of TeX for Windows. A number of implementations are listed on the @uref{http://www.tug.org/interest.html#free, TeX Users Group} website. -@menu -* AUCTeX:: -@end menu - -@node AUCTeX -@subsection AUCTeX -@cindex auctex, precompiled for Windows -@cindex latex -@cindex preview-latex - -AUCTeX is an Emacs package for writing LaTeX files, which also -includes preview-latex, an Emacs mode for previewing the formatted -contents of LaTeX documents. AUCTeX is available from -@uref{https://elpa.gnu.org, GNU ELPA} and can be installed with the -command @kbd{M-x list-packages}. - @node Spell check @section How do I perform spell checks? @cindex spell checking commit 6fc54786c3bb797068675d7eb7b500fb990bd04a Author: Eli Zaretskii Date: Mon May 9 16:28:22 2022 +0300 ; Fix documentation of completion options * doc/emacs/mini.texi (Completion Commands, Completion Options): Improve and clarify the wording. diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index ad5701670e..4e71793b66 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -381,16 +381,16 @@ used with the completion list: @vindex minibuffer-completion-auto-choose @item M-@key{DOWN} @itemx M-@key{UP} -While in the minibuffer, these keys will navigate through the -completions displayed in the completions buffer. When +While in the minibuffer, these keys navigate through the completions +displayed in the completions buffer. When @code{minibuffer-completion-auto-choose} is non-@code{nil} (which is -the default), using these commands will automatically insert the -current completion candidate in the minibuffer. If this user option -is @code{nil}, the keys will navigate the same way as before, but -won't automatically insert the candidate in the minibuffer. Instead -you have to use the @kbd{M-@key{RET}} command to do that. With -a prefix argument, @kbd{C-u M-@key{RET}} inserts the currently active -candidate to the minibuffer, but doesn't exit the minibuffer. +the default), using these commands also inserts the current completion +candidate into the minibuffer. If +@code{minibuffer-completion-auto-choose} is @code{nil}, you can use +the @kbd{M-@key{RET}} command to insert the completion candidates into +the minibuffer. By default, that exits the minibuffer, but with a +prefix argument, @kbd{C-u M-@key{RET}} inserts the currently active +candidate without exiting the minibuffer. @findex switch-to-completions @item M-v @@ -408,8 +408,9 @@ ways (@pxref{Windows}). @itemx mouse-2 While in the completion list buffer, this chooses the completion at point (@code{choose-completion}). With a prefix argument, @kbd{C-u -@key{RET}} inserts the completion at point to the minibuffer, but -doesn't exit the minibuffer. +@key{RET}} inserts the completion at point into the minibuffer, but +doesn't exit the minibuffer---thus, you can change your mind and +choose another candidate. @findex next-completion @item @key{TAB} @@ -685,18 +686,19 @@ behavior only when there are @var{n} or fewer alternatives. @vindex completions-format When displaying completions, Emacs will normally pop up a new buffer to display the completions. The completions will by default be sorted -in rows horizontally, but this can be changed by customizing the -@code{completions-format} user option. If @code{vertical}, sort the -completions vertically in columns instead, and if @code{one-column}, -just use a single column. +horizontally, using as many columns as will fit in the window-width, +but this can be changed by customizing the @code{completions-format} +user option. If its value is @code{vertical}, Emacs will sort the +completions vertically instead, and if it's @code{one-column}, Emacs +will use just one column. @vindex completions-sort - The @code{completions-sort} user option controls how completions are -sorted in the @samp{*Completions*} buffer. The default is -@code{alphabetical} that sorts in alphabetical order. The value -@code{nil} disables sorting. It can also be a function which will be -called with the list of completions, and should return the list in the -desired order. + The @code{completions-sort} user option controls the order in which +the completions are sorted in the @samp{*Completions*} buffer. The +default is @code{alphabetical}, which sorts in alphabetical order. +The value @code{nil} disables sorting. The value can also be a +function, which will be called with the list of completions, and +should return the list in the desired order. @vindex completions-max-height When @code{completions-max-height} is non-@code{nil}, it limits the commit 9b2af37559822ec4728ef73c101eb6861fd89084 Merge: c7bfb4841b 0d32e33ed6 Author: Eli Zaretskii Date: Mon May 9 16:08:56 2022 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit c7bfb4841b684fdc92a1bb99e74a92ed4b515152 Author: Eli Zaretskii Date: Mon May 9 16:08:10 2022 +0300 ; * lisp/textmodes/table.el (table-latex-environment): Doc fix. diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 5093a99442..fc06c4c0da 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -754,8 +754,10 @@ the cell contents dynamically." :group 'table) (defcustom table-latex-environment "tabular" - "Which tabular-compatible environment to use when generating latex. -\"tabular\" and \"longtable\" are known to work." + "Tabular-compatible environment to use when generating latex. +The value should be a string suitable for use as a LaTeX environment +that's compatible with the \"tabular\" protocol, such as \"tabular\" +and \"longtable\"." :tag "Latex environment used to export tables" :type '(choice (const :tag "tabular" "tabular") commit 0d32e33ed65c1f7884129e12fa75eaa5d3396c3b Author: Protesilaos Stavrou Date: Mon May 9 10:38:23 2022 +0300 Shorten note about didactic space in TUTORIAL.el_GR (bug#55332) diff --git a/etc/tutorials/TUTORIAL.el_GR b/etc/tutorials/TUTORIAL.el_GR index e001cc6cce..b34fa5403c 100644 --- a/etc/tutorials/TUTORIAL.el_GR +++ b/etc/tutorials/TUTORIAL.el_GR @@ -22,8 +22,7 @@ C-c. (Δύο χαρακτήρες.) Για να ακυρώσεις μια με Οι χαρακτήρες ">>" στο αριστερό περιθώριο δείχνουν οδηγίες για να δοκιμάσεις μια εντολή. Για παράδειγμα: <> -[Το μέσο της σελίδας παραμένει κενό για διδακτικούς σκοπούς. Το -κείμενο συνεχίζεται παρακάτω.] +[Κενό για διδακτικούς σκοπούς. Το κείμενο συνεχίζεται παρακάτω.] >> Τώρα πληκτρολόγησε C-v (δες επόμενη οθόνη) ώστε να κυλήσεις πιο κάτω στην παρούσα εκμάθηση. (Κάνε το, κρατώντας πατημένο το commit 04b1f779f2e37cea854b40f0cc8e7f6221dcf6fd Author: Eli Zaretskii Date: Mon May 9 16:02:58 2022 +0300 ; Fix recent changes in regexp documentation * doc/lispref/searching.texi (Regexp Backslash): * doc/emacs/search.texi (Regexps): Fix typo and wording. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 81f4d26e03..b123ef83a1 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1027,9 +1027,11 @@ you search for @samp{a.*?$} against the text @samp{abbab} followed by a newline, it matches the whole string. Since it @emph{can} match starting at the first @samp{a}, it does. +@cindex set of alternative characters, in regular expressions +@cindex character set, in regular expressions @item @kbd{[ @dots{} ]} -is a @dfn{a set of alternative characters}, beginning with @samp{[} -and terminated by @samp{]}. +is a @dfn{set of alternative characters}, or a @dfn{character set}, +beginning with @samp{[} and terminated by @samp{]}. In the simplest case, the characters between the two brackets are what this set can match. Thus, @samp{[ad]} matches either one @samp{a} or @@ -1046,9 +1048,10 @@ which matches any lower-case @acronym{ASCII} letter or @samp{$}, @samp{%} or period. As another example, @samp{[α-ωί]} matches all lower-case Greek letters. +@cindex character classes, in regular expressions You can also include certain special @dfn{character classes} in a character set. A @samp{[:} and balancing @samp{:]} enclose a -character class inside a character alternative. For instance, +character class inside a set of alternative characters. For instance, @samp{[[:alnum:]]} matches any letter or digit. @xref{Char Classes,,, elisp, The Emacs Lisp Reference Manual}, for a list of character classes. @@ -1116,10 +1119,10 @@ no preceding expression on which the @samp{*} can act. It is poor practice to depend on this behavior; it is better to quote the special character anyway, regardless of where it appears. -As a @samp{\} is not special inside a character alternative, it can +As a @samp{\} is not special inside a set of alternative characters, it can never remove the special meaning of @samp{-}, @samp{^} or @samp{]}. -So you should not quote these characters when they have no special -meaning either. This would not clarify anything, since backslashes +You should not quote these characters when they have no special +meaning. This would not clarify anything, since backslashes can legitimately precede these characters where they @emph{have} special meaning, as in @samp{[^\]} (@code{"[^\\]"} for Lisp string syntax), which matches any single character except a backslash. diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 976f8b4b4b..21a2c6c51e 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -550,8 +550,8 @@ special character anyway, regardless of where it appears. As a @samp{\} is not special inside a character alternative, it can never remove the special meaning of @samp{-}, @samp{^} or @samp{]}. -So you should not quote these characters when they have no special -meaning either. This would not clarify anything, since backslashes +You should not quote these characters when they have no special +meaning. This would not clarify anything, since backslashes can legitimately precede these characters where they @emph{have} special meaning, as in @samp{[^\]} (@code{"[^\\]"} for Lisp string syntax), which matches any single character except a backslash. @@ -825,12 +825,13 @@ matches any character whose syntax is not @var{code}. @cindex category, regexp search for @item \c@var{code} matches any character whose category is @var{code}. Here @var{code} -is a character that represents a category: thus, @samp{code} for -Chinese characters or @samp{g} for Greek characters in the standard -category table. You can see the list of all the currently defined -categories with @kbd{M-x describe-categories @key{RET}}. You can also -define your own categories in addition to the standard ones using the -@code{define-category} function (@pxref{Categories}). +is a character that represents a category: for example, in the standard +category table, @samp{c} stands for Chinese characters and @samp{g} +stands for Greek characters. You can see the list of all the +currently defined categories with @w{@kbd{M-x describe-categories +@key{RET}}}. You can also define your own categories in addition to +the standard ones using the @code{define-category} function +(@pxref{Categories}). @item \C@var{code} matches any character whose category is not @var{code}. commit f54a71fa279a87aa1d9e9a9894224305cbc330af Author: Po Lu Date: Mon May 9 12:45:05 2022 +0000 * src/haikuterm.c (haiku_draw_fringe_bitmap): Set stipple flag. diff --git a/src/haikuterm.c b/src/haikuterm.c index 747c8e4275..802d7d2ac2 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2589,6 +2589,8 @@ haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); BView_EndClip (view); + + row->stipple_p = true; } } commit 825b5435826ff42dfe831ce5dae1d33dbbe82b15 Author: Eli Zaretskii Date: Mon May 9 15:45:08 2022 +0300 ; * lisp/vc/ediff-util.el (ediff-show-diff-output): Doc fix. diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index f140f14559..040a9a63c5 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3432,7 +3432,7 @@ Without an argument, it saves customized diff argument, if available (defun ediff-show-diff-output (arg) "With prefix argument ARG, show plain diff output. -Without an argument, it saves customized diff argument, if available +Without an argument, save the customized diff argument, if available (and plain output, if customized output was not generated)." (interactive "P") (ediff-barf-if-not-control-buffer) commit 83e2e961b013fe086072fd8dbc7eb8d17cc586d1 Author: Po Lu Date: Mon May 9 20:23:20 2022 +0800 Fix reading faces with a default value that is a symbol * lisp/faces.el (read-face-name): Don't try to intern face if it is already a symbol. diff --git a/lisp/faces.el b/lisp/faces.el index 1ada05a7b8..2d4b7761be 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1148,13 +1148,18 @@ returned. Otherwise, DEFAULT is returned verbatim." nil t nil 'face-name-history default)) ;; Ignore elements that are not faces ;; (for example, because DEFAULT was "all faces") - (if (facep face) (push (intern face) faces))) + (if (facep face) (push (if (stringp face) + (intern face) + face) + faces))) (nreverse faces)) (let ((face (completing-read prompt (completion-table-in-turn nonaliasfaces aliasfaces) nil t nil 'face-name-history defaults))) - (if (facep face) (intern face))))))) + (when (facep face) (if (stringp face) + (intern face) + face))))))) ;; Not defined without X, but behind window-system test. (defvar x-bitmap-file-path) commit 3eb82181fc328e6503b6cff5321f201322489d3f Author: Po Lu Date: Mon May 9 20:15:41 2022 +0800 Fix scroll optimizations being enabled for some rows with stipples * src/dispnew.c (update_text_area): New parameter `partial_p'. Set it if not enough glyphs were drawn to determine if a row doesn't have a stipple. (update_window_line): Preserve current_row->stipple_p in that case, after making the desired row current. * src/xterm.c (x_draw_fringe_bitmap): Set row->stipple. diff --git a/src/dispnew.c b/src/dispnew.c index c49c38cba8..795c928bc1 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3907,7 +3907,8 @@ update_marginal_area (struct window *w, struct glyph_row *updated_row, Value is true if display has changed. */ static bool -update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) +update_text_area (struct window *w, struct glyph_row *updated_row, int vpos, + bool *partial_p) { struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos); struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos); @@ -4013,6 +4014,13 @@ update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) { x += desired_glyph->pixel_width; ++desired_glyph, ++current_glyph, ++i; + + /* Say that only a partial update was performed of + the current row (i.e. not all the glyphs were + drawn). This is used to preserve the stipple_p + flag of the current row inside + update_window_line. */ + *partial_p = true; } /* Consider the case that the current row contains "xxx @@ -4084,9 +4092,15 @@ update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) rif->write_glyphs (w, updated_row, start, TEXT_AREA, i - start_hpos); changed_p = 1; + *partial_p = true; } } + /* This means we will draw from the start, so no partial update + is being performed. */ + if (!i) + *partial_p = false; + /* Write the rest. */ if (i < desired_row->used[TEXT_AREA]) { @@ -4159,7 +4173,9 @@ update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p) struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos); struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos); struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w))); - bool changed_p = 0; + + /* partial_p is true if not all of desired_row was drawn. */ + bool changed_p = 0, partial_p = 0, was_stipple; /* A row can be completely invisible in case a desired matrix was built with a vscroll and then make_cursor_line_fully_visible shifts @@ -4183,7 +4199,7 @@ update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p) } /* Update the display of the text area. */ - if (update_text_area (w, desired_row, vpos)) + if (update_text_area (w, desired_row, vpos, &partial_p)) { changed_p = 1; if (current_row->mouse_face_p) @@ -4212,7 +4228,17 @@ update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p) } /* Update current_row from desired_row. */ + was_stipple = current_row->stipple_p; make_current (w->desired_matrix, w->current_matrix, vpos); + + /* If only a partial update was performed, any stipple already + displayed in MATRIX_ROW (w->current_matrix, vpos) might still be + there, so don't hurry to clear that flag if it's not in + desired_row. */ + + if (partial_p && was_stipple) + current_row->stipple_p = true; + return changed_p; } diff --git a/src/xterm.c b/src/xterm.c index c9e2618191..10d268dc93 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5750,7 +5750,8 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) } static void -x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) +x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, + struct draw_fringe_bitmap_params *p) { struct frame *f = XFRAME (WINDOW_FRAME (w)); Display *display = FRAME_X_DISPLAY (f); @@ -5772,6 +5773,8 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring x_fill_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, true); XSetFillStyle (display, face->gc, FillSolid); + + row->stipple_p = true; } else { commit 8a8b81c1e48a45ca187623f3c45d0c332bcd45ac Author: Lars Ingebrigtsen Date: Mon May 9 14:06:24 2022 +0200 Make ediff-show-diff-output work better on unsaved buffers * lisp/vc/ediff-util.el (ediff-show-diff-output): Make the `D' command work on unsaved buffers without a prefix (bug#45016). diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index b41def2aff..f140f14559 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3431,6 +3431,9 @@ Without an argument, it saves customized diff argument, if available )) (defun ediff-show-diff-output (arg) + "With prefix argument ARG, show plain diff output. +Without an argument, it saves customized diff argument, if available +(and plain output, if customized output was not generated)." (interactive "P") (ediff-barf-if-not-control-buffer) (ediff-compute-custom-diffs-maybe) @@ -3438,7 +3441,10 @@ Without an argument, it saves customized diff argument, if available (ediff-skip-unsuitable-frames ' ok-unsplittable)) (let ((buf (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer)) ediff-diff-buffer) - ((ediff-buffer-live-p ediff-custom-diff-buffer) + ((and (ediff-buffer-live-p ediff-custom-diff-buffer) + ;; We may not have gotten a custom output if + ;; we're working on unsaved buffers. + (> (buffer-size ediff-custom-diff-buffer) 0)) ediff-custom-diff-buffer) ((ediff-buffer-live-p ediff-diff-buffer) ediff-diff-buffer) commit d377b396432412b06647eef01f837126982f3e6d Author: João Távora Date: Mon May 9 12:29:59 2022 +0100 Allow non-interactive use of eldoc-doc-buffer * lisp/emacs-lisp/eldoc.el (eldoc-doc-buffer): Allow non-interactive use. (Version): Bump minor. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 74ffeb166d..0b8078579c 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -5,7 +5,7 @@ ;; Author: Noah Friedman ;; Keywords: extensions ;; Created: 1995-10-06 -;; Version: 1.11.1 +;; Version: 1.12.0 ;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -464,19 +464,22 @@ directly from the user or from ElDoc's automatic mechanisms'.") (defvar eldoc--doc-buffer-docs nil "Documentation items in `eldoc--doc-buffer'.") -(defun eldoc-doc-buffer () - "Display ElDoc documentation buffer. +(defun eldoc-doc-buffer (&optional interactive) + "Get or display ElDoc documentation buffer. -This holds the results of the last documentation request." - (interactive) +The buffer holds the results of the last documentation request. +If INTERACTIVE, display it. Else, return said buffer." + (interactive (list t)) (unless (buffer-live-p eldoc--doc-buffer) (user-error (format "ElDoc buffer doesn't exist, maybe `%s' to produce one." (substitute-command-keys "\\[eldoc]")))) (with-current-buffer eldoc--doc-buffer - (rename-buffer (replace-regexp-in-string "^ *" "" - (buffer-name))) - (display-buffer (current-buffer)))) + (cond (interactive + (rename-buffer (replace-regexp-in-string "^ *" "" + (buffer-name))) + (display-buffer (current-buffer))) + (t (current-buffer))))) (defun eldoc--format-doc-buffer (docs) "Ensure DOCS are displayed in an *eldoc* buffer." commit 60a15fae0245e303e012408de49be87dc43af152 Author: Lars Ingebrigtsen Date: Mon May 9 13:38:40 2022 +0200 Copy edits for the regexp sections in the manuals * doc/lispref/searching.texi (Regexp Backslash): * doc/emacs/search.texi (Regexps, Regexp Backslash): Copy edits from Jay Bingham (bug#41970). diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index c990f5d766..81f4d26e03 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1027,24 +1027,9 @@ you search for @samp{a.*?$} against the text @samp{abbab} followed by a newline, it matches the whole string. Since it @emph{can} match starting at the first @samp{a}, it does. -@item @kbd{\@{@var{n}\@}} -is a postfix operator specifying @var{n} repetitions---that is, the -preceding regular expression must match exactly @var{n} times in a -row. For example, @samp{x\@{4\@}} matches the string @samp{xxxx} and -nothing else. - -@item @kbd{\@{@var{n},@var{m}\@}} -is a postfix operator specifying between @var{n} and @var{m} -repetitions---that is, the preceding regular expression must match at -least @var{n} times, but no more than @var{m} times. If @var{m} is -omitted, then there is no upper limit, but the preceding regular -expression must match at least @var{n} times.@* @samp{\@{0,1\@}} is -equivalent to @samp{?}. @* @samp{\@{0,\@}} is equivalent to -@samp{*}. @* @samp{\@{1,\@}} is equivalent to @samp{+}. - @item @kbd{[ @dots{} ]} -is a @dfn{character set}, beginning with @samp{[} and terminated by -@samp{]}. +is a @dfn{a set of alternative characters}, beginning with @samp{[} +and terminated by @samp{]}. In the simplest case, the characters between the two brackets are what this set can match. Thus, @samp{[ad]} matches either one @samp{a} or @@ -1132,12 +1117,12 @@ to depend on this behavior; it is better to quote the special character anyway, regardless of where it appears. As a @samp{\} is not special inside a character alternative, it can -never remove the special meaning of @samp{-} or @samp{]}. So you -should not quote these characters when they have no special meaning -either. This would not clarify anything, since backslashes can -legitimately precede these characters where they @emph{have} special -meaning, as in @samp{[^\]} (@code{"[^\\]"} for Lisp string syntax), -which matches any single character except a backslash. +never remove the special meaning of @samp{-}, @samp{^} or @samp{]}. +So you should not quote these characters when they have no special +meaning either. This would not clarify anything, since backslashes +can legitimately precede these characters where they @emph{have} +special meaning, as in @samp{[^\]} (@code{"[^\\]"} for Lisp string +syntax), which matches any single character except a backslash. @node Regexp Backslash @section Backslash in Regular Expressions @@ -1202,11 +1187,11 @@ matches the same text that matched the @var{d}th occurrence of a @samp{\( @dots{} \)} construct. This is called a @dfn{back reference}. -After the end of a @samp{\( @dots{} \)} construct, the matcher remembers -the beginning and end of the text matched by that construct. Then, -later on in the regular expression, you can use @samp{\} followed by the -digit @var{d} to mean ``match the same text matched the @var{d}th time -by the @samp{\( @dots{} \)} construct''. +After the end of a @samp{\( @dots{} \)} construct, the matcher +remembers the beginning and end of the text matched by that construct. +Then, later on in the regular expression, you can use @samp{\} +followed by the digit @var{d} to mean ``match the same text matched +the @var{d}th @samp{\( @dots{} \)} construct''. The strings matching the first nine @samp{\( @dots{} \)} constructs appearing in a regular expression are assigned numbers 1 through 9 in @@ -1223,6 +1208,21 @@ If a particular @samp{\( @dots{} \)} construct matches more than once (which can easily happen if it is followed by @samp{*}), only the last match is recorded. +@item @kbd{\@{@var{m}\@}} +is a postfix operator specifying @var{m} repetitions---that is, the +preceding regular expression must match exactly @var{m} times in a +row. For example, @samp{x\@{4\@}} matches the string @samp{xxxx} and +nothing else. + +@item @kbd{\@{@var{m},@var{n}\@}} +is a postfix operator specifying between @var{m} and @var{n} +repetitions---that is, the preceding regular expression must match at +least @var{m} times, but no more than @var{n} times. If @var{n} is +omitted, then there is no upper limit, but the preceding regular +expression must match at least @var{m} times.@* @samp{\@{0,1\@}} is +equivalent to @samp{?}. @* @samp{\@{0,\@}} is equivalent to +@samp{*}. @* @samp{\@{1,\@}} is equivalent to @samp{+}. + @item \` matches the empty string, but only at the beginning of the string or buffer (or its accessible portion) being matched against. diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index c9828f9c86..976f8b4b4b 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -549,12 +549,12 @@ can act. It is poor practice to depend on this behavior; quote the special character anyway, regardless of where it appears. As a @samp{\} is not special inside a character alternative, it can -never remove the special meaning of @samp{-} or @samp{]}. So you -should not quote these characters when they have no special meaning -either. This would not clarify anything, since backslashes can -legitimately precede these characters where they @emph{have} special -meaning, as in @samp{[^\]} (@code{"[^\\]"} for Lisp string syntax), -which matches any single character except a backslash. +never remove the special meaning of @samp{-}, @samp{^} or @samp{]}. +So you should not quote these characters when they have no special +meaning either. This would not clarify anything, since backslashes +can legitimately precede these characters where they @emph{have} +special meaning, as in @samp{[^\]} (@code{"[^\\]"} for Lisp string +syntax), which matches any single character except a backslash. In practice, most @samp{]} that occur in regular expressions close a character alternative and hence are special. However, occasionally a @@ -823,21 +823,21 @@ the characters that stand for them. matches any character whose syntax is not @var{code}. @cindex category, regexp search for -@item \c@var{c} -matches any character whose category is @var{c}. Here @var{c} is a -character that represents a category: thus, @samp{c} for Chinese -characters or @samp{g} for Greek characters in the standard category -table. You can see the list of all the currently defined categories -with @kbd{M-x describe-categories @key{RET}}. You can also define -your own categories in addition to the standard ones using the +@item \c@var{code} +matches any character whose category is @var{code}. Here @var{code} +is a character that represents a category: thus, @samp{code} for +Chinese characters or @samp{g} for Greek characters in the standard +category table. You can see the list of all the currently defined +categories with @kbd{M-x describe-categories @key{RET}}. You can also +define your own categories in addition to the standard ones using the @code{define-category} function (@pxref{Categories}). -@item \C@var{c} -matches any character whose category is not @var{c}. +@item \C@var{code} +matches any character whose category is not @var{code}. @end table The following regular expression constructs match the empty string---that is, -they don't use up any characters---but whether they match depends on the +they don't consume any characters---but whether they match depends on the context. For all, the beginning and end of the accessible portion of the buffer are treated as if they were the actual beginning and end of the buffer. commit e195ac3df06cc4e805f3964f593234e5b5d70236 Author: Po Lu Date: Mon May 9 11:21:15 2022 +0000 ; * src/haikuterm.c (haiku_draw_underwave): Fix default scale. diff --git a/src/haikuterm.c b/src/haikuterm.c index bfa6be225a..747c8e4275 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -742,8 +742,8 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x) float ax, ay, bx, by; void *view; - scale_x = 4; - scale_y = 4; + scale_x = 1; + scale_y = 1; haiku_get_scale_factor (&scale_x, &scale_y); wave_height = 3 * scale_y; wave_length = 2 * scale_x; commit 5921e31c45e2d0b2b2ee4e03b21127abb3c30944 Author: Po Lu Date: Mon May 9 11:10:13 2022 +0000 Respect display scale factor drawing underwaves on Haiku * src/haikuterm.c (haiku_get_scale_factor): New function. (haiku_draw_underwave): Apply said factor. diff --git a/src/haikuterm.c b/src/haikuterm.c index 265d3fbf5e..bfa6be225a 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -723,22 +723,41 @@ haiku_draw_relief_rect (struct glyph_string *s, BView_EndClip (view); } +static void +haiku_get_scale_factor (int *scale_x, int *scale_y) +{ + struct haiku_display_info *dpyinfo = x_display_list; + + if (dpyinfo->resx > 96) + *scale_x = floor (dpyinfo->resx / 96); + if (dpyinfo->resy > 96) + *scale_y = floor (dpyinfo->resy / 96); +} + static void haiku_draw_underwave (struct glyph_string *s, int width, int x) { - int wave_height = 3, wave_length = 2; - int y, dx, dy, odd, xmax; + int wave_height, wave_length; + int y, dx, dy, odd, xmax, scale_x, scale_y; float ax, ay, bx, by; - void *view = FRAME_HAIKU_VIEW (s->f); + void *view; + + scale_x = 4; + scale_y = 4; + haiku_get_scale_factor (&scale_x, &scale_y); + wave_height = 3 * scale_y; + wave_length = 2 * scale_x; dx = wave_length; dy = wave_height - 1; y = s->ybase - wave_height + 3; xmax = x + width; + view = FRAME_HAIKU_VIEW (s->f); BView_StartClip (view); haiku_clip_to_string (s); BView_ClipToRect (view, x, y, width, wave_height); + ax = x - ((int) (x) % dx) + (float) 0.5; bx = ax + dx; odd = (int) (ax / dx) % 2; @@ -749,6 +768,8 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x) else by += dy; + BView_SetPenSize (view, scale_y); + while (ax <= xmax) { BView_StrokeLine (view, ax, ay, bx, by); @@ -756,6 +777,8 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x) bx += dx, by = y + 0.5 + odd * dy; odd = !odd; } + + BView_SetPenSize (view, 1); BView_EndClip (view); } commit 2e949031160d769bbac941c064b825a5c578afc5 Author: Lars Ingebrigtsen Date: Mon May 9 12:37:11 2022 +0200 Add meta navigation keys to outline-minor-mode-cycle-map * lisp/outline.el (outline-minor-mode-cycle-map): Add meta navigate keys (bug#41129). diff --git a/lisp/outline.el b/lisp/outline.el index 7fd43195cc..81e312ee01 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -215,6 +215,10 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil." (let ((map (make-sparse-keymap))) (outline-minor-mode-cycle--bind map (kbd "TAB") #'outline-cycle) (outline-minor-mode-cycle--bind map (kbd "") #'outline-cycle-buffer) + (outline-minor-mode-cycle--bind map (kbd "M-") #'outline-promote) + (outline-minor-mode-cycle--bind map (kbd "M-") #'outline-demote) + (outline-minor-mode-cycle--bind map (kbd "M-") #'outline-move-subtree-up) + (outline-minor-mode-cycle--bind map (kbd "M-") #'outline-move-subtree-down) map) "Keymap used by `outline-minor-mode-cycle'.") commit d2a5631552cbe036c46111101c0570135e81fc56 Author: Arash Esbati Date: Mon May 9 12:10:10 2022 +0200 Update AUCTeX FAQ entry * doc/misc/efaq-w32.texi (AUCTeX): AUCTeX project isn't providing pre-compiled versions for Windows anymore (bug#55330). diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index 20dcb07ed7..3b48fb1453 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -1754,10 +1754,9 @@ A number of implementations are listed on the AUCTeX is an Emacs package for writing LaTeX files, which also includes preview-latex, an Emacs mode for previewing the formatted -contents of LaTeX documents. Pre-compiled versions for Windows are -available from -@uref{https://www.gnu.org/software/auctex/download-for-windows.html, the -AUCTeX site}. +contents of LaTeX documents. AUCTeX is available from +@uref{https://elpa.gnu.org, GNU ELPA} and can be installed with the +command @kbd{M-x list-packages}. @node Spell check @section How do I perform spell checks? commit 6b6b2c11edc46517a3a1ac9f869bdd40adf8a3df Author: Vladimir Nikishkin Date: Mon May 9 12:03:33 2022 +0200 Add new user option table-latex-environment * lisp/textmodes/table.el (table-latex-environment): New user option (bug#55333). (table--generate-source-prologue): Use it. diff --git a/etc/NEWS b/etc/NEWS index 5860010f02..92a956c176 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2135,6 +2135,12 @@ This holds the value of the previous call to 'set-locale-environment'. This macro can be used to change the locale temporarily while executing code. +** table.el + +--- +*** New user option 'table-latex-environment'. +This allows switching between "table" and "tabular". + ** Tabulated List Mode +++ diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 2175900194..5093a99442 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -753,6 +753,16 @@ the cell contents dynamically." :type 'string :group 'table) +(defcustom table-latex-environment "tabular" + "Which tabular-compatible environment to use when generating latex. +\"tabular\" and \"longtable\" are known to work." + :tag "Latex environment used to export tables" + :type '(choice + (const :tag "tabular" "tabular") + (const :tag "longtable" "longtable") + string) + :version "29.1") + (defcustom table-cals-thead-rows 1 "Number of top rows to become header rows in CALS table." :tag "CALS Header Rows" @@ -3025,7 +3035,8 @@ CALS (DocBook DTD): ""))) ((eq language 'latex) (insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version) - "\\begin{tabular}{|" (apply #'concat (make-list (length col-list) "l|")) "}\n" + "\\begin{" table-latex-environment "}{|" + (apply #'concat (make-list (length col-list) "l|")) "}\n" "\\hline\n")) ((eq language 'cals) (insert (format "\n" emacs-version) @@ -3051,7 +3062,7 @@ CALS (DocBook DTD): ((eq language 'html) (insert "\n")) ((eq language 'latex) - (insert "\\end{tabular}\n")) + (insert "\\end{" table-latex-environment "}\n")) ((eq language 'cals) (set-marker-insertion-type (table-get-source-info 'colspec-marker) t) ;; insert before (save-excursion commit 177718bc6df79ee93656e20c5b25b94923040dab Author: Lars Ingebrigtsen Date: Mon May 9 11:57:46 2022 +0200 Update string-to-number documentation to bignum Emacs * doc/lispref/strings.texi (String Conversion): string-to-number no longer converts integers to floating point numbers (bug#55334). diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 6a6b756fbe..2810f686eb 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -853,9 +853,7 @@ between 2 and 16 (inclusive), and integers are converted in that base. If @var{base} is @code{nil}, then base ten is used. Floating-point conversion only works in base ten; we have not implemented other radices for floating-point numbers, because that would be much more -work and does not seem useful. If @var{string} looks like an integer -but its value is too large to fit into a Lisp integer, -@code{string-to-number} returns a floating-point result. +work and does not seem useful. The parsing skips spaces and tabs at the beginning of @var{string}, then reads as much of @var{string} as it can interpret as a number in commit 74cc3b525ff9bd939875ce26c95b7a058426f5e7 Author: Lars Ingebrigtsen Date: Mon May 9 11:46:56 2022 +0200 Fix doc string references to tags-loop-continue * lisp/vc/vc-dir.el (vc-dir-search, vc-dir-query-replace-regexp): Fix reference to obsolete tags-loop-continue (bug#55311). diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 18f5b07a7f..9cf6422de0 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -924,7 +924,7 @@ system." "Search through all marked files for a match for REGEXP. For marked directories, use the files displayed from those directories. Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]." +To continue searching for next match, use command \\[fileloop-continue]." (interactive "sSearch marked files (regexp): ") (tags-search regexp (mapcar #'car (vc-dir-marked-only-files-and-states)))) @@ -940,7 +940,7 @@ DEL or `n' to skip and go to the next match. For more directions, type \\[help-command] at that time. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace -with the command \\[tags-loop-continue]." +with the command \\[fileloop-continue]." ;; FIXME: this is almost a copy of `dired-do-query-replace-regexp'. This ;; should probably be made generic and used in both places instead of ;; duplicating it here. commit 52a27a67c1f501898bdb13841ce07609bbe4772e Author: Po Lu Date: Mon May 9 08:22:03 2022 +0000 Fix file-based launching on Haiku * src/haikuselect.c (Fhaiku_roster_launch): Canonicalize file names before using them. diff --git a/src/haikuselect.c b/src/haikuselect.c index 6d62f395c1..8ce7182298 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -821,7 +821,7 @@ after it starts. */) team_id team_id; status_t rc; ptrdiff_t i, nargs; - Lisp_Object tem; + Lisp_Object tem, canonical; void *message; specpdl_ref depth; @@ -840,9 +840,10 @@ after it starts. */) { CHECK_LIST (file_or_type); tem = XCAR (file_or_type); + canonical = Fexpand_file_name (tem, Qnil); CHECK_STRING (tem); - SAFE_ALLOCA_STRING (file, ENCODE_FILE (tem)); + SAFE_ALLOCA_STRING (file, ENCODE_FILE (canonical)); CHECK_LIST_END (XCDR (file_or_type), file_or_type); } commit 09866bb019d005ac5a8c475fe0b173fa35228d11 Author: Po Lu Date: Mon May 9 07:54:54 2022 +0000 Use default external browser by default on Haiku * lisp/net/browse-url.el (browse-url-default-browser): Use that by default on Haiku. (browse-url-default-haiku-browser): New function. * src/haiku_support.cc (be_roster_launch): * src/haiku_support.h: New function. Update prototypes. * src/haikuselect.c (haiku_message_to_lisp): Encode and decode files correctly. (haiku_lisp_to_message): Encode and decode files correctly. (Fhaiku_roster_launch): New function. (syms_of_haikuselect): Update defsubrs. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 66898d7707..c563a27ac8 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1019,6 +1019,8 @@ instead of `browse-url-new-window-flag'." 'browse-url-default-windows-browser) ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) + ((featurep 'haiku) + 'browse-url-default-haiku-browser) ((browse-url-can-use-xdg-open) 'browse-url-xdg-open) ;;; ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) ((executable-find browse-url-mozilla-program) 'browse-url-mozilla) @@ -1239,6 +1241,24 @@ The optional argument NEW-WINDOW is not used." (function-put 'browse-url-webpositive 'browse-url-browser-kind 'external) +(declare-function haiku-roster-launch "haikuselect.c") + +;;;###autoload +(defun browse-url-default-haiku-browser (url &optional _new-window) + "Browse URL with the system default browser. +Default to the URL around or before point." + (interactive (browse-url-interactive-arg "URL: ")) + (setq url (browse-url-encode-url url)) + (let* ((scheme (save-match-data + (if (string-match "\\(.+\\):/" url) + (match-string 1 url) + "http"))) + (mime (concat "application/x-vnd.Be.URL." scheme))) + (haiku-roster-launch mime (vector url)))) + +(function-put 'browse-url-default-haiku-browser + 'browse-url-browser-kind 'external) + ;;;###autoload (defun browse-url-emacs (url &optional same-window) "Ask Emacs to load URL into a buffer and show it in another window. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 27a676dd31..6b4951e139 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include #include @@ -5071,3 +5072,36 @@ BWindow_set_sticky (void *window, bool sticky) w->UnlockLooper (); } } + +status_t +be_roster_launch (const char *type, const char *file, char **cargs, + ptrdiff_t nargs, void *message, team_id *team_id) +{ + BEntry entry; + entry_ref ref; + + if (type) + { + if (message) + return be_roster->Launch (type, (BMessage *) message, + team_id); + + return be_roster->Launch (type, (nargs > INT_MAX + ? INT_MAX : nargs), + cargs, team_id); + } + + if (entry.SetTo (file) != B_OK) + return B_ERROR; + + if (entry.GetRef (&ref) != B_OK) + return B_ERROR; + + if (message) + return be_roster->Launch (&ref, (BMessage *) message, + team_id); + + return be_roster->Launch (&ref, (nargs > INT_MAX + ? INT_MAX : nargs), + cargs, team_id); +} diff --git a/src/haiku_support.h b/src/haiku_support.h index eaca7a9bad..416c717546 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -690,6 +690,8 @@ extern bool be_select_font (void (*) (void), bool (*) (void), int *, bool, int, int, int); extern int be_find_font_indices (struct haiku_font_pattern *, int *, int *); +extern status_t be_roster_launch (const char *, const char *, char **, + ptrdiff_t, void *, team_id *); #ifdef __cplusplus } diff --git a/src/haikuselect.c b/src/haikuselect.c index a186acc66f..6d62f395c1 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -275,7 +275,7 @@ haiku_message_to_lisp (void *message) if (!pbuf) memory_full (SIZE_MAX); - t1 = build_string (pbuf); + t1 = DECODE_FILE (build_string (pbuf)); free (pbuf); break; @@ -526,7 +526,8 @@ haiku_lisp_to_message (Lisp_Object obj, void *message) case 'RREF': CHECK_STRING (data); - if (be_add_refs_data (message, SSDATA (name), SSDATA (data)) + if (be_add_refs_data (message, SSDATA (name), + SSDATA (ENCODE_FILE (data))) && haiku_signal_invalid_refs) signal_error ("Invalid file name", data); break; @@ -799,6 +800,87 @@ ignored if it is dropped on top of FRAME. */) return unbind_to (idx, Qnil); } +DEFUN ("haiku-roster-launch", Fhaiku_roster_launch, Shaiku_roster_launch, + 2, 2, 0, + doc: /* Launch an application associated with FILE-OR-TYPE. +Return the process ID of the application, or nil if no application was +launched. + +FILE-OR-TYPE can either be a string denoting a MIME type, or a list +with one argument FILE, denoting a file whose associated application +will be launched. + +ARGS can either be a vector of strings containing the arguments that +will be passed to the application, or a system message in the form +accepted by `haiku-drag-message' that will be sent to the application +after it starts. */) + (Lisp_Object file_or_type, Lisp_Object args) +{ + char **cargs; + char *type, *file; + team_id team_id; + status_t rc; + ptrdiff_t i, nargs; + Lisp_Object tem; + void *message; + specpdl_ref depth; + + type = NULL; + file = NULL; + cargs = NULL; + message = NULL; + nargs = 0; + depth = SPECPDL_INDEX (); + + USE_SAFE_ALLOCA; + + if (STRINGP (file_or_type)) + SAFE_ALLOCA_STRING (type, file_or_type); + else + { + CHECK_LIST (file_or_type); + tem = XCAR (file_or_type); + + CHECK_STRING (tem); + SAFE_ALLOCA_STRING (file, ENCODE_FILE (tem)); + CHECK_LIST_END (XCDR (file_or_type), file_or_type); + } + + if (VECTORP (args)) + { + nargs = ASIZE (args); + cargs = SAFE_ALLOCA (nargs * sizeof *cargs); + + for (i = 0; i < nargs; ++i) + { + tem = AREF (args, i); + CHECK_STRING (tem); + maybe_quit (); + + cargs[i] = SAFE_ALLOCA (SBYTES (tem) + 1); + memcpy (cargs[i], SDATA (tem), SBYTES (tem) + 1); + } + } + else + { + message = be_create_simple_message (); + + record_unwind_protect_ptr (BMessage_delete, message); + haiku_lisp_to_message (args, message); + } + + block_input (); + rc = be_roster_launch (type, file, cargs, nargs, message, + &team_id); + unblock_input (); + + if (rc == B_OK) + return SAFE_FREE_UNBIND_TO (depth, + make_uint (team_id)); + + return SAFE_FREE_UNBIND_TO (depth, Qnil); +} + static Lisp_Object haiku_note_drag_motion_1 (void *data) { @@ -860,6 +942,7 @@ used to retrieve the current position of the mouse. */); defsubr (&Shaiku_selection_put); defsubr (&Shaiku_selection_owner_p); defsubr (&Shaiku_drag_message); + defsubr (&Shaiku_roster_launch); haiku_dnd_frame = NULL; } commit 364e3d7a4f93a718794d0d1b59449addb76cf4d9 Merge: 8343c2d5f6 d24ea263e2 Author: Stefan Kangas Date: Mon May 9 06:30:29 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: d24ea263e2 dired-do-query-replace-regexp doc string fix commit 8343c2d5f6f470458bdedc3283d0e9beecb07620 Merge: 1a21535725 1d012e0a62 Author: Stefan Kangas Date: Mon May 9 06:30:28 2022 +0200 Merge from origin/emacs-28 1d012e0a62 Linux console: don't translate ESC TAB to `backtab' in inp... commit 1a215357255004f2757d8d20dc0ecc61d29d93dc Merge: d8a4782310 e683b08b3f Author: Stefan Kangas Date: Mon May 9 06:30:28 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: e683b08b3f Handle changed scp protocol in Tramp, don't merge commit d8a47823103da803b8274d790527f48d85a3f9b4 Author: Po Lu Date: Mon May 9 02:52:16 2022 +0000 Fix stipple bitmap caching on Haiku * src/image.c (image_create_bitmap_from_file): Set file name on the bitmap rec on Haiku. diff --git a/src/image.c b/src/image.c index 6cd0aa48cf..0c14173d83 100644 --- a/src/image.c +++ b/src/image.c @@ -781,7 +781,7 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) dpyinfo->bitmaps[id - 1].img = bitmap; dpyinfo->bitmaps[id - 1].depth = 1; - dpyinfo->bitmaps[id - 1].file = NULL; + dpyinfo->bitmaps[id - 1].file = xlispstrdup (file); dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; dpyinfo->bitmaps[id - 1].refcount = 1; commit 6ec29d0566042c65956d46fd1a30c6182ce0e537 Author: Po Lu Date: Mon May 9 10:13:43 2022 +0800 Allow disabling Motif drag protocol * lisp/cus-start.el (standard): Add new variable. * src/xterm.c (x_dnd_update_state, handle_one_xevent): Respect new variable. (syms_of_xterm): New variable `x-dnd-disable-motif-drag'. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 83ab61b28b..d8c4b48035 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -832,6 +832,7 @@ since it could result in memory overflow and make Emacs crash." (scroll-bar-adjust-thumb-portion windows boolean "24.4") (x-scroll-event-delta-factor mouse float "29.1") (x-gtk-use-native-input keyboard boolean "29.1") + (x-dnd-disable-motif-drag dnd boolean "29.1") ;; xselect.c (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c @@ -870,6 +871,8 @@ since it could result in memory overflow and make Emacs crash." ((or (equal "scroll-bar-adjust-thumb-portion" (symbol-name symbol)) (equal "x-scroll-event-delta-factor" + (symbol-name symbol)) + (equal "x-dnd-disable-motif-drag" (symbol-name symbol))) (featurep 'x)) ((string-match "\\`x-" (symbol-name symbol)) diff --git a/src/xterm.c b/src/xterm.c index 2bbc9f3d0c..c9e2618191 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14053,6 +14053,7 @@ x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp) x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); else if (x_dnd_last_seen_window != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) { if (!x_dnd_motif_setup_p) @@ -14092,6 +14093,7 @@ x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp) x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); else if (x_dnd_last_seen_window != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) { if (!x_dnd_motif_setup_p) @@ -14117,7 +14119,8 @@ x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp) if (target != None && x_dnd_last_protocol_version != -1) x_dnd_send_enter (x_dnd_frame, target, x_dnd_last_protocol_version); - else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)) + else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag) { if (!x_dnd_motif_setup_p) xm_setup_drag_info (dpyinfo, x_dnd_frame); @@ -14148,7 +14151,8 @@ x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp) 0 #endif ); - else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) + else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None + && !x_dnd_disable_motif_drag) { if (!x_dnd_motif_setup_p) xm_setup_drag_info (dpyinfo, x_dnd_frame); @@ -15875,6 +15879,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); else if (x_dnd_last_seen_window != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) { if (!x_dnd_motif_setup_p) @@ -15914,6 +15919,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); else if (x_dnd_last_seen_window != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && x_dnd_disable_motif_drag && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) { if (!x_dnd_motif_setup_p) @@ -15960,7 +15966,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (target != None && x_dnd_last_protocol_version != -1) x_dnd_send_enter (x_dnd_frame, target, x_dnd_last_protocol_version); - else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)) + else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag) { if (!x_dnd_motif_setup_p) xm_setup_drag_info (dpyinfo, x_dnd_frame); @@ -15987,7 +15994,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_selection_timestamp, x_dnd_wanted_action, 0, event->xmotion.state); - else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) + else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None + && !x_dnd_disable_motif_drag) { if (!x_dnd_motif_setup_p) xm_setup_drag_info (dpyinfo, x_dnd_frame); @@ -17454,6 +17462,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); else if (x_dnd_last_seen_window != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) { if (!x_dnd_motif_setup_p) @@ -17493,6 +17502,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); else if (x_dnd_last_seen_window != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) { if (!x_dnd_motif_setup_p) @@ -17541,7 +17551,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (target != None && x_dnd_last_protocol_version != -1) x_dnd_send_enter (x_dnd_frame, target, x_dnd_last_protocol_version); - else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)) + else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && !x_dnd_disable_motif_drag) { if (!x_dnd_motif_setup_p) xm_setup_drag_info (dpyinfo, x_dnd_frame); @@ -17581,7 +17592,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_wanted_action, 0, dnd_state); } - else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) + else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None + && !x_dnd_disable_motif_drag) { if (!x_dnd_motif_setup_p) xm_setup_drag_info (dpyinfo, x_dnd_frame); @@ -24906,6 +24918,13 @@ during a drag-and-drop session, to work around broken implementations of Motif. */); x_dnd_fix_motif_leave = true; + DEFVAR_BOOL ("x-dnd-disable-motif-drag", x_dnd_disable_motif_drag, + doc: /* Disable the Motif drag protocol during DND. +This reduces network usage, but also means you can no longer scroll +around inside the Motif window underneath the cursor during +drag-and-drop. */); + x_dnd_disable_motif_drag = false; + DEFVAR_LISP ("x-dnd-movement-function", Vx_dnd_movement_function, doc: /* Function called upon mouse movement on a frame during drag-and-drop. It should either be nil, or accept two arguments FRAME and POSITION, commit fd8eaa72a611d050e1fe9c38c466c7812c7795dd Author: Po Lu Date: Mon May 9 09:37:58 2022 +0800 Allow precision-scrolling nonselected windows when the minibuffer is resized * doc/lispref/windows.texi (Vertical Scrolling): Document new `preserve-vscroll-p' parameter of `set-window-vscroll'. * etc/NEWS: Announce new parameter. * lisp/pixel-scroll.el (pixel-scroll-precision-scroll-down-page) (pixel-scroll-precision-scroll-up-page): Use that parameter when setting the vscroll. * src/window.c (window_scroll_pixel_based, Fset_window_vscroll): Adjust for new parameter. * src/window.h (struct window): New flag `preserve_vscroll_p'. * src/xdisp.c (redisplay_window): Preserve the vscroll inside force_start on frozen windows with that flag set. (bug#55312) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 97908bea00..57763c146d 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -5508,7 +5508,7 @@ pixels, rather than in units of the normal line height. @end example @end defun -@defun set-window-vscroll window lines &optional pixels-p +@defun set-window-vscroll window lines &optional pixels-p preserve-vscroll-p This function sets @var{window}'s vertical scroll position to @var{lines}. If @var{window} is @code{nil}, the selected window is used. The argument @var{lines} should be zero or positive; if not, it @@ -5530,6 +5530,12 @@ The return value is the result of this rounding. If @var{pixels-p} is non-@code{nil}, @var{lines} specifies a number of pixels. In this case, the return value is @var{lines}. + +Normally, the vscroll does not take effect on windows that aren't the +@code{minibuffer-scroll-window} or the selected window when the +mini-window is resized (@pxref{Minibuffer Windows}). This ``frozen'' +behavior is disabled when the @var{preserve-vscroll-p} parameter is +non-@code{nil}, which means to set the vscroll as usual. @end defun @defvar auto-window-vscroll diff --git a/etc/NEWS b/etc/NEWS index dbdc161a41..5860010f02 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2100,6 +2100,11 @@ dimensions. Specifying a cons as the FROM argument allows to start measuring text from a specified amount of pixels above or below a position. ++++ +** 'set-window-vscroll' now accepts a new argument PRESERVE-VSCROLL-P. +This means the vscroll will not be reset when set on a window that is +"frozen" due to a mini-window being resized. + ** XDG support --- diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index b0fe2f56c0..fc7e680c26 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -547,7 +547,7 @@ the height of the current window." (beginning-of-visual-line) (point))) t) - (set-window-vscroll nil desired-vscroll t))) + (set-window-vscroll nil desired-vscroll t t))) (defun pixel-scroll-precision-scroll-down (delta) "Scroll the current window down by DELTA pixels." @@ -586,7 +586,7 @@ the height of the current window." (goto-char up-point))) (let ((current-vscroll (window-vscroll nil t))) (setq delta (- delta current-vscroll)) - (set-window-vscroll nil 0 t) + (set-window-vscroll nil 0 t t) (when (> delta 0) (let* ((start (window-start)) (dims (window-text-pixel-size nil (cons start (- delta)) @@ -602,7 +602,7 @@ the height of the current window." (signal 'beginning-of-buffer nil)) (setq delta (- delta height)))) (when (< delta 0) - (set-window-vscroll nil (- delta) t))))) + (set-window-vscroll nil (- delta) t t))))) (defun pixel-scroll-precision-interpolate (delta &optional old-window) "Interpolate a scroll of DELTA pixels. diff --git a/src/window.c b/src/window.c index 72d10f9da2..47c008a643 100644 --- a/src/window.c +++ b/src/window.c @@ -5636,7 +5636,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) if (w->vscroll < 0 && rtop > 0) { px = max (0, -w->vscroll - min (rtop, -dy)); - Fset_window_vscroll (window, make_fixnum (px), Qt); + Fset_window_vscroll (window, make_fixnum (px), Qt, + Qnil); return; } } @@ -5646,7 +5647,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) if (rbot > 0 && (w->vscroll < 0 || vpos == 0)) { px = max (0, -w->vscroll + min (rbot, dy)); - Fset_window_vscroll (window, make_fixnum (px), Qt); + Fset_window_vscroll (window, make_fixnum (px), Qt, + Qnil); return; } @@ -5655,7 +5657,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) { ptrdiff_t spos; - Fset_window_vscroll (window, make_fixnum (0), Qt); + Fset_window_vscroll (window, make_fixnum (0), Qt, + Qnil); /* If there are other text lines above the current row, move window start to current row. Else to next row. */ if (rbot > 0) @@ -5674,7 +5677,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) } } /* Cancel previous vscroll. */ - Fset_window_vscroll (window, make_fixnum (0), Qt); + Fset_window_vscroll (window, make_fixnum (0), Qt, Qnil); } itdata = bidi_shelve_cache (); @@ -7944,7 +7947,7 @@ optional second arg PIXELS-P means value is measured in pixels. */) DEFUN ("set-window-vscroll", Fset_window_vscroll, Sset_window_vscroll, - 2, 3, 0, + 2, 4, 0, doc: /* Set amount by which WINDOW should be scrolled vertically to VSCROLL. This takes effect when displaying tall lines or images. @@ -7954,8 +7957,12 @@ optional third arg PIXELS-P non-nil means that VSCROLL is in pixels. If PIXELS-P is nil, VSCROLL may have to be rounded so that it corresponds to an integral number of pixels. The return value is the result of this rounding. -If PIXELS-P is non-nil, the return value is VSCROLL. */) - (Lisp_Object window, Lisp_Object vscroll, Lisp_Object pixels_p) +If PIXELS-P is non-nil, the return value is VSCROLL. + +PRESERVE_VSCROLL_P makes setting the start of WINDOW preserve the +vscroll if its start is "frozen" due to a resized mini-window. */) + (Lisp_Object window, Lisp_Object vscroll, Lisp_Object pixels_p, + Lisp_Object preserve_vscroll_p) { struct window *w = decode_live_window (window); struct frame *f = XFRAME (w->frame); @@ -7984,6 +7991,8 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */) /* Mark W for redisplay. (bug#55299) */ wset_redisplay (w); } + + w->preserve_vscroll_p = !NILP (preserve_vscroll_p); } return Fwindow_vscroll (window, pixels_p); diff --git a/src/window.h b/src/window.h index 387a3be36a..7f7de58846 100644 --- a/src/window.h +++ b/src/window.h @@ -445,6 +445,10 @@ struct window window. */ bool_bf suspend_auto_hscroll : 1; + /* True if vscroll should be preserved while forcing the start due + to a frozen window. */ + bool_bf preserve_vscroll_p : 1; + /* Amount by which lines of this window are scrolled in y-direction (smooth scrolling). */ int vscroll; diff --git a/src/xdisp.c b/src/xdisp.c index f09f209b2e..b9b3c6d1bf 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19168,7 +19168,14 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) int new_vpos = -1; w->force_start = false; - w->vscroll = 0; + + /* The vscroll should be preserved in this case, since + `pixel-scroll-precision-mode' must continue working normally + when a mini-window is resized. (bug#55312) */ + if (!w->preserve_vscroll_p || !window_frozen_p (w)) + w->vscroll = 0; + + w->preserve_vscroll_p = false; w->window_end_valid = false; /* Forget any recorded base line for line number display. */ commit 3d846efb857c0ace95d6fe026522fcdbffe04dc3 Author: Po Lu Date: Mon May 9 09:17:28 2022 +0800 Fix race conditions in handling of unsupported drops on X * lisp/x-dnd.el (x-dnd-handle-unsupported-drop): Adjust for new parameters. * src/keyboard.c (kbd_buffer, kbd_fetch_ptr, kbd_store_ptr): Export variables. (kbd_buffer_get_event): Ignore already handled unsupported drops. * src/keyboard.h: Update prototypes. * src/termhooks.h (enum event_kind): Document meaning of `modifiers' in UNSUPPORTED_DROP_EVENTs. * src/xterm.c (x_dnd_send_unsupported_drop): Set event modifiers to current level. (x_toggle_visible_pointer): Fix fixes fallback. (x_dnd_begin_drag_and_drop): Handle UNSUPPORTED_DROP_EVENTs already in the keyboard buffer before starting DND. (syms_of_xterm): Give timestamp to unsupported drop function. * src/xterm.h: Update prototypes. diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 47d8ae14cf..c2498a57a1 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -783,7 +783,7 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." ;;; Handling drops. -(defun x-dnd-handle-unsupported-drop (targets _x _y action _window-id _frame) +(defun x-dnd-handle-unsupported-drop (targets _x _y action _window-id _frame _time) "Return non-nil if the drop described by TARGETS and ACTION should not proceeed." (not (and (or (eq action 'XdndActionCopy) (eq action 'XdndActionMove)) diff --git a/src/keyboard.c b/src/keyboard.c index 70908120cb..e8f51f8a6f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -95,8 +95,6 @@ volatile int interrupt_input_blocked; The maybe_quit function checks this. */ volatile bool pending_signals; -enum { KBD_BUFFER_SIZE = 4096 }; - KBOARD *initial_kboard; KBOARD *current_kboard; static KBOARD *all_kboards; @@ -290,14 +288,14 @@ bool input_was_pending; /* Circular buffer for pre-read keyboard input. */ -static union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE]; +union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE]; /* Pointer to next available character in kbd_buffer. If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. */ -static union buffered_input_event *kbd_fetch_ptr; +union buffered_input_event *kbd_fetch_ptr; /* Pointer to next place to store character in kbd_buffer. */ -static union buffered_input_event *kbd_store_ptr; +union buffered_input_event *kbd_store_ptr; /* The above pair of variables forms a "queue empty" flag. When we enqueue a non-hook event, we increment kbd_store_ptr. When we @@ -4022,6 +4020,11 @@ kbd_buffer_get_event (KBOARD **kbp, kbd_fetch_ptr = next_kbd_event (event); input_pending = readable_events (0); + /* This means this event was already handled in + `x_dnd_begin_drag_and_drop'. */ + if (event->ie.modifiers < x_dnd_unsupported_event_level) + break; + f = XFRAME (event->ie.frame_or_window); if (!FRAME_LIVE_P (f)) @@ -4029,11 +4032,12 @@ kbd_buffer_get_event (KBOARD **kbp, if (!NILP (Vx_dnd_unsupported_drop_function)) { - if (!NILP (call6 (Vx_dnd_unsupported_drop_function, + if (!NILP (call7 (Vx_dnd_unsupported_drop_function, XCAR (XCDR (event->ie.arg)), event->ie.x, event->ie.y, XCAR (XCDR (XCDR (event->ie.arg))), make_uint (event->ie.code), - event->ie.frame_or_window))) + event->ie.frame_or_window, + make_int (event->ie.timestamp)))) break; } diff --git a/src/keyboard.h b/src/keyboard.h index cd5f677b96..a0b7204fa2 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -358,6 +358,11 @@ enum menu_item_idx MENU_ITEMS_ITEM_LENGTH }; +enum + { + KBD_BUFFER_SIZE = 4096 + }; + extern void unuse_menu_items (void); /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU @@ -419,6 +424,10 @@ extern void unuse_menu_items (void); happens. */ extern struct timespec *input_available_clear_time; +extern union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE]; +extern union buffered_input_event *kbd_fetch_ptr; +extern union buffered_input_event *kbd_store_ptr; + extern bool ignore_mouse_drag_p; extern Lisp_Object parse_modifiers (Lisp_Object); diff --git a/src/termhooks.h b/src/termhooks.h index 8c193914ba..08bde0aec0 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -223,6 +223,11 @@ enum event_kind gives the timestamp where the drop happened. + .modifiers gives a number that + determines if an event was already + handled by + `x_dnd_begin_drag_and_drop'. + .x and .y give the coordinates of the drop originating from the root window. */ diff --git a/src/xterm.c b/src/xterm.c index d32bdea843..2bbc9f3d0c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -868,6 +868,10 @@ static int x_filter_event (struct x_display_info *, XEvent *); /* Flag that indicates if a drag-and-drop operation is in progress. */ bool x_dnd_in_progress; +/* Number that indicates the last "generation" of + UNSUPPORTED_DROP_EVENTs handled. */ +unsigned x_dnd_unsupported_event_level; + /* The frame where the drag-and-drop operation originated. */ struct frame *x_dnd_frame; @@ -3070,6 +3074,7 @@ x_dnd_send_unsupported_drop (struct x_display_info *dpyinfo, Window target_windo ie.kind = UNSUPPORTED_DROP_EVENT; ie.code = (unsigned) target_window; + ie.modifiers = x_dnd_unsupported_event_level; ie.arg = list3 (assq_no_quit (QXdndSelection, dpyinfo->terminal->Vselection_alist), targets, arg); @@ -9479,15 +9484,18 @@ x_toggle_visible_pointer (struct frame *f, bool invisible) invisible = false; #else /* But if Xfixes is available, try using it instead. */ - if (x_probe_xfixes_extension (dpyinfo)) + if (dpyinfo->invisible_cursor == None) { - dpyinfo->fixes_pointer_blanking = true; - xfixes_toggle_visible_pointer (f, invisible); + if (x_probe_xfixes_extension (dpyinfo)) + { + dpyinfo->fixes_pointer_blanking = true; + xfixes_toggle_visible_pointer (f, invisible); - return; + return; + } + else + invisible = false; } - else - invisible = false; #endif if (invisible) @@ -9864,6 +9872,64 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, #ifndef USE_GTK struct x_display_info *event_display; #endif + union buffered_input_event *events, *event; + int n_events; + struct frame *event_frame; + + /* Before starting drag-and-drop, walk through the keyboard buffer + to see if there are any UNSUPPORTED_DROP_EVENTs, and run them now + if they exist, to prevent race conditions from happening due to + multiple unsupported drops running at once. */ + + block_input (); + events = alloca (sizeof *events * KBD_BUFFER_SIZE); + n_events = 0; + event = kbd_fetch_ptr; + + while (event != kbd_store_ptr) + { + if (event->ie.kind == UNSUPPORTED_DROP_EVENT + && event->ie.modifiers < x_dnd_unsupported_event_level) + events[n_events++] = *event; + + event = (event == kbd_buffer + KBD_BUFFER_SIZE - 1 + ? kbd_buffer : event + 1); + } + + x_dnd_unsupported_event_level += 1; + unblock_input (); + + for (i = 0; i < n_events; ++i) + { + maybe_quit (); + + event = &events[i]; + event_frame = XFRAME (event->ie.frame_or_window); + + if (!FRAME_LIVE_P (event_frame)) + continue; + + if (!NILP (Vx_dnd_unsupported_drop_function)) + { + if (!NILP (call7 (Vx_dnd_unsupported_drop_function, + XCAR (XCDR (event->ie.arg)), event->ie.x, + event->ie.y, XCAR (XCDR (XCDR (event->ie.arg))), + make_uint (event->ie.code), + event->ie.frame_or_window, + make_int (event->ie.timestamp)))) + continue; + } + + x_dnd_do_unsupported_drop (FRAME_DISPLAY_INFO (event_frame), + event->ie.frame_or_window, + XCAR (event->ie.arg), + XCAR (XCDR (event->ie.arg)), + (Window) event->ie.code, + XFIXNUM (event->ie.x), + XFIXNUM (event->ie.y), + event->ie.timestamp); + break; + } if (!FRAME_VISIBLE_P (f)) { @@ -24849,16 +24915,16 @@ mouse position list. */); DEFVAR_LISP ("x-dnd-unsupported-drop-function", Vx_dnd_unsupported_drop_function, doc: /* Function called when trying to drop on an unsupported window. -This function is called whenever the user tries to drop -something on a window that does not support either the XDND or -Motif protocols for drag-and-drop. It should return a non-nil -value if the drop was handled by the function, and nil if it was -not. It should accept several arguments TARGETS, X, Y, ACTION, -WINDOW-ID and FRAME, where TARGETS is the list of targets that -was passed to `x-begin-drag', WINDOW-ID is the numeric XID of -the window that is being dropped on, X and Y are the root -window-relative coordinates where the drop happened, ACTION -is the action that was passed to `x-begin-drag', and FRAME is -the frame which initiated the drag-and-drop operation. */); +This function is called whenever the user tries to drop something on a +window that does not support either the XDND or Motif protocols for +drag-and-drop. It should return a non-nil value if the drop was +handled by the function, and nil if it was not. It should accept +several arguments TARGETS, X, Y, ACTION, WINDOW-ID, FRAME and TIME, +where TARGETS is the list of targets that was passed to +`x-begin-drag', WINDOW-ID is the numeric XID of the window that is +being dropped on, X and Y are the root window-relative coordinates +where the drop happened, ACTION is the action that was passed to +`x-begin-drag', FRAME is the frame which initiated the drag-and-drop +operation, and TIME is the X server time when the drop happened. */); Vx_dnd_unsupported_drop_function = Qnil; } diff --git a/src/xterm.h b/src/xterm.h index 66c4b17823..16635053be 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1586,6 +1586,7 @@ extern struct input_event xg_pending_quit_event; extern bool x_dnd_in_progress; extern struct frame *x_dnd_frame; +extern unsigned x_dnd_unsupported_event_level; #ifdef HAVE_XINPUT2 extern struct xi_device_t *xi_device_from_id (struct x_display_info *, int); commit 8d788a195f68bf7451635f7d4dfe86a6dc2bbda5 Author: Sean Whitton Date: Sun May 8 13:45:35 2022 -0700 remember-notes: Use pop-to-buffer-same-window not switch-to-buffer * lisp/textmodes/remember.el (remember-notes): Use pop-to-buffer-same-window rather than switch-to-buffer, to allow customization via display-buffer-alist. diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index d65aea6286..e72f86f7db 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -653,7 +653,7 @@ to turn the *scratch* buffer into your notes buffer." (remember-notes-mode 1) (current-buffer))))) (when switch-to - (switch-to-buffer buf)) + (pop-to-buffer-same-window buf)) buf)) (defun remember-notes--kill-buffer-query () commit 21ef29d4b1ea85c4b94232f028b3aa29a4a1a81b Author: Juri Linkov Date: Sun May 8 21:01:34 2022 +0300 Minor documentation improvements for completions commands and options * doc/emacs/mini.texi (Completion Commands): Mention prefix argument of choose-completion. (Completion Options): Improve documentation of completions-format and completions-sort. diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index a899fea7e3..ad5701670e 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -381,16 +381,16 @@ used with the completion list: @vindex minibuffer-completion-auto-choose @item M-@key{DOWN} @itemx M-@key{UP} -These keys will navigate through the completions displayed in the -completions buffer. When @code{minibuffer-completion-auto-choose} is -non-@code{nil} (which is the default), using these commands will -automatically insert the current completion candidate in the -minibuffer. If this user option is @code{nil}, the keys will navigate -the same way as before, but won't automatically insert the candidate -in the minibuffer. Instead you have to use the @kbd{M-@key{RET}} command to -do that. With a prefix argument, @kbd{C-u M-@key{RET}} inserts the -currently active candidate to the minibuffer, but doesn't exit the -minibuffer. +While in the minibuffer, these keys will navigate through the +completions displayed in the completions buffer. When +@code{minibuffer-completion-auto-choose} is non-@code{nil} (which is +the default), using these commands will automatically insert the +current completion candidate in the minibuffer. If this user option +is @code{nil}, the keys will navigate the same way as before, but +won't automatically insert the candidate in the minibuffer. Instead +you have to use the @kbd{M-@key{RET}} command to do that. With +a prefix argument, @kbd{C-u M-@key{RET}} inserts the currently active +candidate to the minibuffer, but doesn't exit the minibuffer. @findex switch-to-completions @item M-v @@ -407,7 +407,9 @@ ways (@pxref{Windows}). @itemx mouse-1 @itemx mouse-2 While in the completion list buffer, this chooses the completion at -point (@code{choose-completion}). +point (@code{choose-completion}). With a prefix argument, @kbd{C-u +@key{RET}} inserts the completion at point to the minibuffer, but +doesn't exit the minibuffer. @findex next-completion @item @key{TAB} @@ -682,17 +684,19 @@ behavior only when there are @var{n} or fewer alternatives. @vindex completions-format When displaying completions, Emacs will normally pop up a new buffer -to display the completions. The completions will (by default) be -sorted in columns horizontally in alphabetical order, but this can be -changed by changing the @code{completions-format} user option. If -@code{vertical}, sort the completions vertically in columns instead, -and if @code{one-column}, just use a single column. +to display the completions. The completions will by default be sorted +in rows horizontally, but this can be changed by customizing the +@code{completions-format} user option. If @code{vertical}, sort the +completions vertically in columns instead, and if @code{one-column}, +just use a single column. @vindex completions-sort - This user option controls how completions are sorted in the -@samp{*Completions*} buffer. The default is @code{alphabetical}, but -it can also be a function which will be called with the list of -completions, and should return the list in the desired order. + The @code{completions-sort} user option controls how completions are +sorted in the @samp{*Completions*} buffer. The default is +@code{alphabetical} that sorts in alphabetical order. The value +@code{nil} disables sorting. It can also be a function which will be +called with the list of completions, and should return the list in the +desired order. @vindex completions-max-height When @code{completions-max-height} is non-@code{nil}, it limits the diff --git a/etc/NEWS b/etc/NEWS index 234aa819be..dbdc161a41 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -892,7 +892,7 @@ When this user option names a face, the current candidate in the "*Completions*" buffer is highlighted with that face. The nil value disables this highlighting. ---- ++++ *** Choosing a completion with a prefix argument doesn't exit the minibuffer. This means that typing 'C-u RET' on a completion candidate in the "*Completions*" buffer inserts the completion to the minibuffer, commit 278b18a460caf34e422847d10ac3f0b62bef4996 Author: Eli Zaretskii Date: Sun May 8 19:08:34 2022 +0300 ; Fix typos and wording in a doc string * lisp/textmodes/pixel-fill.el (pixel-fill-width): Fix doc string. (Bug#55318) diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el index 418d6a37c9..e47653e734 100644 --- a/lisp/textmodes/pixel-fill.el +++ b/lisp/textmodes/pixel-fill.el @@ -45,9 +45,9 @@ of a line or the end of a line." (defun pixel-fill-width (&optional columns window) "Return the pixel width corresponding to COLUMNS in WINDOW. -If COLUMNS in nil, use the enture window width. +If COLUMNS is nil or omitted, use the entire window width. -If WINDOW is nil, this defaults to the current window." +If WINDOW is nil or omitted, this defaults to the selected window." (unless window (setq window (selected-window))) (let ((frame (window-frame window))) commit fad31cebe174cc35738de943eae8e34038f11b1a Author: Protesilaos Stavrou Date: Sun May 8 17:27:48 2022 +0300 Add Greek translation of the tutorial * etc/tutorials/TUTORIAL.el_GR: Add tutorial in Greek. It is a faithful translation of the TUTORIAL. * etc/tutorials/TUTORIAL.translators (Author): Mention myself as the author and the maintainer. * etc/NEWS: Announce it. (Bug#55314) * lisp/language/greek.el (set-language-info-alist): Link to the tutorial and include sample text. diff --git a/etc/NEWS b/etc/NEWS index 5d2b5e12cf..234aa819be 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -719,7 +719,7 @@ The options 'mouse-wheel-down-alternate-event', and 'mouse-wheel-right-alternate-event' have been added to better support systems where two kinds of wheel events can be received. -** Editing complex text layout (CTL) scripts +** Internationalization changes *** The function key now allows deleting the entire composed sequence. For the details, see the item about the 'delete-forward-char' command @@ -749,6 +749,11 @@ This language environment supports Tirhuta or Mithilaakshar, which is used to write the Maithili language. A new input method, 'tirhuta', is provided to type text in this script. +--- +*** New Greek translation of the Emacs tutorial. +Type 'C-u C-h t' to select it in case your language setup does not do +so automatically. + * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/etc/tutorials/TUTORIAL.el_GR b/etc/tutorials/TUTORIAL.el_GR new file mode 100644 index 0000000000..e001cc6cce --- /dev/null +++ b/etc/tutorials/TUTORIAL.el_GR @@ -0,0 +1,1268 @@ +Εκμάθηση του Emacs. Δες το τέλος για όρους αντιγραφής. + +Στο Emacs οι εντολές γενικά περιλαμβάνουν το πλήκτρο CONTROL (συχνά +αναγράφεται ως Ctrl) ή το πλήκτρο META (συνήθως επισημαίνεται ως ALT). +Αντί να γράφουμε το πλήρες όνομα κάθε φορά, θα χρησιμοποιούμε τις εξής +συντομογραφίες: + + C-<χαρ> σημαίνει κράτα πατημένο το πλήκτρο CONTROL καθώς + πληκτρολογείς τον χαρακτήρα <χάρ>. Συνεπώς, C-f είναι: + κράτα πατημένο το CONTROL και πληκτρολόγησε το f. + M-<χαρ> σημαίνει κράτα πατημένο το πλήκτρο META ή ALT καθώς + πληκτρολογείς τον χαρακτήρα <χάρ>. Σε περίπτωση που δεν + υπάρχει πλήκτρο META ή ALT, πληκτρολόγησε και απελευθέρωσε + το πλήκτρο ESC και κατόπιν πληκτρολόγησε τον <χάρ>. + Γράφουμε για το πλήκτρο ESC. + +Σημαντική σημείωση: για να τερματίσεις το Emacs, πληκτρολόγησε C-x +C-c. (Δύο χαρακτήρες.) Για να ακυρώσεις μια μερικώς πληκτρολογημένη +εντολή, πληκτρολόγησε C-g. +Για να σταματήσεις την εκμάθηση, πληκτρολόγησε C-x k, κατόπιν +στην προτροπή. +Οι χαρακτήρες ">>" στο αριστερό περιθώριο δείχνουν οδηγίες για να +δοκιμάσεις μια εντολή. Για παράδειγμα: +<> +[Το μέσο της σελίδας παραμένει κενό για διδακτικούς σκοπούς. Το +κείμενο συνεχίζεται παρακάτω.] + +>> Τώρα πληκτρολόγησε C-v (δες επόμενη οθόνη) ώστε να κυλήσεις πιο + κάτω στην παρούσα εκμάθηση. (Κάνε το, κρατώντας πατημένο το + πλήκτρο CONTROL και πληκτρολογώντας v.) Από εδώ και στο εξής, + παρακαλώ κάνε αυτό όποτε φτάνεις στο τέλος της οθόνης. + +Σημείωσε πως υπάρχει επικάλυψη δύο γραμμών όταν κυλάς μια πλήρη οθόνη: +αυτή σου προσφέρει κάποια συνέχεια ώστε να συνεχίσεις να διαβάζεις το +κείμενο. + +Αυτό είναι αντίγραφο του κειμένου εκμάθησης του Emacs, ελαφρά +τροποποιημένο για εσένα. Παρακάτω θα σου αναθέσουμε να δοκιμάσεις +μερικές εντολές που τροποποιούν το εν λόγω κείμενο. Μην ανησυχείς αν +τροποποιήσεις αυτό το κείμενο πριν σου το ζητήσουμε· η πράξη αυτή +αναφέρεται ως «επεξεργασία» και το Emacs χρησιμοποιείται για αυτόν τον +σκοπό. + +Το πρώτο πράγμα που πρέπει να γνωρίζεις είναι πως να κινείσαι από το +ένα σημείο σε άλλο σημείο του κειμένου. Ήδη ξέρεις πως να πηγαίνεις +μια οθόνη προς τα κάτω με το C-v. Για να κινηθείς αντίστροφα, +πληκτρολόγησε M-v (κράτα πατημένο το META και πληκτρολόγησε το v, ή +πληκτρολόγησε v εάν δεν έχει πλήκτρο META ή ALT). + +>> Δοκίμασε να πληκτρολογήσεις M-v και μετά C-v μερικές φορές. + +Είναι αποδεκτό να κυλήσεις το κείμενο με άλλους τρόπους, αν τους +ξέρεις. + +* ΣΥΝΟΨΗ +-------- + +Οι εξής εντολές είναι χρήσιμες για να βλέπεις πλήρης οθόνες: + + C-v Κινήσου μπροστά/κάτω μια πλήρη οθόνη + M-v Κινήσου πίσω/πάνω μια πλήρη οθόνη + + C-l Καθάρισε την οθόνη επανεμφανίζοντας το κείμενο της και + μεταφέροντας τον δείκτη (κέρσορα) στο κέντρο της. + (Αυτό είναι CONTROL-L, όχι CONTROL-1.) + +>> Εντόπισε τον δείκτη και σημείωσε το κείμενο πέριξ του. Μετά + πληκτρολόγησε C-l. Ξαναβρές τον δείκτη και παρατήρησε το κείμενο + δίπλα του, αλλά τώρα πρόσεξε πως βρίσκεται στο κέντρο της οθόνης. + Εάν πατήσεις C-l πάλι, το κείμενο αυτό θα μετατοπιστεί στο πάνω + μέρος της οθόνης. Πάτα το C-l ξανά και θα πάει στο κάτω μέρος. + +Μπορείς επίσης να χρησιμοποιήσεις τα πλήκτρα PageUp και PageDn για να +κινηθείς ανά πλήρη οθόνη, εάν ο ακροδέκτης (τερματικό) σου τα έχει, +ωστόσο είναι πιο αποτελεσματικό να χρησιμοποιείς τα C-v και M-v. + + +* ΒΑΣΙΚΟΣ ΕΛΕΓΧΟΣ ΤΟΥ ΔΕΙΚΤΗ +---------------------------- + +Η κίνηση ανά πλήρη οθόνη είναι χρήσιμη, αλλά πως θα πας σε +συγκεκριμένο σημείο εντός του κειμένου της οθόνης; + +Υπάρχουν πολλοί τρόποι να το επιτύχεις αυτό. Μπορείς να +χρησιμοποιήσεις τα πλήκτρα με τα βέλη, αλλά είναι πιο αποτελεσματικό +να κρατήσεις τα χέρια σου στην κανονική θέση και να χρησιμοποιήσεις +τις εντολές C-p, C-b, C-f, και C-n. Οι χαρακτήρες αυτοί είναι το +αντίστοιχο των τεσσάρων πλήκτρων με τα βέλη, κατά αυτόν τον τρόπο: + + Προηγούμενη γραμμή, C-p + : + : + Πίσω, C-b .... Παρούσα θέση του δείκτη .... Εμπρός, C-f + : + : + Επόμενη γραμμή, C-n + +>> Μετακίνησε τον δείκτη στη μέση του διαγράμματος αυτού + χρησιμοποιώντας C-n ή C-p. Μετά πληκτρολόγησε C-l για να δεις το + όλο διάγραμμα στο κέντρο της οθόνης. + +Θα σου είναι ευκολότερο να θυμάσαι αυτά τα γράμματα από τις λέξεις τις +οποίες αναφέρουν στην Αγγλική: P για προηγούμενο (previous), N για +επόμενο (next), B για πίσω (backward), και F για εμπρός (forward). Θα +χρησιμοποιείς διαρκώς αυτές τις βασικές εντολές για την τοποθέτηση του +δείκτη. + +>> Κάνε μερικά C-n μέχρι να φέρεις τον δείκτη σε αυτή την γραμμή. + +>> Κινήσου εντός της γραμμής με μερικά C-f και μετά πάνω με κάποια + C-p. Δες τι κάνει το C-p όταν βρίσκεται στην μέση της γραμμής. + +Κάθε γραμμή κειμένου τελειώνει με τον χαρακτήρα νέας γραμμής, που +επιτελεί τον σκοπό του διαχωρισμού της μίας γραμμής από την άλλη. +(Συνήθως η τελευταία γραμμή σε ένα αρχείο τελειώνει με τον χαρακτήρα +νέας γραμμής, ωστόσο το Emacs δεν απαιτεί κάτι τέτοιο.) + +>> Δοκίμασε το C-b στην αρχή της γραμμής. Θα μετακινήσει τον δείκτη + στο τέλος της προηγούμενης γραμμής. Διότι κινείται προς τα πίσω + προσπερνώντας τον χαρακτήρα νέας γραμμής. + +Το C-f έχει την ίδια συμπεριφορά με το C-b. + +>> Κάνε μερικά ακόμα C-b, ώστε να εντοπίσεις τον δείκτη. Κατόπιν + κάνε C-f για να γυρίσεις στο τέλος της γραμμής. Μετά ένα ακόμα C-f + για να κινηθείς στην αρχή της επόμενης γραμμής. + +Όταν κινείσαι πέρα από το πάνω ή κάτω μέρος της οθόνης, το κείμενο +πέραν της άκρης μετατοπίζεται εντός της οθόνης. Αυτό ονομάζεται +«κύλιση». Επιτρέπει στο Emacs να φέρει τον δείκτη στο ορισμένο +σημείο του κειμένου χωρίς να κινηθεί εκτός της οθόνης. + +>> Δοκίμασε να κινήσεις τον δείκτη πέρα από το κάτω μέρος της οθόνης + με το C-n και δες τι συμβαίνει. + +Εάν η κίνηση ανά χαρακτήρα είναι πολύ αργή, μπορείς να κινηθείς ανά +λέξη. Το M-f (META-f) πάει μπροστά μια λέξη και M-b πίσω μια λέξη. + +>> Πληκτρολόγησε μερικά M-f και M-b. + +Όταν βρίσκεσαι στο μέσο μιας λέξης, το M-f πηγαίνει στο τέλος της. +Όταν βρίσκεσαι σε κενό μεταξύ λέξεων, το M-f κινείται στο τέλος της +ακόλουθης λέξης. Το M-b λειτουργεί αναλόγως προς την αντίθετη +κατεύθυνση. + +>> Πληκτρολόγησε M-f και M-b μερικές φορές, με C-f και C-b μεταξύ τους + ώστε να παρατηρήσεις την δράση των M-f και M-b σε διάφορα σημεία + εντός και μεταξύ λέξεων. + +Παρατήρησε την παράλληλο μεταξύ C-f και C-b από την μία, και M-f και +M-b από την άλλη. Πολύ συχνά οι Meta χαρακτήρες χρησιμοποιούνται για +πράξεις που σχετίζονται με μονάδες που ορίζει η εκάστοτε γλώσσα +(λέξεις, προτάσεις, παραγράφους), ενώ οι Control χαρακτήρες επιδρούν +σε βασικά στοιχεία που είναι ανεξάρτητα του τι επεξεργάζεσαι +(χαρακτήρες, γραμμές, κτλ.). + +Αυτή η παράλληλος ισχύει μεταξύ γραμμών και προτάσεων. C-a και C-e +πηγαίνουν στην αρχή και το τέλος της γραμμής, ενώ M-a και M-e +πηγαίνουν στην αρχή και το τέλος της πρότασης. + +>> Δοκίμασε δύο C-a και ύστερα δύο C-e. + Δοκίμασε δύο M-a και ύστερα δύο M-e. + +Παρατήρησε πως αλλεπάλληλα C-a δεν κάνουν τίποτα, ενώ επανειλημμένα +M-a συνεχίζουν να κινούνται ανά μία πρόταση. Παρότι δεν είναι +ανάλογα, το καθένα φαντάζει φυσικό. + +Η θέση του δείκτη εντός του κειμένου ονομάζεται «σημείο» (point). Με +άλλα λόγια, ο δείκτης δείχνει που βρίσκεται το σημείο εντός του +κειμένου στην οθόνη. + +Ιδού μία σύνοψη των απλών κινήσεων του δείκτη, συμπεριλαμβανομένων +των εντολών για κίνηση ανά λέξη και πρόταση: + + C-f Κινήσου εμπρός ένα χαρακτήρα + C-b Κινήσου πίσω ένα χαρακτήρα + + M-f Κινήσου εμπρός μία λέξη + M-b Κινήσου πίσω μία λέξη + + C-n Κινήσου στην επόμενη γραμμή + C-p Κινήσου στην προηγούμενη γραμμή + + C-a Κινήσου στην αρχή της γραμμής + C-e Κινήσου στο τέλος της γραμμής + + M-a Κινήσου πίσω στην αρχή της πρότασης + M-e Κινήσου εμπρός στο τέλος της πρότασης + +>> Δοκίμασε όλες αυτές τις εντολές μερικές φορές για εξάσκηση. Αυτές + είναι οι πιο συνηθισμένες εντολές. + +Δύο άλλες σημαντικές κινήσεις του δείκτη είναι το M-< (META +Μικρότερο), που κινείται στην αρχή ολόκληρου του κειμένου, και M-> +(META Μεγαλύτερο) που κινείται στο τέλος ολόκληρου του κειμένου. + +Στους πλείστους ακροδέκτες (τερματικά), το '<' είναι στο ίδιο πλήκτρο +με το κόμμα, οπότε πρέπει να κρατάς πατημένο το shift για να το +πληκτρολογήσεις. Σε αυτούς τους ακροδέκτες πρέπει να χρησιμοποιήσεις +το shift και για το M-<, αλλιώς θα πατάς M-κόμμα. + +>> Δοκίμασε το M-< τώρα για να κινηθείς στην αρχή αυτής της εκμάθησης. + Κατόπιν χρησιμοποίησε το C-v επανειλημμένα για να επιστρέψεις εδώ. + +>> Τώρα δοκίμασε το M-> για να κινηθείς στο τέλος αυτής της εκμάθησης. + Κατόπιν χρησιμοποίησε το M-v επανειλημμένα για να επιστρέψεις εδώ. + +Μπορείς επίσης να χρησιμοποιήσεις τα πλήκτρα με τα βέλη, εάν ο +ακροδέκτης σου τα υποστηρίζει. Προτείνουμε να μάθεις τα C-b, C-f, C-n +και C-p για τρεις λόγους. Πρώτον, δουλεύουν σε όλων των ειδών τους +ακροδέκτες. Δεύτερον, όταν αποκτήσεις εμπειρία στην χρήση του Emacs, +θα διαπιστώσεις πως αυτοί οι χαρακτήρες του Control είναι πιο γρήγοροι +στην χρήση παρά τα βέλη (διότι δεν απομακρύνεις τα χέρια σου από την +θέση πληκτρολόγησης δια αφής). Τρίτον, εφόσον διαμορφώσεις την +συνήθεια να χρησιμοποιείς τις εντολές με τους Control χαρακτήρες, +μπορείς πιο εύκολα να μάθεις πιο προηγμένες εντολές κίνησης. + +Οι πλείστες εντολές του Emacs δέχονται αριθμητική παράμετρο: για τις +περισσότερες εντολές αυτή λειτουργεί ως μετρητής επανάληψης. Ο τρόπος +που δίνεις σε μια εντολή αριθμητική παράμετρο γίνεται πληκτρολογώντας +το C-u και μετά τα ψηφία προτού πληκτρολογήσεις την εντολή. Εάν έχεις +το πλήκτρο META (ή ALT), υπάρχει άλλος εναλλακτικός τρόπος εισαγωγής +αριθμητικής παραμέτρου: πληκτρολόγησε τα ψηφία κρατώντας πατημένο το +πλήκτρο META. Συνιστούμε να μάθεις την μέθοδο του C-u γιατί ισχύει σε +όλους τους ακροδέκτες. Η αριθμητική παράμετρος ονομάζεται επίσης +«προθεματική παράμετρος», καθώς πληκτρολογείς την παράμετρο πριν την +εντολή στην οποία δίνεται. + +Για παράδειγμα, C-u 8 C-f κινείται εμπρός οκτώ χαρακτήρες. + +>> Δοκίμασε να χρησιμοποιήσεις το C-n ή C-p με αριθμητική παράμετρο + για να κινήσεις τον δείκτη σε μια γραμμή κοντά σε αυτή με μόνο μία + εντολή. + +Οι πλείστες εντολές χρησιμοποιούν την αριθμητική παράμετρο ως μετρητή +επανάληψης, αλλά μερικές εντολές την χρησιμοποιούν με διαφορετικό +τρόπο. Αρκετές εντολές (αλλά καμία από αυτές που έμαθες έως τώρα) την +χρησιμοποιούν ως ένδειξη--η παρουσία προθεματικής παραμέτρου, +ανεξαρτήτως της αξίας της, κάνει την εντολή να εκτελέσει κάτι +διαφορετικό. + +Τα C-v και M-v συνιστούν άλλο ένα είδος εξαίρεσης. Όταν τους δοθεί +παράμετρος, κυλούν το κείμενο πάνω ή κάτω κατά τόσες γραμμές, αντί για +πλήρη οθόνη. Για παράδειγμα, C-u 8 C-v κυλάει πάνω κατά 8 γραμμές. + +>> Δοκίμασε να πληκτρολογήσεις C-u 8 C-v τώρα. + +Αυτό πρέπει να κύλησε το κείμενο πάνω κατά 8 γραμμές. Αν θέλεις να το +φέρεις κάτω πάλι δοκίμασε την ίδια αριθμητική παράμετρο με το M-v. + +Εάν χρησιμοποιείς γραφική προβολή, όπως το X ή MS-Windows, θα πρέπει +να υπάρχει μια ψηλή, ορθογώνια επιφάνεια σε πλευρά του παραθύρου του +Emacs που είναι γνωστή και ως η μπάρα κύλισης (scroll bar). Μπορείς +να κυλήσεις το κείμενο πατώντας με το ποντίκι πάνω στην μπάρα κύλισης. + +Αν το ποντίκι σου έχει ροδέλα, μπορείς να την χρησιμοποιήσεις για +κύλιση. + + +* ΑΝ ΤΟ EMACS ΠΑΨΕΙ ΝΑ ΑΝΤΑΠΟΚΡΙΝΕΤΑΙ +------------------------------------- + +Αν το Emacs πάψει να ανταποκρίνεται στις εντολές σου, μπορείς να το +σταματήσεις με ασφάλεια πληκτρολογώντας C-g. Μπορείς να +χρησιμοποιήσεις το C-g για να σταματήσεις μια εντολή που παίρνει πολύ +χρόνο να εκτελεστεί. + +Μπορείς επίσης να χρησιμοποιήσεις το C-g για να καταργήσεις μια +αριθμητική παράμετρο ή την αρχή μιας εντολής που δεν θέλεις να +ολοκληρώσεις. + +>> Πληκτρολόγησε C-u 100 για να φτιάξεις μια αριθμητική παράμετρο του + 100, μετά πληκτρολόγησε C-g. Τώρα πληκτρολόγησε C-f. Θα πρέπει να + κινηθεί μόνο ένα χαρακτήρα, διότι ακύρωσες την παράμετρο με το C-g. + +Σε περίπτωση που έχεις πληκτρολογήσει το κατά λάθος, μπορείς να +το ξεφορτωθείς με το C-g. + + +* ΑΠΕΝΕΡΓΟΠΟΙΗΜΕΝΕΣ ΕΝΤΟΛΕΣ +--------------------------- + +Κάποιες εντολές του Emacs είναι «απενεργοποιημένες» ώστε νέοι χρήστες +να μην τις χρησιμοποιήσουν κατά λάθος. + +Αν πληκτρολογήσεις μία από αυτές τις απενεργοποιημένες εντολές, το +Emacs παρουσιάζει μήνυμα που αναφέρει ποια είναι η εντολή και σου ζητά +αν θέλεις να την εκτελέσεις. + +Εάν πράγματι θες να δοκιμάσεις την εντολή, πληκτρολόγησε (το +κενό) ως απάντηση στην ερώτηση. Κανονικά, αν δεν θέλεις να εκτελέσεις +την απενεργοποιημένη εντολή απαντάς με το «n». + +>> Πληκτρολόγησε C-x C-l (που είναι απενεργοποιημένη εντολή) και μετά + πληκτρολόγησε n ως απάντηση. + + +* ΠΑΡΑΘΥΡΑ +---------- + +Το Emacs μπορεί να έχει πολλά «παράθυρα», με το καθένα να δείχνει το +δικό του κείμενο. Θα εξηγήσουμε παρακάτω πως να χρησιμοποιείς πολλά +παράθυρα. Για την ώρα θέλουμε να εξηγήσουμε πως θα ξεφορτωθείς +πλεονάζοντα παράθυρα για να επιστρέψεις στην βασική επεξεργασία εντός +ενός παραθύρου. Είναι απλό: + + C-x 1 Ένα παράθυρο (δηλαδή εξαφάνισε όλα τα άλλα παράθυρα) + +Αυτό πρόκειται για το CONTROL-x που ακολουθείται από το ψηφίο 1. Το +C-x 1 μεγιστοποιεί το παράθυρο που περιέχει τον δείκτη. Διαγράφει τα +άλλα παράθυρα. + +>> Φέρε τον δείκτη σε αυτή την γραμμή και πληκτρολόγησε C-u 0 C-l. +>> Πληκτρολόγησε C-h k C-f. + Δες πως το παράθυρο συρρικνώνεται, καθώς ένα νέο εμφανίζεται για να + παρουσιάσει την καταγραφή της εντολής C-f. + +>> Πληκτρολόγησε C-x 1 και δες πως το παράθυρο της καταγραφής + εξαφανίζεται. + +Υπάρχει σειρά εντολών που ξεκινούν με το CONTROL-x· πολλές εξ αυτών +έχουν να κάνουν με παράθυρα (windows), αρχεία (files), αποσβεστήρες +(buffers), και τα σχετικά. Αυτές οι εντολές είναι δύο, τρία ή τέσσερα +γράμματα μάκρος. + + +* ΕΙΣΑΓΟΝΤΑΣ ΚΑΙ ΔΙΑΓΡΑΦΟΝΤΑΣ +----------------------------- + +Αν θέλεις να εισάγεις κείμενο, απλά πληκτρολόγησε το. Κοινοί +χαρακτήρες, όπως το Α, 7, *, κτλ. εισάγονται καθώς τους πληκτρολογείς. +Για να εισάγεις τον χαρακτήρα νέας γραμμής, πληκτρολόγησε +(αυτό είναι το πλήκτρο που μερικές φορές αναγράφεται ως «Enter»). + +Για να διαγράψεις τον χαρακτήρα ακριβώς πριν από το τωρινό σημείο του +δείκτη, πληκτρολόγησε . Αυτό είναι το πλήκτρο που συνήθως +αναγράφεται στο πληκτρολόγιο ως «Backspace»--το ίδιο θα +χρησιμοποιούσες κανονικά κι εκτός Emacs για να διαγράψεις τον +τελευταίο χαρακτήρα που εισήγαγες. + +Συνήθως υπάρχει άλλο ένα πλήκτρο που αναγράφεται ως , αλλά +αυτό είναι διαφορετικό από αυτό που προαναφέραμε και που εννοούμε με +το του Emacs. + +>> Κάνε αυτό τώρα--πληκτρολόγησε μερικούς χαρακτήρες, μετά διάγραψε + τους πατώντας το μερικές φορές. Μην ανησυχείς για την + τροποποίηση αυτού του αρχείου: δεν τροποποιείς το κύριο κείμενο + εκμάθησης. Αυτό είναι το προσωπικό σου αντίγραφο. + +Όταν η γραμμή του κειμένου γίνεται πολύ μεγάλη για μια γραμμή της +οθόνης, η γραμμή του κειμένου «συνεχίζεται» σε δεύτερη γραμμή οθόνης. +Εάν χρησιμοποιείς γραφική προβολή, καμπυλωτά βελάκια θα εμφανιστούν +στα στενά πλαίσια που βρίσκονται στα άκρα της επιφάνειας του κειμένου +(οι «παρυφές» αριστερά και δεξιά), για να επισημάνουν που συνεχίζεται +η γραμμή. Εάν χρησιμοποιείται προβολή κειμένου, η συνεχιζόμενη γραμμή +παρουσιάζεται με την αντίστροφη κάθετο ('\') στην δεξιότερη στήλη της +οθόνης. + +>> Εισήγαγε κείμενο μέχρις ότου φτάσεις στο δεξί περιθώριο και + συνέχισε να προσθέτεις. Θα δεις να εμφανίζεται η γραμμή συνέχειας. + +>> Πάτα επανειλημμένα για να διαγράψεις το κείμενο μέχρι που η + γραμμή να χωράει ξανά στην οθόνη. Η γραμμή συνέχειας θα χαθεί. + +Μπορείς να διαγράψεις τον χαρακτήρα νέας γραμμής όπως κάθε άλλο +χαρακτήρα. Διαγράφοντας τον χαρακτήρα νέας γραμμής μεταξύ δύο γραμμών +έχει σαν αποτέλεσμα την συνένωση τους σε μία γραμμή. Εάν σαν +αποτέλεσμα η γραμμή είναι πολύ μεγάλη, θα παρουσιαστεί με την γραμμή +συνέχειας. + +>> Μετακίνησε τον δείκτη στην αρχή της γραμμής και πληκτρολόγησε + . Αυτό θα συνενώσει την γραμμή με την από πάνω της. + +>> Πληκτρολόγησε για να επανεισάγεις τον χαρακτήρα νέας + γραμμής που μόλις διέγραψες. + +Το πλήκτρο είναι ειδικό, καθώς πληκτρολογώντας το μπορεί να +κάνει περισσότερα πράγματα πέραν της εισαγωγής του χαρακτήρα νέας +γραμμής. Ανάλογα με το περιβάλλων κείμενο, μπορεί να προσθέσει κενό +μετά τον χαρακτήρα νέας γραμμής, ώστε όταν αρχίσεις να γράφεις στην +νέα γραμμή, το κείμενο να στοιχίζεται με την προηγούμενη γραμμή. +Ονομάζουμε αυτή την συμπεριφορά (όπου το πάτημα ενός πλήκτρου κάνει +κάτι παραπάνω από την εισαγωγή του σχετικού χαρακτήρα) «ηλεκτρική». + +>> Ιδού ένα παράδειγμα της ηλεκτρικότητας του . + Πληκτρολόγησε στο τέλος αυτής της γραμμής. + +Κανονικά θα δεις πως μετά την εισαγωγή του χαρακτήρα νέας γραμμής, το +Emacs εισάγει κενά ώστε ο δείκτης να βρίσκεται ακριβώς κάτω από το +«Π» του «Πληκτρολόγησε». + +Θυμήσου πως οι πλείστες εντολές του Emacs δέχονται μετρητή επανάληψης· +αυτό περιλαμβάνει την εισαγωγή κειμένου. Επαναλαμβάνοντας ένα +χαρακτήρα κειμένου τον εισάγει πολλές φορές. + +>> Δοκίμασε το τώρα -- πληκτρολόγησε C-u 8 * για να εισάγεις ********. + +Έχεις ήδη μάθει τους πιο βασικούς τρόπους για την πληκτρολόγηση +κειμένου στο Emacs και την διόρθωση των λαθών. Μπορείς επίσης να +διαγράψεις λέξεις και γραμμές. Ιδού η σύνοψη των πράξεων διαγραφής: + + Διάγραψε τον χαρακτήρα ακριβώς πριν τον δείκτη + C-d Διάγραψε τον χαρακτήρα ακριβώς μετά τον δείκτη + + M- Εξαφάνισε την λέξη ακριβώς πριν τον δείκτη + M-d Εξαφάνισε την λέξη μετά τον δείκτη + + C-k Εξαφάνισε από το σημείο του δείκτη ως το τέλος της γραμμής + M-k Εξαφάνισε ως το τέλος της παρούσας πρότασης + +Πρόσεξε πως το και C-d σε σύγκριση με M- και M-d +προεκτείνουν την παράλληλο που άρχισε με το C-f και M-f (κατ'ακρίβεια, +το δεν είναι χαρακτήρας control, αλλά ας μην ανησυχούμε για +αυτό). Τα C-k και M-k είναι κατά τρόπο όπως το C-e και M-e καθώς οι +γραμμές ταιριάζουν με τις προτάσεις. + +Μπορείς επίσης να εξαφανίσεις ένα μέρος κειμένου με ενιαίο τρόπο. +Κινήσου σε μία άκρη του και πληκτρολόγησε C-. ( είναι το +πλήκτρο του κενού.) Κατόπιν, μετακίνησε τον δείκτη στην άλλη άκρη του +κειμένου που θέλεις να εξαφανίσεις. Καθώς το κάνεις αυτό, το Emacs +επισημαίνει το κείμενο μεταξύ των δύο άκρων του δείκτη και του σημείου +όπου πληκτρολόγησες C-. Τέλος, πληκτρολόγησε C-w. Αυτό +εξαφανίζει το κείμενο μεταξύ των δύο σημείων. + +>> Μετακίνησε τον δείκτη στο γράμμα Μ στην αρχή της προηγούμενης + παραγράφου. +>> Πληκτρολόγησε C-. Το Emacs θα σου γράψει μήνυμα στο κάτω + μέρος της οθόνης πως τέθηκε σημάδι («Mark set»). +>> Μετακίνησε τον δείκτη στο κ της λέξης «άκρη» στην δεύτερη γραμμή + της παραγράφου. +>> Πληκτρολόγησε C-w. Αυτό θα εξαφανίσει το κείμενο που άρχιζε με Μ + και τελειώνει ακριβώς πριν το κ. + +Η διαφορά μεταξύ της «εξαφάνισης» και της «διαγραφής» είναι πως το +«εξαφανισμένο» κείμενο μπορεί να επανεισαχθεί (σε οποιαδήποτε θέση), +ενώ τα «διαγραμμένα» πράγματα δεν μπορούν να επανεισαχθούν κατά αυτόν +τον τρόπο (μπορείς, ωστόσο, να αναιρέσεις την διαγραφή--δες παρακάτω). +Επανεισαγωγή εξαφανισμένου κειμένου ονομάζεται «τράβηγμα» («yanking»). +(Φαντάσου πως τραβάς κάτι πίσω το οποίο είχε αφαιρεθεί.) Γενικά, οι +εντολές που αφαιρούν πολύ κείμενο το εξαφανίζουν, ενώ οι εντολές που +αφαιρούν απλά ένα χαρακτήρα, ή μόνο κενές γραμμές ή κενά, κάνουν +διαγραφή (οπότε δεν μπορείς να τα τραβήξεις πίσω). και C-d +κάνουν διαγραφή στην απλή περίπτωση, χωρίς παράμετρο. Αν τους δοθεί +παράμετρος, τότε κάνουν εξαφάνιση. + +>> Μετακίνησε τον δείκτη στην αρχή μιας γραμμής που δεν είναι κενή. + Κατόπιν πληκτρολόγησε C-k για να εξαφανίσεις το κείμενο ως το τέλος + της γραμμής. +>> Πληκτρολόγησε C-k δεύτερη φορά. Θα δεις πως εξαφανίζει τον + χαρακτήρα νέας γραμμής που ακολουθεί εκείνη την γραμμή. + +Σημείωσε πως ένα C-k εξαφανίζει το περιεχόμενο της γραμμής, ενώ +δεύτερο C-k εξαφανίζει την ίδια την γραμμή και κάνει όλες τις +ακόλουθες γραμμές να μετατοπιστούν προς τα πάνω. Το C-k ερμηνεύει την +αριθμητική παράμετρο με ειδικό τρόπο: εξαφανίζει τις γραμμές ΚΑΙ το +περιεχόμενο τους. Αυτό δεν πρόκειται για απλή επανάληψη. C-u 2 C-k +εξαφανίζει δύο γραμμές και τους αντίστοιχους χαρακτήρες νέας γραμμής· +ενώ πληκτρολογώντας το C-k δύο φορές δεν θα το έκανε αυτό. + +Μπορείς να τραβήξεις εξαφανισμένο κείμενο στο ίδιο σημείο από όπου +εξαφανίστηκε, ή σε κάποιο άλλο σημείο που επεξεργάζεσαι, ή ακόμα σε +άλλο αρχείο. Μπορείς να τραβήξεις το ίδιο κείμενο πολλές φορές· αυτό +δημιουργεί πολλαπλά αντίγραφα του. Άλλοι κειμενογράφοι ονομάζουν την +εξαφάνιση και το τράβηγμα «αποκοπή» και «επικόλληση» (δες το γλωσσάριο +στο εγχειρίδιο του Emacs). + +Η εντολή για τράβηγμα είναι C-y. Εισάγει το τελευταίο εξαφανισμένο +κείμενο στην τρέχουσα θέση του δείκτη. + +>> Δοκίμασε το· πληκτρολόγησε C-y για τα τραβήξεις το κείμενο πίσω. + +Εάν κάνεις πολλά C-k στην σειρά, όλο το εξαφανισμένο κείμενο +αποθηκεύεται μαζί, ώστε ένα C-y τραβάει όλες τις γραμμές συλλήβδην. + +>> Κάνε το τώρα· πληκτρολόγησε C-k αρκετές φορές. + +Τώρα ανάκτησε το εξαφανισμένο κείμενο: + +>> Πληκτρολόγησε C-y. Κατόπιν μετακίνησε τον δείκτη κάτω μερικές + γραμμές και πληκτρολόγησε C-y ξανά. Τώρα βλέπεις πως να + αντιγράψεις ορισμένο κείμενο. + +Τι κάνει εάν έχεις κείμενο που θέλεις να τραβήξεις πίσω και μετά να +εξαφανίσεις κάτι άλλο; Το C-y θα τραβήξει την πιο πρόσφατη εξαφάνιση. +Αλλά η προηγούμενη της δεν έχει χαθεί. Μπορείς να επιστρέψεις σε αυτή +χρησιμοποιώντας την εντολή M-y. Αφού έχεις κάνει C-y για να πάρεις +την πιο πρόσφατη εξαφάνιση, πληκτρολογώντας το M-y αντικαθιστά το +τραβηγμένο κείμενο με το λιγότερο πρόσφατο εξαφανισμένο κείμενο. +Πληκτρολογώντας M-y ξανά και ξανά επαναφέρει ολοένα και παλαιότερες +εξαφανίσεις. Όταν βρεις το κείμενο που ψάχνεις, δεν χρειάζεται να +κάνεις κάτι άλλο για να το κρατήσεις. Απλά συνέχισε την επεξεργασία, +αφήνοντας το τραβηγμένο κείμενο εκεί που είναι. + +Εάν χρησιμοποιήσεις το M-y αρκετές φορές, θα επιστρέψεις στο αρχικό +σημείο (την πιο πρόσφατη εξαφάνιση). + +>> Εξαφάνισε μια γραμμή, κινήσου κάπου αλλού, εξαφάνισε άλλη γραμμή. + Μετά πάτα C-y για να επαναφέρεις την δεύτερη εξαφανισμένη γραμμή. + Μετά κάνε M-y κι αυτή θα αντικατασταθεί με την πρώτη εξαφανισμένη + γραμμή. Κάνε κι άλλα M-y να δεις τι θα σου βγάλει. Συνέχισε ώσπου + να σου δώσει πάλι την δεύτερη εξαφανισμένη γραμμή. Αν θέλεις + μπορείς να περάσεις στο M-y θετικές ή αρνητικές παραμέτρους. + + +* ΑΝΑΙΡΕΣΗ +---------- + +Εάν κάνεις αλλαγή στο κείμενο κι ύστερα κρίνεις πως ήταν λάθος, +μπορείς να την αναιρέσεις με την εντολή αναίρεσης C-/. + +Κανονικά, το C-/ αναιρεί τις αλλαγές που επέφερε μία εντολή. Αν +επαναλάβεις το C-/ πολλές φορές στη σειρά, κάθε επανάληψη αναιρεί +ακόμα μία εντολή. + +Ωστόσο υπάρχουν δύο εξαιρέσεις: εντολές που δεν τροποποιούν κείμενο +δεν μετρούν (όπως εντολές που κινούν τον δείκτη ή κυλούν το κείμενο) +και χαρακτήρες που αυτό-εισάγονται συνήθως κρίνονται ως ομάδες έως 20 +μέλη. (Αυτό είναι για να περιορίσει τον αριθμό των C-/ που +απαιτούνται για την αναίρεση εισαγωγής κειμένου.) + +>> Εξαφάνισε αυτή την γραμμή με C-k και πληκτρολόγησε C-/ ώστε να + επανεμφανιστεί. + +Το C-_ είναι εναλλακτική εντολή αναίρεσης που λειτουργεί το ίδιο με το +C-/. Σε ορισμένους ακροδέκτες κειμένου, ενδέχεται να μην χρειάζεται +το shift για να εισάγεις το C-_. Σε ορισμένους ακροδέκτες κειμένου, +το C-/ στέλνει το σήμα του C-_ στο Emacs. Εναλλακτικά, το C-x u +λειτουργεί ακριβώς όπως το C-/, αλλά είναι λίγο πιο δύσκολο να το +πληκτρολογήσεις. + +Η αριθμητική παράμετρος στα C-/, C-_, C-x u δρα ως μετρητής +επανάληψης. + +Μπορείς να αναιρέσεις την διαγραφή κειμένου κατά τον ίδιο τρόπο που +αναιρείς την εξαφάνιση κειμένου. Ο διαχωρισμός μεταξύ εξαφάνισης και +διαγραφής έχει σημασία μόνο όταν θες να τραβήξεις κάτι πίσω με το C-y: +δεν έχει καμιά διαφορά για τους σκοπούς της αναίρεσης. + + +* ΑΡΧΕΙΑ +-------- + +Για να καταστήσεις μόνιμο το κείμενο που επεξεργάζεσαι, πρέπει να το +βάλεις σε αρχείο. Αλλιώς θα χαθεί όταν κλείσεις το Emacs. Για να +βάλεις κείμενο σε αρχείο, πρέπει να το «βρεις» πριν εισάγεις το +κείμενο. (Η πράξη αυτή ονομάζεται επίσης ως «επίσκεψη» στην τοποθεσία +του αρχείου.) + +Εξεύρεση του αρχείο σημαίνει πως βλέπεις το περιεχόμενο του εντός του +Emacs. Κατά πολλούς τρόπους, είναι σαν να επεξεργάζεσαι το αρχείο +απευθείας. Ωστόσο, οι αλλαγές που κάνεις καθίστανται μόνιμες μόνο +αφού «αποθηκεύσεις» το αρχείο. Αυτό γίνεται ώστε να μην μένουν +μισοτελειωμένα αρχεία στο σύστημα ενάντια στην θέληση σου. Ακόμα κι +αν αποθηκεύσεις τις αλλαγές, το Emacs διατηρεί αντίγραφο του γνησίου +αρχείου υπό ελαφρώς τροποποιημένο όνομα, ώστε να μπορείς να το +επαναφέρεις σε περίπτωση που συνέβη κάποιο λάθος. + +Αν κοιτάξεις προς το κάτω μέρος της οθόνης θα δεις μια γραμμή που +αρχίζει με παύλες και αναφέρει « -:--- TUTORIAL.el_GR» ή κάπως έτσι. +Αυτό το μέρος της οθόνης συνήθως δείχνει το όνομα του αρχείου που +επισκέπτεσαι. Τώρα επισκέπτεσαι το προσωπικό σου αντίγραφο του +κειμένου εκμάθησης του Emacs, που ονομάζεται «TUTORIAL.el_GR». Όταν +βρίσκεις ένα αρχείο με το Emacs, το όνομα του θα εμφανιστεί σε εκείνο +ακριβώς το σημείο. + +Μια ειδική πτυχή της εντολής για εξεύρεση αρχείου είναι πως πρέπει να +προσδιορίσεις ποιο αρχείο θέλεις. Λέμε πως η εντολή «διαβάζει την +παράμετρο» (στην προκειμένη περίπτωση αυτή είναι το όνομα του +αρχείου). Αφού πληκτρολογήσεις την εντολή + + C-x C-f Βρες ένα αρχείο + +το Emacs θα σου ζητήσει να πληκτρολογήσεις το όνομα του. Το όνομα +του αρχείου που εισάγεις εμφανίζεται στο κάτω μέρος της οθόνης. Η +τελευταία γραμμή ονομάζεται μικροαποσβεστήρας (minibuffer) όταν +χρησιμοποιείται για τέτοιους σκοπούς εισαγωγής εντολής. Μπορείς να +χρησιμοποιήσεις τις κοινές εντολές του Emacs για επεξεργασία κειμένου +καθώς γράφεις το όνομα του αρχείου. + +Ενόσω δακτυλογραφείς το όνομα του αρχείο (ή κάθε άλλο κείμενο στον +μικροαποσβεστήρα), μπορείς να ακυρώσεις την εντολή με το C-g. + +>> Πληκτρολόγησε C-x C-f και μετά C-g. Αυτό ακυρώνει τον + μικροαποσβεστήρα και την εντολή C-x C-f που τον χρησιμοποιούσε. + Συνεπώς δεν θα βρεις κανένα αρχείο. + +Όταν ολοκληρώσεις την εισαγωγή του ονόματος ενός αρχείου, πάτα + για να την επικυρώσεις. Ο μικροαποσβεστήρας εξαφανίζεται +καθώς το C-x C-f αναλαμβάνει δράση για να βρει το αρχείο που του +όρισες. + +Το περιεχόμενο του αρχείου τώρα εμφανίζεται στην οθόνη και μπορείς να +το επεξεργαστείς. Όταν θέλεις να μονιμοποιήσεις τις αλλαγές που +έκανες, χρησιμοποίησε την εντολή + + C-x C-s Αποθήκευσε το αρχείο + +Αυτή αντιγράφει το κείμενο που βρίσκεται στο Emacs στο εν λόγω αρχείο. +Την πρώτη φορά που το κάνεις αυτό, το Emacs μετονομάζει το γνήσιο ώστε +να μην χαθεί. Το νέο όνομα περιέχει το σύμβολο «~» ως κατάληξη του +αρχικού ονόματος. Όταν ολοκληρωθεί η αποθήκευση, το Emacs παρουσιάζει +το όνομα του αρχείου όπου γράφτηκαν οι αλλαγές. + +>> Πληκτρολόγησε C-x C-s TUTORIAL.el_GR . + Αυτό θα αποθηκεύσει αυτό το κείμενο σε αρχείο με το όνομα + TUTORIAL.el_GR και θα αναφέρει πως έγραψε σε αυτό στο κάτω μέρος + της οθόνης. + +Μπορείς να βρεις υφιστάμενο αρχείο είτε για να το δεις ή να το +επεξεργαστείς. Μπορείς επίσης να βρεις αρχείο το οποίο δεν +προϋπάρχει. Έτσι το Emacs θα δημιουργήσει το αρχείο: θα βρεις το νέο +αρχείο, το οποίο είναι κενό, και κατόπιν θα εισάγεις κείμενο σε αυτό. +Όταν επιχειρήσεις να το αποθηκεύσεις, το Emacs θα δημιουργήσει το +αρχείο αυτό με το περιεχόμενο που του έδωσες. Από εκεί και πέρα +θεώρησε πως επεξεργάζεσαι ένα υφιστάμενο αρχείο. + + +* ΑΠΟΣΒΕΣΤΗΡΕΣ +-------------- + +Εάν βρεις δεύτερο αρχείο με το C-x C-f, το πρώτο παραμένει εντός του +Emacs. Μπορείς να επανέλθεις σε αυτό αν το ξαναβρείς με το C-x C-f. +Έτσι δύναται να έχεις πολλά αρχεία ανοιχτά εντός του Emacs. + +Το Emacs αποθηκεύει το περιεχόμενο του κάθε αρχείου σε αντικείμενο το +οποίο ονομάζεται «αποσβεστήρας» (buffer). Η εξεύρεση αρχείου +δημιουργεί νέο αποσβεστήρα εντός του Emacs. Για να δεις την λίστα με +όλους τους υφιστάμενους αποσβεστήρες, πληκτρολόγησε + + C-x C-b Παράθεσε αποσβεστήρες + +>> Δοκίμασε το C-x C-b τώρα. + +Παρατήρησε πως κάθε αποσβεστήρας έχει όνομα ενώ δύναται να έχει επίσης +κι όνομα αρχείου του οποίο το περιεχόμενο κρατεί. ΟΤΙΔΗΠΟΤΕ βλέπεις +σε παράθυρο Emacs πάντα είναι μέρος ενός αποσβεστήρα. + +>> Πληκτρολόγησε C-x 1 για να εξαφανίσεις το παράθυρο που παραθέτει + τους αποσβεστήρες. + +Όταν έχεις πολλούς αποσβεστήρες, μόνο ένας είναι ο «τρέχον» σε κάθε +στιγμή. Πρόκειται για τον αποσβεστήρα που επεξεργάζεσαι. Εάν θες να +επεξεργαστείς κάποιον άλλο αποσβεστήρα, πρέπει να «μεταβείς» σε αυτόν. +Αν θα μεταβείς σε αποσβεστήρας που επισκέπτεται αρχείο, μπορείς να το +κάνεις με το C-x C-f προσδιορίζοντας το όνομα του αρχείου. Αλλά +υπάρχει ευκολότερος τρόπος: χρησιμοποίησε την εντολή C-x b. Σε αυτή +την εντολή, πρέπει να εισάγεις το όνομα του αποσβεστήρα. + +>> Δημιούργησε αρχείο ονόματι «foo»: γράψε C-x C-f foo . + Μετά πληκτρολόγησε C-x b TUTORIAL.el_GR για να επιστρέψεις + σε αυτό το κείμενο εκμάθησης του Emacs. + +Συνήθως, το όνομα του αποσβεστήρα αντιστοιχεί σε αυτό του αρχείου +(χωρίς το μέρος του αρχείου που αναφέρει τον κατάλογο/φάκελο στον +οποίο βρίσκεται). Ωστόσο αυτό δεν ισχύει πάντοτε. Η παράθεση +αποσβεστήρων που φτιάχνει το C-x C-b δείχνει τόσο το όνομα του +αποσβεστήρα όσο κι αυτό του αρχείου. + +Κάποιοι αποσβεστήρες δεν ανταποκρίνονται σε αρχεία. Ο αποσβεστήρας +ονόματι «*Buffer List*», που περιέχει τα στοιχεία του C-x C-b, δεν +έχει κάποιο υποκείμενο αρχείο. Ο αποσβεστήρας αυτού του +TUTORIAL.el_GR αρχικά δεν είχε κάποιο αρχείο, αλλά τώρα έχει, καθώς +στην προηγούμενη ενότητα χρησιμοποίησες το C-x C-s για να τον +αποθηκεύσεις σε αρχείο. + +Ο αποσβεστήρας με το όνομα «*Messages*» επίσης δεν έχει αρχείο. Αυτός +περιέχει όλα τα μηνύματα που εμφανίζονται στο κάτω μέρος της οθόνης +κατά την λειτουργία του Emacs. + +>> Πληκτρολόγησε C-x b *Messages* για να δεις τον αποσβεστήρα + με τα μηνύματα. Μετά πληκτρολόγησε C-x b TUTORIAL.el_GR + για να επανέλθεις εδώ. + +Εάν κάνεις αλλαγές στο κείμενο ενός αρχείου, μετά βρεις κάποιο άλλο +αρχείο, η πράξη αυτή δεν αποθηκεύει τις αλλαγές που έκανες στο πρώτο +αρχείο. Οι αλλαγές παραμένουν εντός του Emacs, στον αποσβεστήρα που +ανταποκρίνεται σε εκείνο το αρχείο. Η δημιουργία ή επεξεργασία του +δεύτερου αρχείου δεν επηρεάζει το πρώτο. Αυτό είναι πολύ χρήσιμο, +ωστόσο σημαίνει πως χρειάζεσαι έναν βολικό τρόπο να αποθηκεύεις +αλλαγές σε πολλούς αποσβεστήρες. Το να πρέπει να επιστρέψεις στο +πρώτο αρχείο απλά και μόνο για να το αποθηκεύσεις είναι ενοχλητικό. +Οπότε έχουμε + + C-x s Αποθήκευσε ορισμένους αποσβεστήρες στα αρχεία τους + +Το C-x s ρωτά για κάθε αποσβεστήρα που επισκέπτεται αρχείο και που +κρατά αλλαγές οι οποίες δεν έχουν αποθηκευτεί. Σε ρωτά για κάθε +αποσβεστήρα κατά πόσον να αποθηκευτούν οι αλλαγές του στο αρχείο. + +>> Εισήγαγε μια γραμμή κειμένου και πληκτρολόγησε C-x s. + Θα σε ρωτήσει κατά πόσον θες να αποθηκεύσεις τον αποσβεστήρα με + όνομα TUTORIAL.el_GR. Απάντα καταφατικά με το «y» (yes). + + +* ΕΠΕΚΤΕΙΝΟΝΤΑΣ ΤΟ ΣΥΝΟΛΟ ΕΝΤΟΛΩΝ +--------------------------------- + +Υπάρχουν πάρα πολλές εντολές του Emacs που δεν μπορούν να χωρέσουν σε +όλους τους control και meta χαρακτήρες. Το Emacs ξεπερνά αυτό το +εμπόδιο με την εντολή επέκτασης (eXtend). Αυτή έχει δύο μορφές: + + C-x Χαρακτήρος επέκταση. Ακολουθείται από τον χαρακτήρα. + M-x Ονόματος επέκταση. Ακολουθείται από όνομα. + +Αυτές είναι εντολές που είναι χρήσιμες εν γένει αλλά χρησιμοποιούνται +σχετικά λιγότερο από αυτές που έμαθες έως τώρα. Έχεις ήδη δει εντολές +επέκτασης, όπως το C-x C-f και το C-x C-s. Άλλο παράδειγμα είναι η +εντολή που κλείνει το Emacs--αυτή είναι C-x C-c. (Μην ανησυχείς για +απώλεια αλλαγών που έκανες· το C-x C-c ρωτά να αποθηκεύσει αλλαγές σε +κάθε αρχείο πριν τερματίσει το Emacs.) + +Εάν χρησιμοποιείς γραφική προβολή, δεν χρειάζεσαι κάποια ειδική εντολή +για να μεταβείς από το Emacs σε κάποια άλλη εφαρμογή. Μπορείς να το +κάνεις με το ποντίκι ή τις εντολές του διαχειριστή παραθύρων. Αν όμως +χρησιμοποιείς ακροδέκτη κειμένου ο οποίος προβάλει μόνο μία εφαρμογή, +τότε πρέπει να «αναστείλεις» το Emacs για να επιλέξεις οποιαδήποτε +άλλη εφαρμογή. + +C-z είναι η εντολή της *προσωρινής* εξόδου από το Emacs--μπορείς να +επιστρέψεις στην ίδια συνεδρία υστερότερα. Όταν το Emacs λειτουργεί +εντός ακροδέκτη κειμένου, το C-z «αναστέλλει» το Emacs· δηλαδή +επιστρέφει στο περίβλημα (shell) χωρίς να καταστρέψει την εργασία του +Emacs. Στα πλείστα περιβλήματα, μπορείς να επαναφέρεις το Emacs με +την εντολή «fg» ή την «%emacs». + +Χρησιμοποιείς το C-x C-c όταν θες να αποσυνδεθείς πλήρως. Είναι η +σωστή πράξη για έξοδο από το Emacs, παράδειγμα για περιπτώσεις ταχείας +επεξεργασίας κειμένου όπως στην διαχείριση ηλεκτρονικού ταχυδρομείου. + +Υπάρχουν πολλές εντολές του τύπου C-x. Παραθέτουμε αυτές που έμαθες: + + C-x C-f Εξεύρεση αρχείου + C-x C-s Αποθήκευση αποσβεστήρα σε αρχείο + C-x s Αποθήκευση μερικών αποσβεστήρων στα αρχεία τους + C-x C-b Παράθεση αποσβεστήρων + C-x b Μετάβαση σε αποσβεστήρα + C-x C-c Έξοδος από το Emacs + C-x 1 Διαγραφή όλων πλην ενός παραθύρου + C-x u Αναίρεση + +Επώνυμες εκτεταμένες εντολές είναι αυτές που χρησιμοποιούνται με +λιγότερη συχνότητα, ή εντολές που χρησιμοποιούνται μόνο σε +συγκεκριμένες λειτουργίες. Ως παράδειγμα έχουμε την εντολή +replace-string, η οποία αντικαθιστά μια σειρά (αλληλουχία) χαρακτήρων +με μια άλλη εντός του αποσβεστήρα. Όταν πληκτρολογείς M-x, το Emacs +σε προτρέπει στο κάτω μέρος της οθόνης για το όνομα της εντολής· +«replace-string» σε αυτή την περίπτωση. Απλά να πληκτρολογήσεις το +«repl s» και το Emacs θα ολοκληρώσει το όνομα. ( αναφέρεται +στο πλήκτρο Tab, που συνήθως βρίσκεται πάνω από το Caps Lock ή το +Shift στην αριστερή πλευρά του πληκτρολογίου.) Κατάθεσε το όνομα της +εντολής με το . + +Η εντολή replace-string απαιτεί δύο παραμέτρους--την σειρά χαρακτήρων +προς αντικατάσταση και αυτή που θα την αντικαταστήσει. Κάθε +παράμετρος τελειώνει με το . + +>> Μετακίνησε τον δείκτη στην κενή γραμμή δύο γραμμές κάτω από αυτήν. + Πληκτρολόγησε M-x repl sαλλάξειμετατραπεί + + Πρόσεξε πως αυτή η γραμμή έχει αλλάξει: αντικατέστησες την λέξη + «αλλάξει» με την «μετατραπεί» όπου αυτή υπήρχε μετά την αρχική θέση + του δείκτη. + + +* ΑΥΤΟΜΑΤΗ ΑΠΟΘΗΚΕΥΣΗ +--------------------- + +Όταν έχεις κάνει αλλαγές σε ένα αρχείο, αλλά δεν τις έχεις αποθηκεύσει +ακόμα, ενδέχεται να χαθούν αν ο υπολογιστής κλείσει. Για να σε +προστατέψει από αυτό το ενδεχόμενο, το Emacs κατά διαστήματα γράφει σε +ένα αρχείο «αυτόματης αποθήκευσης» κάθε αρχείο που επεξεργάζεσαι. Το +όνομα αυτού του αρχείου έχει ένα # στην αρχή κι ένα στο τέλος· για +παράδειγμα, αν το αρχείο σου ονομάζεται «hello.c», η αυτόματη +αποθήκευση γίνεται στο «#hello.c#». Όταν αποθηκεύσεις το αρχείο με +τον φυσιολογικό τρόπο, το Emacs διαγράφει το αρχείο αυτόματης +αποθήκευσης. + +Εάν ο υπολογιστής κλείσει αναπάντεχα μπορείς να ανακτήσεις αυτό που +επεξεργαζόσουν με το να βρεις το αρχείο (το κανονικό αρχείο, όχι αυτό +της αυτόματης αντιγραφής του) και να πληκτρολογήσεις M-x +recover-this-file . Όταν σου ζητηθεί επιβεβαίωση, +πληκτρολόγησε yes για την ανάκτηση των δεδομένων. + + +* ΤΟΠΟΣ ΑΝΤΗΧΗΣΗΣ +----------------- + +Αν το Emacs διακρίνει πως πληκτρολογείς τους χαρακτήρες μιας +μακροσκελούς εντολής με σχετικά αργό ρυθμό, θα σου τους δείξει στο +κάτω μέρος της οθόνης σε αυτό που ονομάζεται «τόπος αντήχησης». Ο +τόπος αντήχησης περιλαμβάνει την τελευταία γραμμή της οθόνης. + + +* ΓΡΑΜΜΗ ΚΑΤΑΣΤΑΣΗΣ +------------------- + +Η γραμμή ακριβώς πάνω από τον τόπο αντήχησης ονομάζεται «γραμμή +κατάστασης». Αυτή αναφέρει πληροφορίες όπως: + + -:**- TUTORIAL.el_GR 63% L800 (Fundamental) + +Αυτή η γραμμή έχει χρήσιμες πληροφορίες για την κατάσταση του Emacs +και του κειμένου που επεξεργάζεσαι. + +Ήδη γνωρίζεις τι σημαίνει το πεδίο ονόματος του αρχείου--αναφέρει το +αρχείο που έχεις επισκεφθεί. Το ΝΝ% δείχνει την τρέχουσα θέση σου +στον αποσβεστήρα του κειμένου: σημαίνει πως ΝΝ επί τις εκατό του +αποσβεστήρα βρίσκεται πέρα από το πάνω μέρος της οθόνης. Εάν το πάνω +μέρος περιέχει όλο το προηγούμενο κείμενο, τότε θα γράφει «Top» αντί +για «0%». Αν είναι στο κάτω μέρος του αποσβεστήρα, τότε θα αναγράφει +«Bot». Αν ο αποσβεστήρας είναι μικρός ώστε όλο το περιεχόμενο του να +χωράει στην οθόνη, τότε η γραμμή κατάστασης θα γράφει «All». + +Το L και τα ψηφία δείχνουν την θέση με άλλο τρόπο: τον αριθμό της +γραμμής όπου βρίσκεται το σημείο. + +Οι αστερίσκοι κοντά στην αρχή δείχνουν πως έχουν υπάρξει τροποποιήσεις +στο κείμενο. Μόλις επισκεφθείς ή αποθηκεύσεις ένα αρχείο, εκείνο το +τμήμα δεν δείχνει αστερίσκους παρά μόνο παύλες. + +Το τμήμα της γραμμής κατάστασης εντός παρενθέσεων αναφέρει τις +λειτουργίες επεξεργασίας που ισχύουν. Η βασική λειτουργία ονομάζεται +Fundamental κι είναι αυτή που χρησιμοποιείς τώρα. Πρόκειται για +παράδειγμα «αξιωματικής λειτουργίας» (major mode). + +Το Emacs έχει πολλές αξιωματικές λειτουργίες. Κάποιες αφορούν την +επεξεργασία κειμένου σε διάφορες γλώσσες προγραμματισμού ή για διάφορα +ήδη κειμένου, όπως Lisp mode, Text mode, κτλ. Μόνο μια αξιωματική +λειτουργία γίνεται να είναι σε ισχύ, και το όνομα της βρίσκεται στην +γραμμή κατάστασης όπου τώρα υπάρχει το «Fundamental». + +Κάθε αξιωματική λειτουργία κάνει κάποιες εντολές να συμπεριφέρονται με +διαφορετικό τρόπο. Για παράδειγμα, υπάρχουν εντολές για την +δημιουργία σχολίων σε ένα πρόγραμμα, και καθώς κάθε γλώσσα έχει τις +δικές τις ιδέες για το τι συνιστά σχόλιο, η εκάστοτε αξιωματική +λειτουργία εισάγει σχόλια ιδιοτρόπως. + +Κάθε αξιωματική λειτουργία φέρει το όνομα μιας εκτεταμένης εντολής, +που είναι ένας τρόπος να αλλάξεις σε αυτή. Για παράδειγμα, M-x +fundamental-mode είναι η εντολή που θέτει σε ισχύ το Fundamental mode. + +Αν θα επεξεργάζεσαι κείμενο σε ανθρώπινη γλώσσα, όπως αυτό το αρχείο, +μάλλον θες να χρησιμοποιήσεις το Text mode. + +>> Πληκτρολόγησε M-x text-mode . + +Μην ανησυχείς, καθώς καμία από τις εντολές που έχεις μάθει δεν αλλάζει +με ουσιαστικό τρόπο. Ωστόσο θα διαπιστώσεις πως M-f και M-b τώρα +θεωρούν τα εισαγωγικά ως μέρος της λέξης. Πριν, στο Fundamental mode, +M-f και M-b διάβαζαν τα εισαγωγικά ως διαχωριστικά λέξεων. + +Αξιωματικές λειτουργίες κάνουν τέτοιες εκλεπτυσμένες αλλαγές: οι +πλείστες εντολές «διεκπεραιώνουν το ίδιο έργο» σε κάθε αξιωματική +λειτουργία, αλλά ίσως το επιτυγχάνουν με ελαφρώς διαφορετικό τρόπο. + +Για να μάθεις περισσότερα σχετικά με την τρέχουσα αξιωματική +λειτουργία, πληκτρολόγησε C-h m. + +>> Μετακίνησε τον δείκτη στην γραμμή μετά από αυτήν. +>> Πληκτρολόγησε C-l C-l ώστε να έρθει αυτή η γραμμή στο πάνω μέρος + της οθόνης. +>> Πληκτρολόγησε C-h m για να διαβάσεις πως διαφέρει το Text mode από + το Fundamental mode. +>> Πληκτρολόγησε C-x 1 για να αφαιρέσεις την καταγραφή από την οθόνη. + +Οι αξιωματικές λειτουργίες ονομάζονται έτσι διότι υπάρχουν και οι +ελάσσονες λειτουργίες (minor modes). Ελάσσονες λειτουργίες δεν +υποκαθιστούν τις αξιωματικές λειτουργίες, παρά μόνο επί μέρους πτυχές +τους. Κάθε ελάσσων λειτουργία μπορεί να ενεργοποιηθεί ή +απενεργοποιηθεί αυτοτελώς, ανεξάρτητα από άλλες ελάσσονες λειτουργίες +ή οποιονδήποτε συνδυασμό τους. + +Μια ελάσσων λειτουργία που είναι πολύ χρήσιμη, ειδικά για την +επεξεργασία κειμένου ανθρώπινης γλώσσας, είναι η Auto Fill mode. Όταν +αυτή η λειτουργία ενεργοποιηθεί, το Emacs αυτόματα διαχωρίζει τις +γραμμές μεταξύ των λέξεων όταν αυτές γίνονται πολύ πλατιές. + +Το Auto Fill mode ενεργοποιείται με M-x auto-fill-mode . Όταν +η λειτουργία είναι σε ισχύ, μπορεί να απενεργοποιηθεί πάλι με M-x +auto-fill-mode . Αν είναι απενεργοποιημένη, τότε η εντολή +αυτή την ενεργοποιεί, και το αντίστροφο. Λέμε πως η εντολή +«εναλλάσσει την λειτουργία». + +>> Πληκτρολόγησε M-x auto-fill-mode τώρα. Κατόπιν + πληκτρολόγησε μια γραμμή με «ασδφ » πολλές φορές ως που να δεις ότι + διαιρείται σε δύο γραμμές. Πρέπει να έχει κενά μεταξύ των + χαρακτήρων, διότι μόνο με βάση αυτά λειτουργεί το Auto Fill (δεν + κόβει λέξεις). + +Το μήκος συνήθως ορίζεται στους 70 χαρακτήρες, αλλά μπορείς να το +αλλάξεις με την εντολή C-x f. Όρισε τον αριθμό που επιθυμείς ως +αριθμητική παράμετρο. + +>> Πληκτρολόγησε C-x f με παράμετρο το 20. (C-u 2 0 C-x f). Κατόπιν + πληκτρολόγησε τυχαίο κείμενο με κενά και πρόσεξε πως το Emacs + συμπληρώνει τις γραμμές έως τους 20 χαρακτήρες. Μετά θέσε πάλι το + μήκος τους 70 χαρακτήρες χρησιμοποιώντας C-x f με αριθμητική + παράμετρο. + +Αν κάνεις αλλαγές στην μέση της παραγράφου, το Auto Fill mode δεν +επανασυμπληρώνει για χάρη σου. +Για να επανασυμπληρώσεις μια παράγραφο χειροκίνητα, πληκτρολόγησε M-q +(META-q) με τον δείκτη εντός της παραγράφου εκείνης. + +>> Μετακίνησε τον δείκτη στην προηγούμενη παράγραφο και πληκτρολόγησε + M-q. + + +* ΑΝΑΖΗΤΗΣΗ +----------- + +Το Emacs μπορεί να αναζητήσει σειρές (σειρά (string) είναι αλληλουχία +χαρακτήρων) είτε προς τα εμπρός είτε ανάποδα. Αναζήτηση σειράς +συνιστά κίνηση του δείκτη· μετακινεί τον δείκτη όπου εμφανίζεται η +σειρά. + +Η εντολή αναζήτησης του Emacs είναι «τμηματική». Αυτό σημαίνει πως η +αναζήτηση γίνεται ενόσω δακτυλογραφείς τους χαρακτήρες της σειράς που +αναζητείς. + +Η εντολή προς εκκίνηση αναζήτησης είναι C-s για κίνηση προς τα εμπρός +και C-r και κίνηση όπισθεν. ΑΛΛΑ ΠΕΡΙΜΕΝΕ! Μην τις δοκιμάσεις ακόμα. + +Όταν πληκτρολογείς C-s θα δεις πως η σειρά «I-search» εμφανίζεται ως +προτροπή στον τόπο αντήχησης. Αυτό σου λέει πως το Emacs βρίσκεται σε +αυτό που ονομάζεται «τμηματική αναζήτηση» και περιμένει να +πληκτρολογήσεις αυτό το οποίο ψάχνεις. ολοκληρώνει την +αναζήτηση. + +>> Τώρα πληκτρολόγησε C-s για να αρχίσεις την αναζήτηση. ΑΡΓΑ, ένα + γράμμα τη φορά, γράψε «δείκτη», κάνοντας παύση αφού εισάγεις τον + κάθε χαρακτήρα για να δεις τι συμβαίνει με τον δείκτη. + Τώρα έχεις αναζητήσει για «δείκτη» μία φορά. +>> Πάτα πάλι C-s για να ψάξεις την επόμενη εμφάνιση του «δείκτη». +>> Τώρα πληκτρολόγησε τέσσερις φορές και δες πως κινείται ο + δείκτης. +>> Πληκτρολόγησε για να τερματίσεις την αναζήτηση. + +Είδες τι έγινε; Το Emacs, σε τμηματική αναζήτηση, προσπαθεί να +εντοπίσει την επόμενη εμφάνιση της σειράς χαρακτήρων που έγραψες. Για +να μεταφερθείς στην επόμενη εμφάνιση, πάτα C-s ξανά. Εάν δεν υπάρχει +άλλη, το Emacs θα σηματοδοτήσει «αποτυχία» (failing). Το C-g μπορεί +να τερματίσει την αναζήτηση. + +Κατά την διάρκεια μιας τμηματικής αναζήτησης εάν πατήσεις , η +αναζήτηση «υποχωρεί» σε πρότερο σημείο. Αν πατήσεις αμέσως +αφότου έχεις πληκτρολογήσει C-s για μετακίνηση στην επόμενη εμφάνιση +μιας σειράς χαρακτήρων, θα μεταβείς πίσω στην προηγούμενη εμφάνιση. +Εάν δεν υπάρχει προηγούμενη εμφάνιση, το διαγράφει τον τελευταίο +χαρακτήρα στην σειρά. Για παράδειγμα, φαντάσου πως έγραψες «δ» για να +βρεις την πρώτη εμφάνιση του. Τώρα αν προσθέσεις το «ε» θα πας στην +πρώτη εμφάνιση του «δε». Τώρα πάτα . Διαγράφει το «ε» από την +σειρά και μετακινεί τον δείκτη πίσω στην πρώτη εμφάνιση του «δ». + +Αν είσαι στο μέσον μιας αναζήτησης και πληκτρολογήσεις ένα χαρακτήρα +control ή meta (με κάποιες εξαιρέσεις--όπως C-s και C-r που έχουν +ειδική σημασία στην αναζήτηση), η αναζήτηση θα τερματιστεί. + +Το C-s ξεκινά αναζήτηση που ψάχνει για κάθε εμφάνιση της αναζητούμενης +σειράς ΑΠΟ την τρέχουσα θέση του δείκτη. Εάν θες να βρεις +προηγούμενες εμφανίσεις, χρησιμοποίησε το C-r. Όσα είπαμε για το C-s +ισχύουν για το C-r, με μόνη διαφορά την κατεύθυνση της αναζήτησης. + + +* ΠΟΛΛΑΠΛΑ ΠΑΡΑΘΥΡΑ +------------------- + +Ένα από τα καλά του Emacs είναι πως μπορείς να παρουσιάσεις πέραν του +ενός παραθύρου στην οθόνη. (Σημείωσε πως το Emacs χρησιμοποιεί τον +όρο «πλαίσιο» (frame)--επεξηγείται στην επόμενη ενότητα--για αυτό που +ορισμένες εφαρμογές αποκαλούν «παράθυρο» (window). Το εγχειρίδιο του +Emacs περιέχει γλωσσάριο με όλους τους όρους.) + +>> Φέρε τον δείκτη σε αυτή την γραμμή και πληκτρολόγησε C-l C-l. + +>> Τώρα πάτα C-x 2, που μοιράζει την οθόνη σε δύο παράθυρα. + Και τα δύο παράθυρα παρουσιάζουν αυτή την εκμάθηση. Ο δείκτης + επεξεργασίας παραμένει στο πάνω παράθυρο. + +>> Πληκτρολόγησε C-M-v για να κυλήσεις το κάτω παράθυρο. (Εάν δεν + έχεις META ή ALT πλήκτρο, τότε πληκτρολόγησε C-v.) + +>> Πληκτρολόγησε C-x o («o» είναι για το «άλλο» στην αγγλική (other)) + ώστε να επιλέξεις το έτερο παράθυρο. + +>> Χρησιμοποίησε C-v και M-v στο κάτω παράθυρο για να το κυλήσεις. + Συνέχισε να διαβάζεις αυτές τις οδηγίες στο πάνω παράθυρο. + +>> Πάτα C-x o και πάλι ώστε να φέρεις τον δείκτη πίσω στο πάνω + παράθυρο. Ο δείκτης στο πάνω παράθυρο είναι εκεί που ήταν και + πριν. + +Μπορείς να συνεχίσεις να χρησιμοποιείς C-x o για εναλλαγή μεταξύ των +παραθύρων. Το «επιλεγμένο παράθυρο», όπου γίνεται η επεξεργασία, +είναι αυτό που έχει ένα φανερό δείκτη που αναβοσβήνει καθώς γράφεις. +Τα άλλα παράθυρα έχουν τις δικές τους θέσεις για τον δείκτη· αν +χρησιμοποιείς γραφική προβολή του Emacs, αυτοί οι δείκτες +παρουσιάζονται ως άδεια κουτιά που δεν αναβοσβήνουν. + +Η εντολή C-M-v είναι πολύ χρήσιμη όταν επεξεργάζεται κείμενο σε ένα +παράθυρο και χρησιμοποιείς το έτερο παράθυρο για αναφορά. Χωρίς να +φύγεις από το επιλεγμένο παράθυρο, μπορείς να κυλήσεις το παράθυρο με +C-M-v. + +Το C-M-v αποτελεί παράδειγμα CONTROL-META χαρακτήρα. Αν έχεις META (ή +ALT) πλήκτρο, πληκτρολογείς C-M-v κρατώντας πατημένα τόσο το CONTROL +όσο και το META και πληκτρολογώντας v. Δεν έχει σημασία αν το CONTROL +ή το META «έρχεται πρώτο», καθώς αμφότερα μεταβάλουν τον χαρακτήρα που +εισάγεις. + +Αν δεν έχεις το πλήκτρο META (ή ALT), και χρησιμοποιείς το , τότε +η σειρά έχει σημασία: πρώτα πατάς κι αφήνεις το κι ακολουθείς με +CONTROL-v, διότι CONTROL--v δεν θα δουλέψει. Αυτό γιατί το +είναι χαρακτήρας από μόνο του, κι όχι πλήκτρο μετατροπής χαρακτήρων. + +>> Πληκτρολόγησε C-x 1 στο πάνω παράθυρο για να κλείσεις το κάτω + παράθυρο. + +(Άν πατούσες C-x 1 στο κάτω παράθυρο, θα έκλεινες το πάνω. Φαντάσου +πως αυτή η εντολή λέει «κράτα ένα παράθυρο--αυτό που έχω επιλεγμένο.») + +Δεν είναι απαραίτητο να παρουσιάζεις τον ίδιο αποσβεστήρα σε πολλά +παράθυρα. Αν χρησιμοποιήσεις το C-x C-f για να βρεις ένα αρχείο στο +ένα παράθυρο, το έτερο παράθυρο δεν αλλάζει. Μπορείς να βρεις ένα +αρχείο σε κάθε παράθυρο ανεξάρτητα από τα άλλα. + +Ιδού άλλος ένα τρόπος για να χρησιμοποιείς δύο παράθυρα που δείχνουν +διαφορετικά πράγματα: + +>> Πληκτρολόγησε C-x 4 C-f και δώσε όνομα αρχείου στην σχετική + προτροπή που εμφανίζεται στο κάτω μέρος της οθόνης. Επικύρωσε την + επιλογή σου με το . Δες πως το επιλεγμένο αρχείο + εμφανίζεται στο κάτω παράθυρο. Ο δείκτης πάει κι αυτός εκεί. + +>> Πληκτρολόγησε C-x o για να επιστρέψεις στο πάνω παράθυρο και μετά + C-x 1 για να κλείσεις το κάτω παράθυρο. + + +* ΠΟΛΛΑΠΛΑ ΠΛΑΙΣΙΑ +------------------ + +Το Emacs μπορεί επίσης να δημιουργήσει πολλά «πλαίσια». Πλαίσιο +ονομάζουμε αυτό που περιέχει ένα ή περισσότερα παράθυρα, μαζί με τα +μενού, μπάρες κύλισης, τόπο αντήχησης, κτλ. Σε γραφικές προβολές, +αυτό που το Emacs αποκαλεί «πλαίσιο» είναι το ίδιο που άλλες εφαρμογές +ονομάζουν «παράθυρο». Πολλά γραφικά πλαίσια μπορούν να εμφανίζονται +στην οθόνη ταυτόχρονα. Σε ακροδέκτη κειμένου, μόνο ένα πλαίσιο μπορεί +να παρουσιάζεται κάθε φορά. + +>> Πληκτρολόγησε C-x 5 2. + Δες ένα νέο πλαίσιο που εμφανίστηκε στην οθόνη. + +Μπορείς να κάνεις όσα έκανες στο αρχικό πλαίσιο και στο νέο πλαίσιο. +Δεν υπάρχει τίποτα το ειδικό για το ένα ή το άλλο. + +>> Πληκτρολόγησε C-x 5 0. + Αυτό αφαιρεί το επιλεγμένο πλαίσιο. + +Μπορείς πάντοτε να αφαιρέσεις ένα πλαίσιο με τον κοινό τρόπο που +προσφέρει το σύστημα γραφικών (συνήθως πατάς με το ποντίκι πάνω σε ένα +εικονίδιο «X» σε ένα από τα πάνω άκρα του πλαισίου). Αν αφαιρέσεις το +τελευταίο πλαίσιο της λειτουργίας του Emacs κατά αυτόν τον τρόπο, τότε +κλείνει το Emacs. + + +* ΕΠΙΠΕΔΑ ΑΝΑΔΡΟΜΙΚΗΣ ΕΠΕΞΕΡΓΑΣΙΑΣ +---------------------------------- + +Κάποιες φορές θα βρεθείς σε αυτό που ονομάζουμε «επίπεδο αναδρομικής +επεξεργασίας». Αυτό επισημαίνεται από αγκύλες στην γραμμή κατάστασης +που περιβάλλουν τις παρενθέσεις γύρω από την αξιωματική λειτουργία. +Για παράδειγμα, ίσως δεις [(Fundamental)] αντί για (Fundamental). + +Για να βγεις από επίπεδο αναδρομικής επεξεργασίας, πληκτρολόγησε + . Αυτή είναι η γενική εντολή εξόδου. Μπορείς να την +χρησιμοποιήσεις για να κλείσεις όλα τα έτερα παράθυρα και για να βγεις +από τον μικροαποσβεστήρα. + +>> Πληκτρολόγησε M-x για να μπεις στον μικροαποσβεστήρα· κατόπιν πάτα + για να εξέλθεις. + +Δεν μπορείς να χρησιμοποιήσεις C-g για να βγεις από επίπεδο +αναδρομικής επεξεργασίας. Αυτό είναι έτσι γιατί το C-g ακυρώνει +εντολές ή τις παραμέτρους αυτών ΕΝΤΟΣ του τρέχοντος επιπέδου +αναδρομικής επεξεργασίας. + + +* ΠΕΡΙΣΣΟΤΕΡΗ ΒΟΗΘΕΙΑ +--------------------- + +Σε αυτό τον οδηγό προσπαθήσαμε να προσφέρουμε βασικές γνώσεις για να +αρχίσεις να χρησιμοποιείς το Emacs. Υπάρχουν τόσα πολλά στο Emacs που +θα ήταν αδύνατο να τα εξηγήσουμε όλα εδώ. Ωστόσο, μάλλον θα θέλεις να +μάθεις περισσότερα για τις διάφορες δυνατότητες που παρέχει το Emacs. +Προς αυτόν τον σκοπό, το Emacs προσφέρει εντολές για την εξεύρεση κι +ανάγνωση οδηγιών. Αυτές οι εντολές «βοήθειας» (help) όλες αρχίζουν με +τον χαρακτήρα CONTROL-h, που αποκαλείται «ο χαρακτήρας βοηθείας». + +Για να χρησιμοποιήσεις τις υπηρεσίες βοηθείας, πληκτρολόγησε C-h, και +μετά ένα χαρακτήρα που ανταποκρίνεται στο είδος της βοήθειας που +επιζητείς. Αν είσαι σε ΠΡΑΓΜΑΤΙΚΑ δύσκολη θέση, πάτα C-h ? και το +Emacs θα σου πει τι είδη βοηθείας υπάρχουν. Αν έχεις ήδη πατήσει C-h +και αποφάσισες πως δεν θέλεις καμία βοήθεια, απλά ακύρωσε το με C-g. + +(Αν το C-h δεν προβάλει μήνυμα για βοήθεια στο κάτω μέρος της οθόνης, +δοκίμασε το πλήκτρο F1, αλλιώς M-x help .) + +Η πιο βασική βοήθεια προσφέρεται από το C-h c. Πληκτρολόγησε C-h, +ύστερα το c, και μετά τον χαρακτήρα ή αλληλουχία χαρακτήρων +οποιασδήποτε εντολής: το Emacs θα εμφανίσει μια σύντομη περιγραφή της +εντολής. + +>> Πληκτρολόγησε C-h c C-p + +Το μήνυμα θα είναι κάπως έτσι: + + C-p εκτελεί την εντολή previous-line + +Αυτό σου λέει το «όνομα της συνάρτησης». Καθώς οι συναρτήσεις έχουν +ονόματα που φανερώνουν την λειτουργία τους, μπορούν να ερμηνευθούν κι +ως πολύ σύντομες περιγραφές--επαρκείς για να σου υπενθυμίσουν κάτι που +ήδη έχεις μάθει. + +Εντολές με πολλούς χαρακτήρες, όπως C-x C-s ή v (αντί του M-v για +όσους δεν έχουν πλήκτρο META ή ALT) μπορούν κι αυτές να δοθούν μετά το +C-h c. + +Για περισσότερες πληροφορίες αναφορικά με μια εντολή, χρησιμοποίησε το +C-h k αντί του C-h c. + +>> Πληκτρολόγησε C-h k C-p. + +Αυτό δείχνει την πλήρη καταγραφή της συνάρτησης, καθώς και το όνομα +της, σε νέο παράθυρο του Emacs. Όταν το διαβάσεις, πάτα C-x 1 για να +κλείσεις εκείνο το παράθυρο. Δεν χρειάζεται να το κάνεις αυτό αμέσως. +Ίσως θες πρώτα να επεξεργαστείς κάτι καθώς αναφέρεσαι στο κείμενο +βοηθείας και μετά να πληκτρολογήσεις C-x 1. + +Ιδού άλλες χρήσιμες επιλογές με το C-h: + + C-h x Περιέγραψε μια εντολή. Ζητά το όνομα της εντολής. + +>> Προσπάθησε C-h x previous-line . + Δείχνει όλες τις πληροφορίες που έχει το Emacs σχετικά με την + συνάρτηση που δίνει την εντολή C-p. + +Παρόμοια εντολή είναι αυτή του C-h v που δείχνει την καταγραφή μιας +μεταβλητής, συμπεριλαμβανομένων αυτών που μπορείς να τροποποιήσεις για +να αλλάξεις την συμπεριφορά του Emacs. Πρέπει να γράψεις το όνομα της +μεταβλητής στην σχετική προτροπή. + + C-h a Συναφή εντολών (command apropos). Γράψε μια + λέξη-κλειδί και το Emacs θα παραθέσει όλες τις εντολές + των οποίων το όνομα περιέχει αυτήν την λέξη. Όλες + αυτές οι εντολές μπορούν να κληθούν με το META-x. Για + ορισμένες εντολές, τα συναφή εντολών περιέχουν και την + σχετική αλληλουχία χαρακτήρων που εκτελεί την εντολή. + +>> Πληκτρολόγησε C-h a file . + +Αυτό παραθέτει σε έτερο παράθυρο όλες τις εντολές M-x που περιέχουν +τον όρο «file» στο όνομα τους. Θα δεις εντολές χαρακτήρος μεταξύ των +επονομαζομένων (όπως C-x C-f πέριξ του find-file). + +>> Πληκτρολόγησε C-M-v για να κυλήσεις το παράθυρο βοηθείας. Κάνε το + μερικές φορές. + +>> Πληκτρολόγησε C-x 1 για να κλείσεις το παράθυρο βοηθείας. + + C-h i Διάβασε τα εγχειρίδια (Info manuals). Αυτή η εντολή + σε βάζει σε ειδικό αποσβεστήρα που ονομάζεται «*info*» + όπου μπορείς να διαβάσεις εγχειρίδια για τις + συσκευασίες που είναι εγκατεστημένες στο σύστημα σου. + Πληκτρολόγησε m emacs για να διαβάσεις το + εγχειρίδιο του Emacs. Αν δεν έχεις χρησιμοποιήσει το + Info ποτέ, πληκτρολόγησε h και το Emacs θα σου δείξει + τις σχετικές λειτουργίες. Αφού ολοκληρώσεις αυτή την + εκμάθηση, να αναφέρεσε στο εγχειρίδιο του Emacs ως την + κύρια πηγή όλων των καταγραφών. + + +* ΑΛΛΕΣ ΛΕΙΤΟΥΡΓΙΕΣ +------------------- + +Μπορείς να μάθεις περισσότερα για το Emacs διαβάζοντας το εγχειρίδιο +του, είτε ως έντυπο βιβλίο, είτε εντός του Emacs (χρησιμοποίησε τον +κατάλογο βοηθείας ή πληκτρολόγησε C-h r). Δύο λειτουργίες που ίσως να +σου φανούν χρήσιμες είναι η «ολοκλήρωση», που εξοικονομεί στην +δακτυλογράφηση, και το Dired, που απλοποιεί την διαχείριση αρχείων. + +Η ολοκλήρωση είναι τρόπος αποφυγής αχρείαστης πληκτρολόγησης. Για +παράδειγμα, αν θες να μεταβείς στον αποσβεστήρα *Messages*, +πληκτρολογείς C-x b *M και το Emacs θα συμπληρώσει το υπόλοιπο +του ονόματος ως εκεί που μπορεί να κρίνει αντιστοιχία με αυτό που +έχεις ήδη γράψει. Η ολοκλήρωση δουλεύει επίσης για ονόματα εντολών κι +αρχείων. Στο εγχειρίδιο καταγράφεται στην ενότητα «Completion». + +Το Dired σου επιτρέπει να παραθέτεις κατάλογο αρχείων (και προαιρετικά +υποκαταλόγους), να επιλέγεις, επισκέπτεσαι, μετονομάζεις, διαγράφεις, +ή γενικά να επιδράς πάνω σε αρχεία. Το Dired καταγράφεται στο +εγχειρίδιο στην ενότητα «Dired». + +Το εγχειρίδιο καταγράφει πολλές άλλες λειτουργίες του Emacs. + + +* ΕΓΚΑΤΑΣΤΑΣΗ ΣΥΣΚΕΥΑΣΙΩΝ +------------------------- + +Υπάρχει πλούσιος όγκος συσκευασιών (packages) του Emacs που έχουν +παρασκευαστεί από την κοινότητα των χρηστών του, που επεκτείνουν τις +δυνατότητες του Emacs. Αυτές οι συσκευασίες περιλαμβάνουν υποστήριξη +για νέες γλώσσες, πρόσθετα θέματα χρωμάτων, προεκτάσεις για εξωτερικές +εφαρμογές, και άλλα πολλά. + +Για παράθεση των διαθέσιμων συσκευασιών, πληκτρολόγησε M-x +list-packages. Στη σχετική λίστα, μπορείς να εγκαταστήσεις ή +απεγκαταστήσεις συσκευασίες, καθώς και να διαβάσεις τις περιγραφές +τους. Για περισσότερες πληροφορίες περί διαχείρισης συσκευασιών, δες +το εγχειρίδιο του Emacs. + + +* ΚΑΤΑΛΗΚΤΙΚΑ +------------- + +Για έξοδο από το Emacs, χρησιμοποίησε C-x C-c. + +Αυτή η εκμάθηση γράφτηκε για να είναι κατανοητή σε όλους τους νέους +χρήστες. Αν λοιπόν κάτι παραμένει ασαφές, μην κάτσεις εκεί να +κατηγορείς τον εαυτό σου - πες μας για το πρόβλημα σου! + + +* ΑΝΤΙΓΡΑΦΗ +----------- + +Αυτό το κείμενο εκμάθησης είναι συνέχεια μιας μακράς γραμμής κειμένων +εκμάθησης του Emacs, αρχής γενομένης αυτού του Stuart Cracraft για το +αρχικό Emacs. + +Αυτή η έκδοση της εκμάθησης είναι μέρος του GNU Emacs. Έχει +πνευματικά δικαιώματα και δίνεται με την άδεια διανομής αντιγράφων υπό +κάποιους όρους. + + Πνευματικά Δικαιώματα (C) 1985, 1996, 1998, 2001-2022 Free Software + Foundation, Inc. + + Αυτό το αρχείο είναι μέρος του GNU Emacs. + + Το GNU Emacs είναι ελεύθερο λογισμικό: μπορείτε να το αναδιανέμετε + ή/και να το τροποποιήσετε σύμφωνα με τους όρους της GNU Γενική + Δημόσια Άδεια (GNU General Public License) όπως δημοσιεύθηκε από το + Ίδρυμα Ελεύθερου Λογισμικού (Free Software Foundation), είτε την + έκδοση 3 της άδειας, είτε (κατά την επιλογή σας) οποιαδήποτε + μεταγενέστερη έκδοση. + + Το GNU Emacs διανέμεται με την ελπίδα πως θα είναι χρήσιμο, αλλά + ΧΩΡΙΣ ΚΑΜΙΑ ΕΓΓΥΗΣΗ· χωρίς καν την συνεπαγόμενη εγγύηση της + ΕΜΠΟΡΕΥΣΙΜΟΤΗΤΑΣ ή ΚΑΤΑΛΛΗΛΟΤΗΤΑΣ ΓΙΑ ΣΥΓΚΕΚΡΙΜΕΝΟ ΣΚΟΠΟ. Δείτε την + GNU Γενική Δημόσια Άδεια (GNU General Public License) για + περισσότερες λεπτομέρειες. + + Οφείλατε να λάβετε αντίγραφο της GNU Γενικής Δημόσιας Άδειας (GNU + General Public License) μαζί με το GNU Emacs. Εάν όχι, δείτε + . + +Παρακαλώ όπως διαβάσετε το αρχείο COPYING και δώσετε αντίγραφα του GNU +Emacs στους φίλους σας. Βοηθήστε στην καταπολέμηση του περιορισμού +(«ιδιοκτησία») του λογισμικού δια της χρήσης, γραφής, και κοινοποίησης +ελεύθερου λογισμικού! diff --git a/etc/tutorials/TUTORIAL.translators b/etc/tutorials/TUTORIAL.translators index b6b9578706..891b6a1682 100644 --- a/etc/tutorials/TUTORIAL.translators +++ b/etc/tutorials/TUTORIAL.translators @@ -26,6 +26,10 @@ Maintainer: Dale Gulledge Author: Rafael Sepúlveda Maintainer: Rafael Sepúlveda +* TUTORIAL.el_GR: +Author: Protesilaos Stavrou +Maintainer: Protesilaos Stavrou + * TUTORIAL.fr: Author: Éric Jacoboni Maintainer: Éric Jacoboni diff --git a/lisp/language/greek.el b/lisp/language/greek.el index 58f4fe6fc4..920cf67d87 100644 --- a/lisp/language/greek.el +++ b/lisp/language/greek.el @@ -79,7 +79,9 @@ (coding-priority greek-iso-8bit) (nonascii-translation . iso-8859-7) (input-method . "greek") - (documentation . t))) + (documentation . "Support for Greek ISO-8859-7 using the greek input method.") + (sample-text . "Greek (ελληνικά) Γειά σας") + (tutorial . "TUTORIAL.el_GR"))) (provide 'greek) commit e8ed4317e879683872d956cc919d0957fff18531 Author: Eli Zaretskii Date: Sun May 8 17:37:32 2022 +0300 ; * etc/HELLO: Remove empty line. diff --git a/etc/HELLO b/etc/HELLO index bd33c32b7a..f5e2adae94 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -86,7 +86,6 @@ TaiViet (ꪁꪫꪱꪣ ꪼꪕ) ꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ Tibetan (བོད་སྐད་) བཀྲ་ཤིས་བདེ་ལེགས༎ Tigrigna (ትግርኛ) ሰላማት - Tirhuta (𑒞𑒱𑒩𑒯𑒳𑒞𑒰) 𑒣𑓂𑒩𑒢𑒰𑒧 / 𑒮𑒲𑒞𑒰𑒩𑒰𑒧 Turkish (Türkçe) Merhaba Ukrainian (українська) Вітаю commit 82f1f198c6b473c5f1169983d998f0779958d087 Author: समीर सिंह Sameer Singh Date: Sun May 8 17:42:35 2022 +0530 Add support for the Tirhuta script * lisp/language/indian.el ("Tirhuta"): New language environment. Add composition rules for Tirhuta. Add sample text and input method. * lisp/international/fontset.el (script-representative-chars) (setup-default-fontset): Support Tirhuta. * lisp/leim/quail/indian.el ("tirhuta"): New input method. * etc/HELLO: Add a Tirhuta greeting. * etc/NEWS: Announce the new language environment and its input method. diff --git a/etc/HELLO b/etc/HELLO index ac0cb823ea..bd33c32b7a 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -86,6 +86,8 @@ TaiViet (ꪁꪫꪱꪣ ꪼꪕ) ꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ Tibetan (བོད་སྐད་) བཀྲ་ཤིས་བདེ་ལེགས༎ Tigrigna (ትግርኛ) ሰላማት + +Tirhuta (𑒞𑒱𑒩𑒯𑒳𑒞𑒰) 𑒣𑓂𑒩𑒢𑒰𑒧 / 𑒮𑒲𑒞𑒰𑒩𑒰𑒧 Turkish (Türkçe) Merhaba Ukrainian (українська) Вітаю Vietnamese (tiếng Việt) Chào bạn diff --git a/etc/NEWS b/etc/NEWS index 5c13b72c29..5d2b5e12cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -744,6 +744,11 @@ an important writing system of the past mainly used for administrative purposes. A new input method, 'kaithi', is provided to type text in this script. +*** New language environment "Tirhuta". +This language environment supports Tirhuta or Mithilaakshar, which is +used to write the Maithili language. A new input method, 'tirhuta', +is provided to type text in this script. + * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 66f5068cf7..2d417d632f 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -238,7 +238,7 @@ (khudawadi #x112B0) (grantha #x11305) (newa #x11400) - (tirhuta #x11481) + (tirhuta #x11481 #x1148F #x114D0) (siddham #x11580) (modi #x11600) (takri #x11680) @@ -774,6 +774,7 @@ old-uyghur brahmi kaithi + tirhuta makasar dives-akuru cuneiform diff --git a/lisp/language/indian.el b/lisp/language/indian.el index ce46d32549..922061c3b6 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -147,6 +147,17 @@ Languages such as Awadhi, Bhojpuri, Magahi and Maithili which used the Kaithi script are supported in this language environment.")) '("Indian")) +(set-language-info-alist + "Tirhuta" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "tirhuta") + (sample-text . "Tirhuta (𑒞𑒱𑒩𑒯𑒳𑒞𑒰) 𑒣𑓂𑒩𑒢𑒰𑒧") + (documentation . "\ +Maithili language and its script Tirhuta is supported in this +language environment.")) + '("Indian")) + ;; Replace mnemonic characters in REGEXP according to TABLE. TABLE is ;; an alist of (MNEMONIC-STRING . REPLACEMENT-STRING). @@ -466,4 +477,17 @@ which used the Kaithi script are supported in this language environment.")) (provide 'indian) +;; Tirhuta composition rules +(let ((consonant "[\x1148F-\x114AF]") + (nukta "\x114C3") + (vowel "[\x114B0-\x114BE]") + (anusvara-candrabindu "[\x114BF\x114C0]") + (virama "\x114C2")) + (set-char-table-range composition-function-table + '(#x114B0 . #x114C3) + (list (vector + (concat consonant nukta "?\\(?:" virama consonant nukta "?\\)*\\(?:" + virama "\\|" vowel "*" nukta "?" anusvara-candrabindu "?\\)") + 1 'font-shape-gstring)))) + ;;; indian.el ends here diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index a52d44bc08..f730a5ca0f 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -860,6 +860,7 @@ Full key sequences are listed below:") ("8" ?८) ("`8" ?8) ("9" ?९) +("`9" ?9) ("0" ?०) ("`0" ?0) ("`\)" ?𑂻) @@ -936,5 +937,111 @@ Full key sequences are listed below:") ("`m" ?𑂀) ) +(quail-define-package + "tirhuta" "Tirhuta" "𑒞𑒱" t "Tirhuta phonetic input method. + + `\\=`' is used to switch levels instead of Alt-Gr. +" nil t t t t nil nil nil nil nil t) + +(quail-define-rules +("``" ?₹) +("1" ?𑓑) +("`1" ?1) +("2" ?𑓒) +("`2" ?2) +("3" ?𑓓) +("`3" ?3) +("4" ?𑓔) +("`4" ?4) +("5" ?𑓕) +("`5" ?5) +("6" ?𑓖) +("`6" ?6) +("7" ?𑓗) +("`7" ?7) +("8" ?𑓘) +("`8" ?8) +("9" ?𑓙) +("`9" ?9) +("0" ?𑓐) +("`0" ?0) +("`\)" ?𑓆) +("`\\" ?।) +("`|" ?॥) +("`" ?𑒙) +("q" ?𑒙) +("Q" ?𑒚) +("w" ?𑒛) +("W" ?𑒜) +("e" ?𑒺) +("E" ?𑒹) +("`e" ?𑒋) +("r" ?𑒩) +("R" ?𑒵) +("`r" ?𑒇) +("t" ?𑒞) +("T" ?𑒟) +("y" ?𑒨) +("Y" ?𑒻) +("`y" ?𑒌) +("u" ?𑒳) +("U" ?𑒴) +("`u" ?𑒅) +("`U" ?𑒆) +("i" ?𑒱) +("I" ?𑒲) +("`i" ?𑒃) +("`I" ?𑒄) +("o" ?𑒽) +("O" ?𑒼) +("`o" ?𑒍) +("p" ?𑒣) +("P" ?𑒤) +("a" ?𑒰) +("A" ?𑒂) +("`a" ?𑒁) +("s" ?𑒮) +("S" ?𑒬) +("d" ?𑒠) +("D" ?𑒡) +("f" ?𑓂) +("F" ?𑒶) +("`f" ?𑒈) +("g" ?𑒑) +("G" ?𑒒) +("h" ?𑒯) +("H" ?𑓁) +("j" ?𑒖) +("J" ?𑒗) +("k" ?𑒏) +("K" ?𑒐) +("l" ?𑒪) +("L" ?𑒷) +("`l" ?𑒉) +("z" ?𑒘) +("Z" ?𑒓) +("`z" ?𑒸) +("`Z" ?𑒊) +("x" ?𑒭) +("X" ?𑓃) +("c" ?𑒔) +("C" ?𑒕) +("`c" #x200C) ; ZWNJ +("v" ?𑒫) +("V" ?𑒾) +("`v" ?𑒎) +("b" ?𑒥) +("B" ?𑒦) +("`b" ?𑒀) +("`B" ?𑓄) +("n" ?𑒢) +("N" ?𑒝) +("`n" ?𑓇) +("`N" ?𑓅) +("m" ?𑒧) +("M" ?𑓀) +("`m" ?𑒿) +) + ;;; indian.el ends here commit b03d6265cd9427e11c5bfd4a56822b4475c8e8cd Author: Stefan Monnier Date: Sun May 8 10:33:49 2022 -0400 * lisp/emacs-lisp/oclosure.el (oclosure-define): Fix empty case diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index cb8c59b05a..9775e8cc65 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -223,7 +223,7 @@ list of slot properties. The currently known properties are the following: `:mutable': A non-nil value mean the slot can be mutated. `:type': Specifies the type of the values expected to appear in the slot." (declare (doc-string 2) (indent 1)) - (unless (stringp docstring) + (unless (or (stringp docstring) (null docstring)) (push docstring slots) (setq docstring nil)) (let* ((options (when (consp name) commit 7546179a011452c304022349d034a03303a11ebb Author: Lars Ingebrigtsen Date: Sun May 8 15:41:46 2022 +0200 Don't hang on trying to rename FIFOs between file systems * src/fileio.c (Frename_file): Don't hang on trying to move FIFOs (bug#34069). diff --git a/src/fileio.c b/src/fileio.c index c418036fc6..0610f7235a 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2718,6 +2718,20 @@ This is what happens in interactive use with M-x. */) : Qnil); if (!NILP (symlink_target)) Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); + else if (S_ISFIFO (file_st.st_mode)) + { + /* If it's a FIFO, calling `copy-file' will hang if it's a + inter-file system move, so do it here. (It will signal + an error in that case, but it won't hang in any case.) */ + if (!NILP (ok_if_already_exists)) + barf_or_query_if_file_exists (newname, false, + "rename to it", + FIXNUMP (ok_if_already_exists), + false); + if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) != 0) + report_file_errno ("Renaming", list2 (file, newname), errno); + return Qnil; + } else Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); } commit d24ea263e2193016c353d20e6388ef91597cf082 Author: Visuwesh Date: Sun May 8 13:17:34 2022 +0200 dired-do-query-replace-regexp doc string fix * lisp/dired-aux.el (dired-do-query-replace-regexp): Refer 'fileloop-continue' instead of the obsolete command 'tags-loop-continue'. (Bug#55311) (cherry picked from commit 4c505203f9171886f47638779326e257a95a1d79) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index e00910cfe8..d47bcf0427 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -3179,7 +3179,7 @@ type \\[help-command] at that time. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit the query-replace loop (\\[keyboard-quit], RET or q), you can -resume the query replace with the command \\[tags-loop-continue]." +resume the query replace with the command \\[fileloop-continue]." (interactive (let ((common (query-replace-read-args commit d6e316db729718f93772cec2e5166f54a920c0e3 Author: Po Lu Date: Sun May 8 21:28:28 2022 +0800 Fix display of fringes with stipples on X * src/xterm.c (x_draw_fringe_bitmap): Set fill style and use fill function correctly. diff --git a/src/xterm.c b/src/xterm.c index fe9531bdb4..d32bdea843 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5762,15 +5762,19 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring mono-displays, the fill style may have been changed to FillSolid in x_draw_glyph_string_background. */ if (face->stipple) - XSetFillStyle (display, face->gc, FillOpaqueStippled); + { + XSetFillStyle (display, face->gc, FillOpaqueStippled); + x_fill_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, + true); + XSetFillStyle (display, face->gc, FillSolid); + } else - XSetBackground (display, face->gc, face->background); - - x_clear_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, - true); - - if (!face->stipple) - XSetForeground (display, face->gc, face->foreground); + { + XSetBackground (display, face->gc, face->background); + x_clear_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, + true); + XSetForeground (display, face->gc, face->foreground); + } } #ifdef USE_CAIRO commit 4d8527e5802e41573ee8c9f2a41659a1ba388dde Author: Po Lu Date: Sun May 8 13:20:43 2022 +0000 Fix display of fringes with stipples on Haiku * haikuterm.c (haiku_after_update_window_line): Fix coding style. (haiku_draw_fringe_bitmap): Handle display of stipples if present. diff --git a/src/haikuterm.c b/src/haikuterm.c index 16e732fa0d..265d3fbf5e 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1910,8 +1910,9 @@ haiku_after_update_window_line (struct window *w, void *view = FRAME_HAIKU_VIEW (f); BView_draw_lock (view, false, 0, 0, 0, 0); BView_StartClip (view); - BView_SetHighColor (view, face->background_defaulted_p ? - FRAME_BACKGROUND_PIXEL (f) : face->background); + BView_SetHighColor (view, (face->background_defaulted_p + ? FRAME_BACKGROUND_PIXEL (f) + : face->background)); BView_FillRectangle (view, 0, y, width, height); BView_FillRectangle (view, FRAME_PIXEL_WIDTH (f) - width, y, width, height); @@ -2529,25 +2530,50 @@ static void haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) { - void *view = FRAME_HAIKU_VIEW (XFRAME (WINDOW_FRAME (w))); - struct face *face = p->face; + struct face *face; + struct frame *f; + struct haiku_bitmap_record *rec; + void *view, *bitmap; + uint32 col; + + f = XFRAME (WINDOW_FRAME (w)); + view = FRAME_HAIKU_VIEW (f); + face = p->face; block_input (); BView_draw_lock (view, true, p->x, p->y, p->wd, p->h); BView_StartClip (view); haiku_clip_to_row (w, row, ANY_AREA); + if (p->bx >= 0 && !p->overlay_p) { - BView_SetHighColor (view, face->background); - BView_FillRectangle (view, p->bx, p->by, p->nx, p->ny); + if (!face->stipple) + { + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, p->bx, p->by, p->nx, p->ny); + } + else + { + rec = haiku_get_bitmap_rec (f, face->stipple); + haiku_update_bitmap_rec (rec, face->foreground, + face->background); + + BView_StartClip (view); + haiku_clip_to_row (w, row, ANY_AREA); + BView_ClipToRect (view, p->bx, p->by, p->nx, p->ny); + BView_DrawBitmapTiled (view, rec->img, 0, 0, -1, -1, + 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_EndClip (view); + } } if (p->which && p->which < max_fringe_bmp && p->which < max_used_fringe_bitmap) { - void *bitmap = fringe_bmps[p->which]; + bitmap = fringe_bmps[p->which]; if (!bitmap) { @@ -2561,8 +2587,6 @@ haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, bitmap = fringe_bmps[p->which]; } - uint32_t col; - if (!p->cursor_p) col = face->foreground; else if (p->overlay_p) commit f93c94996c7a8062878e1b7e0e7dba74bf5b98cd Author: Alan Mackenzie Date: Sun May 8 13:14:14 2022 +0000 CC Mode: Fix bug in c-parse-state. Fixes bug #55181. * lisp/progmodes/cc-engine.el (c-state-cache-lower-good-pos): When in a literal, return the start of that literal as a "good pos", not the parameter POS. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index b2fa9e0691..ae68bf989a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -3422,7 +3422,9 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and ;; Return a good pos (in the sense of `c-state-cache-good-pos') at the ;; lowest[*] position between POS and HERE which is syntactically equivalent ;; to HERE. This position may be HERE itself. POS is before HERE in the - ;; buffer. + ;; buffer. If POS and HERE are both in the same literal, return the start + ;; of the literal. STATE is the parsing state at POS. + ;; ;; [*] We don't actually always determine this exact position, since this ;; would require a disproportionate amount of work, given that this function ;; deals only with a corner condition, and POS and HERE are typically on @@ -3438,7 +3440,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (setq pos (point) state s))) (if (eq (point) here) ; HERE is in the same literal as POS - pos + (nth 8 state) ; A valid good pos cannot be in a literal. (setq s (parse-partial-sexp pos here (1+ (car state)) nil state nil)) (cond ((> (car s) (car state)) ; Moved into a paren between POS and HERE commit c7bd76a3f02d0a426c85035fd37b0d1a8b6ea5d9 Author: Po Lu Date: Sun May 8 21:07:44 2022 +0800 Set stipple flag on PGTK as well * pgtkterm.c (pgtk_draw_glyph_string_background): (pgtk_draw_glyph_string): Set stipple flag on string row. (pgtk_draw_fringe_bitmap): (pgtk_defined_color): Fix coding style. diff --git a/src/pgtkterm.c b/src/pgtkterm.c index c8c8bd0d85..4d6221d803 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -1333,9 +1333,7 @@ pgtk_draw_glyph_string_background (struct glyph_string *s, bool force_p) if (s->stippled_p) { /* Fill background with a stipple pattern. */ - - fill_background (s, - s->x, s->y + box_line_width, + fill_background (s, s->x, s->y + box_line_width, s->background_width, s->height - 2 * box_line_width); s->background_filled_p = true; @@ -2501,9 +2499,7 @@ pgtk_draw_glyph_string (struct glyph_string *s) if (s->face->underline_defaulted_p) pgtk_draw_underwave (s, s->xgcv.foreground); else - { - pgtk_draw_underwave (s, s->face->underline_color); - } + pgtk_draw_underwave (s, s->face->underline_color); } else if (s->face->underline == FACE_UNDER_LINE) { @@ -2670,6 +2666,11 @@ pgtk_draw_glyph_string (struct glyph_string *s) } } + /* TODO: figure out in which cases the stipple is actually drawn on + PGTK. */ + if (!s->row->stipple_p) + s->row->stipple_p = s->face->stipple; + /* Reset clipping. */ pgtk_end_cr_clip (s->f); s->num_clips = 0; @@ -3505,9 +3506,7 @@ pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row, mono-displays, the fill style may have been changed to FillSolid in pgtk_draw_glyph_string_background. */ if (face->stipple) - { - fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny); - } + fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny); else { pgtk_set_cr_source_with_color (f, face->background, true); @@ -6608,9 +6607,9 @@ pgtk_xlfd_to_fontname (const char *xlfd) } bool -pgtk_defined_color (struct frame *f, - const char *name, - Emacs_Color * color_def, bool alloc, bool makeIndex) +pgtk_defined_color (struct frame *f, const char *name, + Emacs_Color *color_def, bool alloc, + bool makeIndex) /* -------------------------------------------------------------------------- Return true if named color found, and set color_def rgb accordingly. If makeIndex and alloc are nonzero put the color in the color_table, commit 33141b51c3121b93f625c76b996b17ec8de97419 Author: Lars Ingebrigtsen Date: Sun May 8 15:03:59 2022 +0200 Allow term-mode to send function keys to the underlying shell * lisp/term.el (term-bind-function-keys): New user option. (term-raw-map): Bind f keys. (term-send-function-key): Send the function key to the underlying shell (bug#29920). diff --git a/etc/NEWS b/etc/NEWS index ee7a127af0..5c13b72c29 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1137,6 +1137,11 @@ filters and displayed with the specified color. ** term-mode +--- +*** New user option 'term-bind-function-keys'. +If non-nil, 'term-mode' will pass the function keys on to the +underlying shell instead of using the normal Emacs bindings. + --- *** Support for ANSI 256-color and 24-bit colors, italic and other fonts. Term-mode can now display 256-color and 24-bit color codes. It can diff --git a/lisp/term.el b/lisp/term.el index 3e05d529cd..640478b59a 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -918,6 +918,13 @@ is buffer-local." :type 'integer :version "27.1") +(defcustom term-bind-function-keys nil + "If nil, don't alter , and so on. +If non-nil, bind these keys in `term-mode' and send them to the +underlying shell." + :type 'boolean + :version "29.1") + ;; Set up term-raw-map, etc. @@ -958,6 +965,10 @@ is buffer-local." (define-key map [next] 'term-send-next) (define-key map [xterm-paste] #'term--xterm-paste) (define-key map [?\C-/] #'term-send-C-_) + + (when term-bind-function-keys + (dotimes (key 21) + (keymap-set map (format "" key) #'term-send-function-key))) map) "Keyboard map for sending characters directly to the inferior process.") @@ -1411,6 +1422,26 @@ Entry to this mode runs the hooks on `term-mode-hook'." (defun term-send-del () (interactive) (term-send-raw-string "\e[3~")) (defun term-send-backspace () (interactive) (term-send-raw-string "\C-?")) (defun term-send-C-_ () (interactive) (term-send-raw-string "\C-_")) + +(defun term-send-function-key () + "If bound to a function key, this will send that key to the underlying shell." + (interactive) + (let ((key (this-command-keys-vector))) + (when (and (= (length key) 1) + (symbolp (elt key 0))) + (let ((name (symbol-name (elt key 0)))) + (when (string-match "\\`f\\([0-9]++\\)\\'" name) + (let* ((num (string-to-number (match-string 1 name))) + (ansi + (cond + ((<= num 5) (+ num 10)) + ((<= num 10) (+ num 11)) + ((<= num 14) (+ num 12)) + ((<= num 16) (+ num 13)) + ((<= num 20) (+ num 14))))) + (when ansi + (term-send-raw-string (format "\e[%d~" ansi))))))))) + (defun term-char-mode () "Switch to char (\"raw\") sub-mode of term mode. commit 4b20ae908bc82d1f0d9e5bc9740a32572ed15018 Author: Po Lu Date: Sun May 8 13:02:00 2022 +0000 Set stipple flags on Haiku as well * src/haikuterm.c (haiku_draw_glyph_string): Set stipple flag where stipples are actually drawn. (This is different from X.) diff --git a/src/haikuterm.c b/src/haikuterm.c index 7c1115e027..16e732fa0d 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1860,8 +1860,21 @@ haiku_draw_glyph_string (struct glyph_string *s) } } } + haiku_end_clip (s); BView_draw_unlock (view); + + /* Set the stipple_p flag indicating whether or not a stipple was + drawn in s->row. That is the case either when s is a stretch + glyph string and s->face->stipple is not NULL, or when + s->face->stipple exists and s->hl is not DRAW_CURSOR, and s is + not an image. This is different from X. */ + if (s->first_glyph->type != IMAGE_GLYPH + && s->face->stipple + && (s->first_glyph->type == STRETCH_GLYPH + || s->hl != DRAW_CURSOR)) + s->row->stipple_p = true; + unblock_input (); } commit 2f1410562ea36f1143c9d7b2e1341cef93ae1c19 Author: Po Lu Date: Sun May 8 20:48:42 2022 +0800 Disable scrolling optimizations when a stipple is present * src/dispextern.h (struct glyph_row): New field `stippled_p'. We cannot just use the contents of the glyph row, since it has to be set in `gui_clear_end_of_line' and is more convenient to set inside the various draw_glyph_string functions. * src/dispnew.c (scrolling_window): Disable if a row in the current matrix has the stipple_p flag set. * src/xdisp.c (gui_clear_end_of_line): * src/xterm.c (x_draw_image_glyph_string) (x_draw_stretch_glyph_string, x_draw_glyph_string): Set `stipple_p' if a stipple pattern was drawn. diff --git a/src/dispextern.h b/src/dispextern.h index e9b19a7f13..a7f478acdf 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1075,6 +1075,9 @@ struct glyph_row right-to-left paragraph. */ bool_bf reversed_p : 1; + /* Whether or not a stipple was drawn in this row at some point. */ + bool_bf stipple_p : 1; + /* Continuation lines width at the start of the row. */ int continuation_lines_width; diff --git a/src/dispnew.c b/src/dispnew.c index 1dd64be4ea..c49c38cba8 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -4392,7 +4392,6 @@ add_row_entry (struct glyph_row *row) return entry; } - /* Try to reuse part of the current display of W by scrolling lines. HEADER_LINE_P means W has a header line. @@ -4438,6 +4437,14 @@ scrolling_window (struct window *w, int tab_line_p) struct glyph_row *d = MATRIX_ROW (desired_matrix, i); struct glyph_row *c = MATRIX_ROW (current_matrix, i); + /* If there is a row with a stipple currently on the glass, give + up. Stipples look different depending on where on the + display they are drawn, so scrolling the display will produce + incorrect results. */ + + if (c->stipple_p) + return 0; + if (c->enabled_p && d->enabled_p && !d->redraw_fringe_bitmaps_p @@ -4467,6 +4474,16 @@ scrolling_window (struct window *w, int tab_line_p) first_old = first_new = i; + while (i < current_matrix->nrows - 1) + { + /* If there is a stipple after the first change, give up as + well. */ + if (MATRIX_ROW (current_matrix, i)->stipple_p) + return 0; + + ++i; + } + /* Set last_new to the index + 1 of the row that reaches the bottom boundary in the desired matrix. Give up if we find a disabled row before we reach the bottom boundary. */ diff --git a/src/xdisp.c b/src/xdisp.c index 50efa50c55..f09f209b2e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32015,14 +32015,16 @@ gui_insert_glyphs (struct window *w, struct glyph_row *updated_row, void gui_clear_end_of_line (struct window *w, struct glyph_row *updated_row, - enum glyph_row_area updated_area, int to_x) + enum glyph_row_area updated_area, int to_x) { struct frame *f; int max_x, min_y, max_y; int from_x, from_y, to_y; + struct face *face; eassert (updated_row); f = XFRAME (w->frame); + face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID); if (updated_row->full_width_p) max_x = (WINDOW_PIXEL_WIDTH (w) @@ -32074,6 +32076,9 @@ gui_clear_end_of_line (struct window *w, struct glyph_row *updated_row, block_input (); FRAME_RIF (f)->clear_frame_area (f, from_x, from_y, to_x - from_x, to_y - from_y); + + if (face && !updated_row->stipple_p) + updated_row->stipple_p = face->stipple; unblock_input (); } } diff --git a/src/xterm.c b/src/xterm.c index a7f0f3d7ef..fe9531bdb4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8052,6 +8052,9 @@ x_draw_image_glyph_string (struct glyph_string *s) || s->img->pixmap == 0 || s->width != s->background_width) { + if (s->stippled_p) + s->row->stipple_p = true; + #ifndef USE_CAIRO if (s->img->mask) { @@ -8232,6 +8235,8 @@ x_draw_stretch_glyph_string (struct glyph_string *s) XSetFillStyle (display, gc, FillOpaqueStippled); x_fill_rectangle (s->f, gc, x, y, w, h, true); XSetFillStyle (display, gc, FillSolid); + + s->row->stipple_p = true; } else { @@ -8258,8 +8263,13 @@ x_draw_stretch_glyph_string (struct glyph_string *s) background_width -= text_left_x - x; x = text_left_x; } + + if (!s->row->stipple_p) + s->row->stipple_p = s->stippled_p; + if (background_width > 0) - x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); + x_draw_glyph_string_bg_rect (s, x, s->y, + background_width, s->height); } s->background_filled_p = true; @@ -8708,6 +8718,14 @@ x_draw_glyph_string (struct glyph_string *s) /* Reset clipping. */ x_reset_clip_rectangles (s->f, s->gc); s->num_clips = 0; + + /* Set the stippled flag that tells redisplay whether or not a + stipple was actually draw. */ + + if (s->first_glyph->type != STRETCH_GLYPH + && s->first_glyph->type != IMAGE_GLYPH + && !s->row->stipple_p) + s->row->stipple_p = s->stippled_p; } /* Shift display to make room for inserted glyphs. */ commit 7a29f55f3aa3b1c3a9ed94d049e2fac1694200b9 Merge: 461ac0815c 4c505203f9 Author: Po Lu Date: Sun May 8 19:43:13 2022 +0800 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 1d012e0a621f9cf99048f57130144275b9025d1c Author: Alan Mackenzie Date: Sun May 8 11:39:45 2022 +0000 Linux console: don't translate ESC TAB to `backtab' in input-decode-map. This translation happened after the terminfo entry for TAB in the linux section was changed to kcbt=\E^I in ncurses version 6.3. * lisp/term/linux.el (terminal-init-linux): Add a define-key form to remove the entry for "\e\t" from input-decode-map. * etc/PROBLEMS: Add a new section under "character terminals" about S-TAB wrongly doing the same thing as M-TAB, giving tips about amending the Linux keyboard layout. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 2a26dfaec4..8a260c3177 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1736,6 +1736,33 @@ this, you can remove the X resource or put this in your init file: (xterm-remove-modify-other-keys) +** The shift TAB key combination works as meta TAB on a Linux console. + +This happens because on your keyboard layout, S-TAB produces the same +keycodes as typing ESC TAB individually. The best way to solve this +is to modify your keyboard layout to produce different codes, and tell +Emacs what these new codes mean. + +The current keyboard layout will probably be a .map.gz file somewhere +under /usr/share/keymaps. Identify this file, possibly from a system +initialization file such as /etc/conf.d/keymaps. Run gunzip on it to +decompress it, and amend the entries for keycode 15 to look something +like this: + +keycode 15 = Tab + alt keycode 15 = Meta_Tab + shift keycode 15 = F219 +string F219 = "\033[4}\011" # Shift+ + +After possibly saving this file under a different name, compress it +again using gzip. Amend /etc/conf.d/keyamps, etc., if needed. +Further details can be found in the man page for loadkeys. + +Then add the following line near the start of your site-start.el or +.emacs or init.el file: + +(define-key input-decode-map "\e[4}\t" 'backtab) + ** Emacs spontaneously displays "I-search: " at the bottom of the screen. This means that Control-S/Control-Q (XON/XOFF) "flow control" is being diff --git a/lisp/term/linux.el b/lisp/term/linux.el index 6d43e477ac..ab5a6d8698 100644 --- a/lisp/term/linux.el +++ b/lisp/term/linux.el @@ -17,6 +17,10 @@ (ignore-errors (when gpm-mouse-mode (require 't-mouse) (gpm-mouse-enable))) + ;; Don't translate ESC TAB to backtab as directed + ;; by ncurses-6.3. + (define-key input-decode-map "\e\t" nil) + ;; Make Latin-1 input characters work, too. ;; Meta will continue to work, because the kernel ;; turns that into Escape. commit 4c505203f9171886f47638779326e257a95a1d79 Author: Visuwesh Date: Sun May 8 13:17:34 2022 +0200 dired-do-query-replace-regexp doc string fix * lisp/dired-aux.el (dired-do-query-replace-regexp): Refer 'fileloop-continue' instead of the obsolete command 'tags-loop-continue'. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 64cdab28f9..d2bac5c467 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -3293,7 +3293,7 @@ type \\[help-command] at that time. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit the query-replace loop (\\[keyboard-quit], RET or q), you can -resume the query replace with the command \\[tags-loop-continue]." +resume the query replace with the command \\[fileloop-continue]." (interactive (let ((common (query-replace-read-args commit 461ac0815c153778c41f3074e8d7748754ff7dd9 Author: Po Lu Date: Sun May 8 19:14:57 2022 +0800 Fix crashes on ordinary menus on macOS * src/nsmenu.m ([EmacsMenu runMenuAt:forFrame:keymaps:]): Fix coding style. ([EmacsMenu menu:willHighlightItem:]): Ignore if this is a context menu. diff --git a/src/nsmenu.m b/src/nsmenu.m index b0ab12bb87..34864f9408 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -741,15 +741,15 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f /* p = [view convertPoint:p fromView: nil]; */ p.y = NSHeight ([view frame]) - p.y; e = [[view window] currentEvent]; - event = [NSEvent mouseEventWithType: NSEventTypeRightMouseDown - location: p - modifierFlags: 0 - timestamp: [e timestamp] - windowNumber: [[view window] windowNumber] - context: nil - eventNumber: 0 /* [e eventNumber] */ - clickCount: 1 - pressure: 0]; + event = [NSEvent mouseEventWithType: NSEventTypeRightMouseDown + location: p + modifierFlags: 0 + timestamp: [e timestamp] + windowNumber: [[view window] windowNumber] + context: nil + eventNumber: 0 /* [e eventNumber] */ + clickCount: 1 + pressure: 0]; context_menu_value = -1; [NSMenu popUpContextMenu: self withEvent: event forView: view]; @@ -767,6 +767,10 @@ - (void) menu: (NSMenu *) menu willHighlightItem: (NSMenuItem *) item Lisp_Object vec = f->menu_bar_vector; Lisp_Object help, frame; + /* This isn't a menubar, ignore. */ + if (context_menu_value == -1) + return; + if (idx >= ASIZE (vec)) return; commit be60e9e947cc441abc3373d321ff7869b607628e Author: Po Lu Date: Sun May 8 19:02:06 2022 +0800 Fix bug in `pixel-scroll-precision-mode' on nonselected windows * src/window.c (Fset_window_vscroll): Mark window for redisplay. (bug#55299) diff --git a/src/window.c b/src/window.c index 15d6cf94b0..72d10f9da2 100644 --- a/src/window.c +++ b/src/window.c @@ -7980,6 +7980,9 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */) /* Prevent redisplay shortcuts. */ XBUFFER (w->contents)->prevent_redisplay_optimizations_p = true; + + /* Mark W for redisplay. (bug#55299) */ + wset_redisplay (w); } } commit ccbdae840d21100520d191afa7001c4cd53a48a8 Author: Michael Albinus Date: Sun May 8 11:51:59 2022 +0200 Handle changed scp protocol in Tramp * lisp/net/tramp-sh.el (tramp-scp-force-scp-protocol): New defvar. (tramp-scp-force-scp-protocol): New defun. (tramp-do-copy-or-rename-file-out-of-band): Use it. (tramp-scp-direct-remote-copying, tramp-methods) : Use "%z". * lisp/net/tramp.el (tramp-methods): Adapt docstring. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ba4cdb0ab5..74155d1722 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -137,6 +137,15 @@ be auto-detected by Tramp. The string is used in `tramp-methods'.") +(defvar tramp-scp-force-scp-protocol nil + "Force scp protocol. + +It is the string \"-O\" if supported by the local scp (since +release 8.6), otherwise the string \"\". If it is nil, it will +be auto-detected by Tramp. + +The string is used in `tramp-methods'.") + (defcustom tramp-use-scp-direct-remote-copying nil "Whether to use direct copying between two remote hosts." :group 'tramp @@ -179,7 +188,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("%x") ("%y") ("-q") ("-r") ("%c"))) + ("%x") ("%y") ("%z") + ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -195,7 +205,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("%x") ("%y") ("-q") ("-r") ("%c"))) + ("%x") ("%y") ("%z") + ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -2347,7 +2358,8 @@ The method used must be an out-of-band method." ?r listener ?c options ?k (if keep-date " " "") ?n (concat "2>" (tramp-get-remote-null-device v)) ?x (tramp-scp-strict-file-name-checking v) - ?y (tramp-scp-direct-remote-copying v1 v2)) + ?y (tramp-scp-force-scp-protocol v) + ?z (tramp-scp-direct-remote-copying v1 v2)) copy-program (tramp-get-method-parameter v 'tramp-copy-program) copy-keep-date (tramp-get-method-parameter v 'tramp-copy-keep-date) @@ -4810,14 +4822,41 @@ Goes through the list `tramp-inline-compress-commands'." (setq tramp-scp-strict-file-name-checking "-T"))))))) tramp-scp-strict-file-name-checking))) +(defun tramp-scp-force-scp-protocol (vec) + "Return the force scp protocol argument of the local scp." + (cond + ;; No options to be computed. + ((null (assoc "%y" (tramp-get-method-parameter vec 'tramp-copy-args))) + "") + + ;; There is already a value to be used. + ((stringp tramp-scp-force-scp-protocol) + tramp-scp-force-scp-protocol) + + ;; Determine the options. + (t (setq tramp-scp-force-scp-protocol "") + (let ((case-fold-search t)) + (ignore-errors + (when (executable-find "scp") + (with-tramp-progress-reporter + vec 4 "Computing force scp protocol argument" + (with-temp-buffer + (tramp-call-process vec "scp" nil t nil "-O") + (goto-char (point-min)) + (unless + (search-forward-regexp + "\\(illegal\\|unknown\\) option -- O" nil t) + (setq tramp-scp-force-scp-protocol "-O"))))))) + tramp-scp-force-scp-protocol))) + (defun tramp-scp-direct-remote-copying (vec1 vec2) "Return the direct remote copying argument of the local scp." (cond ((or (not tramp-use-scp-direct-remote-copying) (null vec1) (null vec2) (not (tramp-get-process vec1)) (not (equal (tramp-file-name-port vec1) (tramp-file-name-port vec2))) - (null (assoc "%y" (tramp-get-method-parameter vec1 'tramp-copy-args))) - (null (assoc "%y" (tramp-get-method-parameter vec2 'tramp-copy-args)))) + (null (assoc "%z" (tramp-get-method-parameter vec1 'tramp-copy-args))) + (null (assoc "%z" (tramp-get-method-parameter vec2 'tramp-copy-args)))) "") ((let ((case-fold-search t)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 34f256147b..fec4ea68ec 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -255,7 +255,9 @@ pair of the form (KEY VALUE). The following KEYs are defined: - \"%n\" expands to \"2>/dev/null\". - \"%x\" is replaced by the `tramp-scp-strict-file-name-checking' argument if it is supported. - - \"%y\" is replaced by the `tramp-scp-direct-remote-copying' + - \"%y\" is replaced by the `tramp-scp-force-scp-protocol' + argument if it is supported. + - \"%z\" is replaced by the `tramp-scp-direct-remote-copying' argument if it is supported. The existence of `tramp-login-args', combined with the commit e683b08b3fbbc1692e0053699c5cf2b7cbc803f6 Author: Michael Albinus Date: Sun May 8 11:43:19 2022 +0200 Handle changed scp protocol in Tramp, don't merge * lisp/net/tramp-sh.el (tramp-scp-force-scp-protocol): New defvar. (tramp-scp-force-scp-protocol): New defun. (tramp-do-copy-or-rename-file-out-of-band): Use it. (tramp-methods) : Use "%y". * lisp/net/tramp.el (tramp-methods): Adapt docstring. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 67f5519bbf..c4fbe4673b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -134,6 +134,15 @@ be auto-detected by Tramp. The string is used in `tramp-methods'.") +(defvar tramp-scp-force-scp-protocol nil + "Force scp protocol. + +It is the string \"-O\" if supported by the local scp (since +release 8.6), otherwise the string \"\". If it is nil, it will +be auto-detected by Tramp. + +The string is used in `tramp-methods'.") + ;; Initialize `tramp-methods' with the supported methods. ;;;###tramp-autoload (tramp--with-startup @@ -170,7 +179,7 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("%x") ("-q") ("-r") ("%c"))) + ("%x") ("%y") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -186,7 +195,7 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("%x") ("-q") ("-r") ("%c"))) + ("%x") ("%y") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -2311,7 +2320,8 @@ The method used must be an out-of-band method." ?h (or host "") ?u (or user "") ?p (or port "") ?r listener ?c options ?k (if keep-date " " "") ?n (concat "2>" (tramp-get-remote-null-device v)) - ?x (tramp-scp-strict-file-name-checking v)) + ?x (tramp-scp-strict-file-name-checking v) + ?y (tramp-scp-force-scp-protocol v)) copy-program (tramp-get-method-parameter v 'tramp-copy-program) copy-keep-date (tramp-get-method-parameter v 'tramp-copy-keep-date) @@ -4818,6 +4828,33 @@ Goes through the list `tramp-inline-compress-commands'." (setq tramp-scp-strict-file-name-checking "-T"))))))) tramp-scp-strict-file-name-checking))) +(defun tramp-scp-force-scp-protocol (vec) + "Return the force scp protocol argument of the local scp." + (cond + ;; No options to be computed. + ((null (assoc "%y" (tramp-get-method-parameter vec 'tramp-copy-args))) + "") + + ;; There is already a value to be used. + ((stringp tramp-scp-force-scp-protocol) + tramp-scp-force-scp-protocol) + + ;; Determine the options. + (t (setq tramp-scp-force-scp-protocol "") + (let ((case-fold-search t)) + (ignore-errors + (when (executable-find "scp") + (with-tramp-progress-reporter + vec 4 "Computing force scp protocol argument" + (with-temp-buffer + (tramp-call-process vec "scp" nil t nil "-O") + (goto-char (point-min)) + (unless + (search-forward-regexp + "\\(illegal\\|unknown\\) option -- O" nil t) + (setq tramp-scp-force-scp-protocol "-O"))))))) + tramp-scp-force-scp-protocol))) + (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8baf72464d..63ea8a283c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -255,6 +255,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: - \"%n\" expands to \"2>/dev/null\". - \"%x\" is replaced by the `tramp-scp-strict-file-name-checking' argument if it is supported. + - \"%y\" is replaced by the `tramp-scp-force-scp-protocol' + argument if it is supported. The existence of `tramp-login-args', combined with the absence of `tramp-copy-args', is an indication that the commit 1a988d9ff55c098ddee0c79afcccbdc63e7c680e Author: Po Lu Date: Sun May 8 14:33:34 2022 +0800 Improve handling of invisible cursor alloc failures * src/xterm.c (x_toggle_visible_pointer): Use Xfixes if cursor allocation really fails. This happens when the X server has a limit on the number of cursors that can be created. diff --git a/src/xterm.c b/src/xterm.c index 2fc4c559a9..a7f0f3d7ef 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9452,8 +9452,21 @@ x_toggle_visible_pointer (struct frame *f, bool invisible) if (dpyinfo->invisible_cursor == None) dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); +#ifndef HAVE_XFIXES if (dpyinfo->invisible_cursor == None) invisible = false; +#else + /* But if Xfixes is available, try using it instead. */ + if (x_probe_xfixes_extension (dpyinfo)) + { + dpyinfo->fixes_pointer_blanking = true; + xfixes_toggle_visible_pointer (f, invisible); + + return; + } + else + invisible = false; +#endif if (invisible) XDefineCursor (dpyinfo->display, FRAME_X_WINDOW (f), commit 144e9f9b6a376ec0349557ef10a6c133228cda26 Author: Po Lu Date: Sun May 8 14:27:13 2022 +0800 Fix file-based stipple on NS * src/image.c (image_create_bitmap_from_file) [HAVE_NS]: Fix loading XBM data from file. diff --git a/src/image.c b/src/image.c index f3b47f7ccc..6cd0aa48cf 100644 --- a/src/image.c +++ b/src/image.c @@ -611,7 +611,7 @@ image_create_bitmap_from_data (struct frame *f, char *bits, return id; } -#ifdef HAVE_HAIKU +#if defined HAVE_HAIKU || defined HAVE_NS static char *slurp_file (int, ptrdiff_t *); static Lisp_Object image_find_image_fd (Lisp_Object, int *); static bool xbm_read_bitmap_data (struct frame *, char *, char *, @@ -630,11 +630,36 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) #endif #ifdef HAVE_NS - ptrdiff_t id; - void *bitmap = ns_image_from_file (file); + ptrdiff_t id, size; + int fd, width, height, rc; + char *contents, *data; + void *bitmap; + + if (!STRINGP (image_find_image_fd (file, &fd))) + return -1; + + contents = slurp_file (fd, &size); + + if (!contents) + return -1; + + rc = xbm_read_bitmap_data (f, contents, contents + size, + &width, &height, &data, 0); + + if (!rc) + { + xfree (contents); + return -1; + } + + bitmap = ns_image_from_XBM (data, width, height, 0, 0); if (!bitmap) + { + xfree (contents); + xfree (data); return -1; + } id = image_allocate_bitmap_record (f); dpyinfo->bitmaps[id - 1].img = bitmap; @@ -643,6 +668,9 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) dpyinfo->bitmaps[id - 1].depth = 1; dpyinfo->bitmaps[id - 1].height = ns_image_width (bitmap); dpyinfo->bitmaps[id - 1].width = ns_image_height (bitmap); + + xfree (contents); + xfree (data); return id; #endif commit a85e30516e543081d0197b9975fa9ba143426b6f Author: Eli Zaretskii Date: Sun May 8 09:24:29 2022 +0300 Fix selection dialog display on MS-Windows * src/w32fns.c (w32_wnd_proc) : Update the frame from the back buffer when double-buffering is in effect and a selection dialog is open. (w32_dialog_in_progress): Indicate to 'w32_wnd_proc' that a selection dialog is open. (Bug#55208) diff --git a/src/w32fns.c b/src/w32fns.c index 0f25c1a594..e5becb5d64 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -247,6 +247,8 @@ static HWND w32_visible_system_caret_hwnd; static int w32_unicode_gui; +static bool w32_selection_dialog_open; + /* From w32menu.c */ int menubar_in_use = 0; @@ -4184,6 +4186,16 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) update_rect.left, update_rect.top, update_rect.right, update_rect.bottom)); #endif + /* Under double-buffering, update the frame from the back + buffer, to prevent a "ghost" of the selection dialog to + be left on display while the user selects in the dialog. */ + if (w32_selection_dialog_open + && !w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->paint_dc) + BitBlt (FRAME_OUTPUT_DATA (f)->paint_buffer_handle, + 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), + FRAME_OUTPUT_DATA (f)->paint_dc, 0, 0, SRCCOPY); + EndPaint (hwnd, &paintStruct); leave_crit (); @@ -7755,6 +7767,15 @@ w32_dialog_in_progress (Lisp_Object in_progress) { Lisp_Object frames, frame; + /* Indicate to w32_wnd_proc that the selection dialog is about to be + open (or was closed, if IN_PROGRESS is nil). */ + if (!w32_disable_double_buffering) + { + enter_crit (); + w32_selection_dialog_open = !NILP (in_progress); + leave_crit (); + } + /* Don't let frames in `above' z-group obscure dialog windows. */ FOR_EACH_FRAME (frames, frame) { commit 48c422e255095658ea8ff20a59a6d306910281c5 Author: Po Lu Date: Sun May 8 13:44:28 2022 +0800 Fix display of hollow box cursor on NS * src/nsterm.m (ns_draw_window_cursor): Fix verbatim translations from X. diff --git a/src/nsterm.m b/src/nsterm.m index fef7f0dc6c..8206203333 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3079,7 +3079,9 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. break; case HOLLOW_BOX_CURSOR: draw_phys_cursor_glyph (w, glyph_row, DRAW_NORMAL_TEXT); - [NSBezierPath strokeRect: r]; + + /* This works like it does in PostScript, not X Windows. */ + [NSBezierPath strokeRect: NSInsetRect (r, 0.5, 0.5)]; break; case HBAR_CURSOR: NSRectFill (r); commit 7474b55e2812ec11f55817429b5e8815710e5112 Author: Po Lu Date: Sun May 8 05:28:11 2022 +0000 Fix setting stipple via `set-face-stipple' * lisp/faces.el (face-valid-attribute-values): Return results for `:stipple' in correct format. diff --git a/lisp/faces.el b/lisp/faces.el index 395ea315ba..1ada05a7b8 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1203,7 +1203,8 @@ an integer value." 'integerp) (:stipple (and (memq (window-system frame) '(x ns pgtk haiku)) ; No stipple on w32 - (mapcar #'list + (mapcar (lambda (item) + (cons item item)) (apply #'nconc (mapcar (lambda (dir) (and (file-readable-p dir) commit 5eeca488b9a5f1cad328f9b031be588526a0ef1e Author: Po Lu Date: Sun May 8 05:09:24 2022 +0000 Implement stipples for stretch glyphs * src/haikuterm.c (haiku_draw_stipple_background): Accept new arguments for specifying the color explicitly. All callers changed. (haiku_draw_stretch_glyph_string): Draw stipple correctly. (haiku_draw_glyph_string): Handle stipple correctly when drawing neighbors. diff --git a/src/haikuterm.c b/src/haikuterm.c index 93af5c8e43..7c1115e027 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1026,7 +1026,10 @@ haiku_update_bitmap_rec (struct haiku_bitmap_record *rec, static void haiku_draw_stipple_background (struct glyph_string *s, struct face *face, - int x, int y, int width, int height) + int x, int y, int width, int height, + bool explicit_colors_p, + uint32 explicit_background, + uint32 explicit_foreground) { struct haiku_bitmap_record *rec; unsigned long foreground, background; @@ -1035,7 +1038,12 @@ haiku_draw_stipple_background (struct glyph_string *s, struct face *face, view = FRAME_HAIKU_VIEW (s->f); rec = haiku_get_bitmap_rec (s->f, s->face->stipple); - if (s->hl == DRAW_CURSOR) + if (explicit_colors_p) + { + background = explicit_background; + foreground = explicit_foreground; + } + else if (s->hl == DRAW_CURSOR) haiku_merge_cursor_foreground (s, &foreground, &background); else { @@ -1061,7 +1069,8 @@ haiku_draw_background_rect (struct glyph_string *s, struct face *face, if (!s->stippled_p) haiku_draw_plain_background (s, face, x, y, width, height); else - haiku_draw_stipple_background (s, face, x, y, width, height); + haiku_draw_stipple_background (s, face, x, y, width, height, + false, 0, 0); } static void @@ -1255,9 +1264,8 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s) static void haiku_draw_stretch_glyph_string (struct glyph_string *s) { - eassert (s->first_glyph->type == STRETCH_GLYPH); - struct face *face = s->face; + uint32_t bkg; if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p) { @@ -1305,9 +1313,11 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) int y = s->y; int w = background_width - width, h = s->height; + /* Draw stipples manually because we want the background + part of a stretch glyph to have a stipple even if the + cursor is visible on top. */ if (!face->stipple) { - uint32_t bkg; if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) haiku_mouse_face_colors (s, NULL, &bkg); else @@ -1316,6 +1326,16 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) BView_SetHighColor (view, bkg); BView_FillRectangle (view, x, y, w, h); } + else + { + if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) + haiku_mouse_face_colors (s, NULL, &bkg); + else + bkg = face->background; + + haiku_draw_stipple_background (s, s->face, x, y, w, h, + true, bkg, face->foreground); + } } } else if (!s->background_filled_p) @@ -1333,7 +1353,7 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) } if (background_width > 0) - haiku_draw_background_rect (s, s->face, s->y, + haiku_draw_background_rect (s, s->face, s->x, s->y, background_width, s->height); } s->background_filled_p = 1; @@ -1706,13 +1726,16 @@ haiku_draw_glyph_string (struct glyph_string *s) width += next->width, next = next->next) if (next->first_glyph->type != IMAGE_GLYPH) { - prepare_face_for_display (s->f, s->next->face); - haiku_start_clip (s->next); - haiku_clip_to_string (s->next); + prepare_face_for_display (s->f, next->face); + next->stippled_p + = next->hl != DRAW_CURSOR && next->face->stipple; + + haiku_start_clip (next); + haiku_clip_to_string (next); if (next->first_glyph->type != STRETCH_GLYPH) - haiku_maybe_draw_background (s->next, 1); + haiku_maybe_draw_background (next, true); else - haiku_draw_stretch_glyph_string (s->next); + haiku_draw_stretch_glyph_string (next); haiku_end_clip (s); } } commit b205d67f8c92593f8e170419d677a70e535a3a19 Author: Po Lu Date: Sun May 8 04:42:11 2022 +0000 Fully implement stipples for text on Haiku * src/haikufont.c (haikufont_draw): Use `haiku_draw_background_rect' instead. * src/haikuterm.c (haiku_draw_plain_background): Change arguments to accept rect manually. (haiku_get_bitmap): Delete function. (haiku_get_bitmap_rec): New function. (haiku_draw_stipple_background): Accept rect instead of box sizes. (haiku_draw_background_rect): New function. (haiku_maybe_draw_background): Use that instead. (haiku_draw_image_glyph_string): Add notice. (haiku_draw_glyph_string): Set `stippled_p' correctly. * src/haikuterm.h (struct haiku_bitmap_record): New fields for keeping track of stipple state. * src/image.c (image_create_bitmap_from_data) (image_create_bitmap_from_file, free_bitmap_record): Free and set them accordingly. diff --git a/src/haikufont.c b/src/haikufont.c index e0db086aa0..54f11c6e41 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -1084,8 +1084,8 @@ haikufont_draw (struct glyph_string *s, int from, int to, s->first_glyph->slice.glyphless.lower_yoff - s->first_glyph->slice.glyphless.upper_yoff; - BView_SetHighColor (view, background); - BView_FillRectangle (view, x, y - ascent, s->width, height); + haiku_draw_background_rect (s, s->face, x, y - ascent, + s->width, height); s->background_filled_p = 1; } diff --git a/src/haikuterm.c b/src/haikuterm.c index 46ea5f9027..93af5c8e43 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -971,10 +971,11 @@ haiku_draw_string_box (struct glyph_string *s) static void haiku_draw_plain_background (struct glyph_string *s, struct face *face, - int box_line_hwidth, int box_line_vwidth) + int x, int y, int width, int height) { void *view = FRAME_HAIKU_VIEW (s->f); unsigned long cursor_color; + if (s->hl == DRAW_CURSOR) { haiku_merge_cursor_foreground (s, NULL, &cursor_color); @@ -983,38 +984,86 @@ haiku_draw_plain_background (struct glyph_string *s, struct face *face, else BView_SetHighColor (view, face->background_defaulted_p ? FRAME_BACKGROUND_PIXEL (s->f) : - face->background); + face->background); - BView_FillRectangle (view, s->x, - s->y + box_line_hwidth, - s->background_width, - s->height - 2 * box_line_hwidth); + BView_FillRectangle (view, x, y, width, height); } -static void * -haiku_get_bitmap (struct frame *f, ptrdiff_t id) +static struct haiku_bitmap_record * +haiku_get_bitmap_rec (struct frame *f, ptrdiff_t id) { - return FRAME_DISPLAY_INFO (f)->bitmaps[id - 1].img; + return &FRAME_DISPLAY_INFO (f)->bitmaps[id - 1]; +} + +static void +haiku_update_bitmap_rec (struct haiku_bitmap_record *rec, + uint32_t new_foreground, + uint32_t new_background) +{ + char *bits; + int x, y, bytes_per_line; + + if (new_foreground == rec->stipple_foreground + && new_background == rec->stipple_background) + return; + + bits = rec->stipple_bits; + bytes_per_line = (rec->width + 7) / 8; + + for (y = 0; y < rec->height; y++) + { + for (x = 0; x < rec->width; x++) + haiku_put_pixel (rec->img, x, y, + ((bits[x / 8] >> (x % 8)) & 1 + ? new_foreground : new_background)); + + bits += bytes_per_line; + } + + rec->stipple_foreground = new_foreground; + rec->stipple_background = new_background; } static void haiku_draw_stipple_background (struct glyph_string *s, struct face *face, - int box_line_hwidth, int box_line_vwidth) + int x, int y, int width, int height) { + struct haiku_bitmap_record *rec; + unsigned long foreground, background; void *view; view = FRAME_HAIKU_VIEW (s->f); + rec = haiku_get_bitmap_rec (s->f, s->face->stipple); + + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, &foreground, &background); + else + { + foreground = s->face->foreground; + background = s->face->background; + } + + haiku_update_bitmap_rec (rec, foreground, background); + BView_StartClip (view); haiku_clip_to_string (s); - BView_ClipToRect (view, s->x, s->y + box_line_hwidth, - s->background_width, - s->height - 2 * box_line_hwidth); - BView_DrawBitmapTiled (view, haiku_get_bitmap (s->f, face->stipple), - 0, 0, -1, -1, 0, 0, FRAME_PIXEL_WIDTH (s->f), + BView_ClipToRect (view, x, y, width, height); + BView_DrawBitmapTiled (view, rec->img, 0, 0, -1, -1, + 0, 0, FRAME_PIXEL_WIDTH (s->f), FRAME_PIXEL_HEIGHT (s->f)); BView_EndClip (view); } +void +haiku_draw_background_rect (struct glyph_string *s, struct face *face, + int x, int y, int width, int height) +{ + if (!s->stippled_p) + haiku_draw_plain_background (s, face, x, y, width, height); + else + haiku_draw_stipple_background (s, face, x, y, width, height); +} + static void haiku_maybe_draw_background (struct glyph_string *s, int force_p) { @@ -1028,12 +1077,10 @@ haiku_maybe_draw_background (struct glyph_string *s, int force_p) || FONT_TOO_HIGH (s->font) || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) { - if (!face->stipple) - haiku_draw_plain_background (s, face, box_line_width, - box_vline_width); - else - haiku_draw_stipple_background (s, face, box_line_width, - box_vline_width); + haiku_draw_background_rect (s, s->face, s->x, s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_width); + s->background_filled_p = 1; } } @@ -1286,17 +1333,8 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) } if (background_width > 0) - { - void *view = FRAME_HAIKU_VIEW (s->f); - unsigned long bkg; - if (s->hl == DRAW_CURSOR) - haiku_merge_cursor_foreground (s, NULL, &bkg); - else - bkg = s->face->background; - - BView_SetHighColor (view, bkg); - BView_FillRectangle (view, x, s->y, background_width, s->height); - } + haiku_draw_background_rect (s, s->face, s->y, + background_width, s->height); } s->background_filled_p = 1; } @@ -1566,6 +1604,7 @@ haiku_draw_image_glyph_string (struct glyph_string *s) void *view = FRAME_HAIKU_VIEW (s->f); void *bitmap = s->img->pixmap; + /* TODO: implement stipples for images with masks. */ s->stippled_p = face->stipple != 0; BView_SetHighColor (view, face->background); @@ -1648,16 +1687,14 @@ haiku_draw_image_glyph_string (struct glyph_string *s) static void haiku_draw_glyph_string (struct glyph_string *s) { - void *view; + void *view = FRAME_HAIKU_VIEW (s->f);; + struct face *face = s->face; block_input (); - view = FRAME_HAIKU_VIEW (s->f); BView_draw_lock (view, false, 0, 0, 0, 0); prepare_face_for_display (s->f, s->face); - struct face *face = s->face; - if (face != s->face) - prepare_face_for_display (s->f, face); + s->stippled_p = s->hl != DRAW_CURSOR && face->stipple; if (s->next && s->right_overhang && !s->for_overlaps) { diff --git a/src/haikuterm.h b/src/haikuterm.h index 1bff03ae39..cc032d0389 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -52,6 +52,10 @@ struct haiku_bitmap_record char *file; int refcount; int height, width, depth; + + uint32_t stipple_foreground; + uint32_t stipple_background; + void *stipple_bits; }; struct haiku_display_info @@ -325,6 +329,9 @@ extern int haiku_load_image (struct frame *, struct image *, extern void syms_of_haikuimage (void); #endif +extern void haiku_draw_background_rect (struct glyph_string *, struct face *, + int, int, int, int); + #ifdef USE_BE_CAIRO extern cairo_t *haiku_begin_cr_clip (struct frame *, struct glyph_string *); diff --git a/src/image.c b/src/image.c index 757e125006..f3b47f7ccc 100644 --- a/src/image.c +++ b/src/image.c @@ -542,20 +542,24 @@ image_create_bitmap_from_data (struct frame *f, char *bits, #endif /* HAVE_PGTK */ #ifdef HAVE_HAIKU - void *bitmap; + void *bitmap, *stipple; int bytes_per_line, x, y; - bitmap = BBitmap_new (width, height, 1); + bitmap = BBitmap_new (width, height, false); if (!bitmap) return -1; bytes_per_line = (width + 7) / 8; + stipple = xmalloc (height * bytes_per_line); + memcpy (stipple, bits, height * bytes_per_line); for (y = 0; y < height; y++) { for (x = 0; x < width; x++) - PUT_PIXEL (bitmap, x, y, (bits[8] >> (x % 8)) & 1); + PUT_PIXEL (bitmap, x, y, ((bits[8] >> (x % 8)) & 1 + ? f->foreground_pixel + : f->background_pixel)); bits += bytes_per_line; } #endif @@ -577,6 +581,11 @@ image_create_bitmap_from_data (struct frame *f, char *bits, #ifdef HAVE_HAIKU dpyinfo->bitmaps[id - 1].img = bitmap; dpyinfo->bitmaps[id - 1].depth = 1; + dpyinfo->bitmaps[id - 1].stipple_bits = stipple; + dpyinfo->bitmaps[id - 1].stipple_foreground + = f->foreground_pixel & 0xffffffff; + dpyinfo->bitmaps[id - 1].stipple_background + = f->background_pixel & 0xffffffff; #endif dpyinfo->bitmaps[id - 1].file = NULL; @@ -731,7 +740,7 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) return -1; } - bitmap = BBitmap_new (width, height, 1); + bitmap = BBitmap_new (width, height, false); if (!bitmap) { @@ -748,6 +757,11 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; dpyinfo->bitmaps[id - 1].refcount = 1; + dpyinfo->bitmaps[id - 1].stipple_foreground + = f->foreground_pixel & 0xffffffff; + dpyinfo->bitmaps[id - 1].stipple_background + = f->background_pixel & 0xffffffff; + dpyinfo->bitmaps[id - 1].stipple_bits = data; bytes_per_line = (width + 7) / 8; tmp = data; @@ -755,13 +769,14 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) for (y = 0; y < height; y++) { for (x = 0; x < width; x++) - PUT_PIXEL (bitmap, x, y, (tmp[x / 8] >> (x % 8)) & 1); + PUT_PIXEL (bitmap, x, y, ((tmp[x / 8] >> (x % 8)) & 1 + ? f->foreground_pixel + : f->background_pixel)); tmp += bytes_per_line; } xfree (contents); - xfree (data); return id; #endif } @@ -796,6 +811,9 @@ free_bitmap_record (Display_Info *dpyinfo, Bitmap_Record *bm) #ifdef HAVE_HAIKU BBitmap_free (bm->img); + + if (bm->stipple_bits) + xfree (bm->stipple_bits); #endif if (bm->file) commit faa342c794dec66d6b77ccf550361d58455a4454 Author: Po Lu Date: Sun May 8 03:08:42 2022 +0000 Implement bitmap loading for faces on Haiku Stipples don't completely work yet. * lisp/faces.el (face-valid-attribute-values): Enable `:stipple' on Haiku. * src/haiku_draw_support.cc (BView_DrawBitmap) (BView_DrawBitmapWithEraseOp, BView_DrawMask): Don't push and pop states. (BView_DrawBitmapTiled): New function. * src/haiku_support.cc (BBitmap_import_mono_bits): Delete function. * src/haiku_support.h: Update prototypes. * src/haikuterm.c (get_string_resource): Fix coding style. (haiku_get_bitmap, haiku_draw_stipple_background): Implement partially. (haiku_set_scroll_bar_default_width) (haiku_set_scroll_bar_default_height, haiku_scroll_bar_create) (haiku_set_horizontal_scroll_bar, haiku_set_vertical_scroll_bar) (haiku_create_terminal, haiku_scroll_bar_remove): Fix coding style. * src/image.c (image_create_bitmap_from_data) (image_create_bitmap_from_file): Implement on Haiku. diff --git a/lisp/faces.el b/lisp/faces.el index 12a386c8f6..395ea315ba 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1202,7 +1202,7 @@ an integer value." (:height 'integerp) (:stipple - (and (memq (window-system frame) '(x ns pgtk)) ; No stipple on w32 or haiku + (and (memq (window-system frame) '(x ns pgtk haiku)) ; No stipple on w32 (mapcar #'list (apply #'nconc (mapcar (lambda (dir) diff --git a/src/haiku_draw_support.cc b/src/haiku_draw_support.cc index a8d46d000a..551af51d7c 100644 --- a/src/haiku_draw_support.cc +++ b/src/haiku_draw_support.cc @@ -285,11 +285,32 @@ BView_DrawBitmap (void *view, void *bitmap, int x, int y, BView *vw = get_view (view); BBitmap *bm = (BBitmap *) bitmap; - vw->PushState (); vw->SetDrawingMode (B_OP_OVER); vw->DrawBitmap (bm, BRect (x, y, x + width - 1, y + height - 1), BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); - vw->PopState (); + vw->SetDrawingMode (B_OP_COPY); +} + +void +BView_DrawBitmapTiled (void *view, void *bitmap, int x, int y, + int width, int height, int vx, int vy, + int vwidth, int vheight) +{ + BView *vw = get_view (view); + BBitmap *bm = (BBitmap *) bitmap; + BRect bounds = bm->Bounds (); + + if (width == -1) + width = BE_RECT_WIDTH (bounds); + + if (height == -1) + height = BE_RECT_HEIGHT (bounds); + + vw->SetDrawingMode (B_OP_OVER); + vw->DrawBitmap (bm, BRect (x, y, x + width - 1, y + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1), + B_TILE_BITMAP); + vw->SetDrawingMode (B_OP_COPY); } void @@ -300,17 +321,22 @@ BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x, BBitmap *bm = (BBitmap *) bitmap; BBitmap bc (bm->Bounds (), B_RGBA32); BRect rect (x, y, x + width - 1, y + height - 1); + uint32_t *bits; + size_t stride; + rgb_color low_color; + BRect bounds; if (bc.InitCheck () != B_OK || bc.ImportBits (bm) != B_OK) return; - uint32_t *bits = (uint32_t *) bc.Bits (); - size_t stride = bc.BytesPerRow (); + bits = (uint32_t *) bc.Bits (); + stride = bc.BytesPerRow (); if (bm->ColorSpace () == B_GRAY1) { - rgb_color low_color = vw->LowColor (); - BRect bounds = bc.Bounds (); + low_color = vw->LowColor (); + bounds = bc.Bounds (); + for (int y = 0; y < BE_RECT_HEIGHT (bounds); ++y) { for (int x = 0; x < BE_RECT_WIDTH (bounds); ++x) @@ -323,10 +349,11 @@ BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x, } } - vw->PushState (); - vw->SetDrawingMode (bm->ColorSpace () == B_GRAY1 ? B_OP_OVER : B_OP_ERASE); + vw->SetDrawingMode ((bm->ColorSpace () + == B_GRAY1) + ? B_OP_OVER : B_OP_ERASE); vw->DrawBitmap (&bc, rect); - vw->PopState (); + vw->SetDrawingMode (B_OP_COPY); } void @@ -357,6 +384,7 @@ BView_DrawMask (void *src, void *view, vw->SetDrawingMode (B_OP_OVER); vw->DrawBitmap (&bm, BRect (x, y, x + width - 1, y + height - 1), BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); + vw->SetDrawingMode (B_OP_COPY); } static BBitmap * diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 5dfb25d6dd..27a676dd31 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -3599,17 +3599,6 @@ BBitmap_import_fringe_bitmap (void *bitmap, unsigned short *bits, int wd, int h) } } -void -BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h) -{ - BBitmap *bmp = (BBitmap *) bitmap; - - if (wd % 8) - wd += 8 - (wd % 8); - - bmp->ImportBits (bits, wd / 8 * h, wd / 8, 0, B_GRAY1); -} - /* Make a scrollbar at X, Y known to the view VIEW. */ void BView_publish_scroll_bar (void *view, int x, int y, int width, int height) diff --git a/src/haiku_support.h b/src/haiku_support.h index 5ded9300d8..eaca7a9bad 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -541,6 +541,8 @@ extern void BView_DrawBitmap (void *, void *, int, int, int, int, int, int, extern void BView_DrawBitmapWithEraseOp (void *, void *, int, int, int, int); extern void BView_DrawMask (void *, void *, int, int, int, int, int, int, int, int, uint32_t); +extern void BView_DrawBitmapTiled (void *, void *, int, int, + int, int, int, int, int, int); extern void BView_resize_to (void *, int, int); extern void BView_set_view_cursor (void *, void *); @@ -570,9 +572,7 @@ extern void BView_invalidate (void *); extern void BView_draw_lock (void *, bool, int, int, int, int); extern void BView_invalidate_region (void *, int, int, int, int); extern void BView_draw_unlock (void *); - extern void BBitmap_import_fringe_bitmap (void *, unsigned short *, int, int); -extern void BBitmap_import_mono_bits (void *, void *, int, int); extern void haiku_font_pattern_free (struct haiku_font_pattern *); diff --git a/src/haikuterm.c b/src/haikuterm.c index f08fe68187..46ea5f9027 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -122,7 +122,8 @@ haiku_delete_terminal (struct terminal *terminal) } static const char * -get_string_resource (void *ignored, const char *name, const char *class) +haiku_get_string_resource (void *ignored, const char *name, + const char *class) { const char *native; @@ -990,10 +991,28 @@ haiku_draw_plain_background (struct glyph_string *s, struct face *face, s->height - 2 * box_line_hwidth); } +static void * +haiku_get_bitmap (struct frame *f, ptrdiff_t id) +{ + return FRAME_DISPLAY_INFO (f)->bitmaps[id - 1].img; +} + static void haiku_draw_stipple_background (struct glyph_string *s, struct face *face, int box_line_hwidth, int box_line_vwidth) { + void *view; + + view = FRAME_HAIKU_VIEW (s->f); + BView_StartClip (view); + haiku_clip_to_string (s); + BView_ClipToRect (view, s->x, s->y + box_line_hwidth, + s->background_width, + s->height - 2 * box_line_hwidth); + BView_DrawBitmapTiled (view, haiku_get_bitmap (s->f, face->stipple), + 0, 0, -1, -1, 0, 0, FRAME_PIXEL_WIDTH (s->f), + FRAME_PIXEL_HEIGHT (s->f)); + BView_EndClip (view); } static void @@ -2079,19 +2098,25 @@ haiku_draw_vertical_window_border (struct window *w, static void haiku_set_scroll_bar_default_width (struct frame *f) { - int unit = FRAME_COLUMN_WIDTH (f); - FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = BScrollBar_default_size (0) + 1; - FRAME_CONFIG_SCROLL_BAR_COLS (f) = - (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit; + int unit, size; + + unit = FRAME_COLUMN_WIDTH (f); + size = BScrollBar_default_size (0) + 1; + + FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = size; + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (size + unit - 1) / unit; } static void haiku_set_scroll_bar_default_height (struct frame *f) { - int height = FRAME_LINE_HEIGHT (f); - FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = BScrollBar_default_size (1) + 1; - FRAME_CONFIG_SCROLL_BAR_LINES (f) = - (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + height - 1) / height; + int height, size; + + height = FRAME_LINE_HEIGHT (f); + size = BScrollBar_default_size (true) + 1; + + FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = size; + FRAME_CONFIG_SCROLL_BAR_LINES (f) = (size + height - 1) / height; } static void @@ -2273,15 +2298,17 @@ static struct scroll_bar * haiku_scroll_bar_create (struct window *w, int left, int top, int width, int height, bool horizontal_p) { - struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct frame *f; Lisp_Object barobj; + struct scroll_bar *bar; + void *scroll_bar; + void *view; - void *sb = NULL; - void *vw = FRAME_HAIKU_VIEW (f); + f = XFRAME (WINDOW_FRAME (w)); + view = FRAME_HAIKU_VIEW (f); block_input (); - struct scroll_bar *bar - = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER); + bar = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER); XSETWINDOW (bar->window, w); bar->top = top; @@ -2294,15 +2321,14 @@ haiku_scroll_bar_create (struct window *w, int left, int top, bar->update = -1; bar->horizontal = horizontal_p; - sb = BScrollBar_make_for_view (vw, horizontal_p, - left, top, left + width - 1, - top + height - 1, bar); - - BView_publish_scroll_bar (vw, left, top, width, height); + scroll_bar = BScrollBar_make_for_view (view, horizontal_p, + left, top, left + width - 1, + top + height - 1, bar); + BView_publish_scroll_bar (view, left, top, width, height); bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; - bar->scroll_bar = sb; + bar->scroll_bar = scroll_bar; XSETVECTOR (barobj, bar); fset_scroll_bars (f, barobj); @@ -2316,18 +2342,20 @@ haiku_scroll_bar_create (struct window *w, int left, int top, static void haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int position) { - eassert (WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w)); Lisp_Object barobj; struct scroll_bar *bar; int top, height, left, width; int window_x, window_width; + void *view; + eassert (WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w)); /* Get window dimensions. */ window_box (w, ANY_AREA, &window_x, 0, &window_width, 0); left = window_x; width = window_width; top = WINDOW_SCROLL_BAR_AREA_Y (w); height = WINDOW_CONFIG_SCROLL_BAR_HEIGHT (w); + view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); block_input (); @@ -2342,15 +2370,15 @@ haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int p { bar = XSCROLL_BAR (w->horizontal_scroll_bar); - if (bar->left != left || bar->top != top || - bar->width != width || bar->height != height) + if (bar->left != left || bar->top != top + || bar->width != width || bar->height != height) { - void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); BView_forget_scroll_bar (view, bar->left, bar->top, bar->width, bar->height); BView_move_frame (bar->scroll_bar, left, top, left + width - 1, top + height - 1); BView_publish_scroll_bar (view, left, top, width, height); + bar->left = left; bar->top = top; bar->width = width; @@ -2367,14 +2395,15 @@ haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int p } static void -haiku_set_vertical_scroll_bar (struct window *w, - int portion, int whole, int position) +haiku_set_vertical_scroll_bar (struct window *w, int portion, int whole, int position) { - eassert (WINDOW_HAS_VERTICAL_SCROLL_BAR (w)); Lisp_Object barobj; struct scroll_bar *bar; int top, height, left, width; int window_y, window_height; + void *view; + + eassert (WINDOW_HAS_VERTICAL_SCROLL_BAR (w)); /* Get window dimensions. */ window_box (w, ANY_AREA, 0, &window_y, 0, &window_height); @@ -2384,8 +2413,10 @@ haiku_set_vertical_scroll_bar (struct window *w, /* Compute the left edge and the width of the scroll bar area. */ left = WINDOW_SCROLL_BAR_AREA_X (w); width = WINDOW_SCROLL_BAR_AREA_WIDTH (w); - block_input (); + view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); + + block_input (); if (NILP (w->vertical_scroll_bar)) { bar = haiku_scroll_bar_create (w, left, top, width, height, false); @@ -2396,15 +2427,15 @@ haiku_set_vertical_scroll_bar (struct window *w, { bar = XSCROLL_BAR (w->vertical_scroll_bar); - if (bar->left != left || bar->top != top || - bar->width != width || bar->height != height) + if (bar->left != left || bar->top != top + || bar->width != width || bar->height != height) { - void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); BView_forget_scroll_bar (view, bar->left, bar->top, bar->width, bar->height); BView_move_frame (bar->scroll_bar, left, top, left + width - 1, top + height - 1); BView_publish_scroll_bar (view, left, top, width, height); + bar->left = left; bar->top = top; bar->width = width; @@ -3880,7 +3911,7 @@ haiku_create_terminal (struct haiku_display_info *dpyinfo) terminal->frame_visible_invisible_hook = haiku_set_frame_visible_invisible; terminal->set_frame_offset_hook = haiku_set_offset; terminal->delete_terminal_hook = haiku_delete_terminal; - terminal->get_string_resource_hook = get_string_resource; + terminal->get_string_resource_hook = haiku_get_string_resource; terminal->set_new_font_hook = haiku_new_font; terminal->defined_color_hook = haiku_defined_color; terminal->set_window_size_hook = haiku_set_window_size; @@ -4089,9 +4120,15 @@ mark_haiku_display (void) void haiku_scroll_bar_remove (struct scroll_bar *bar) { + void *view; + struct frame *f; + + f = WINDOW_XFRAME (XWINDOW (bar->window)); + view = FRAME_HAIKU_VIEW (f); + block_input (); - void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (XWINDOW (bar->window))); - BView_forget_scroll_bar (view, bar->left, bar->top, bar->width, bar->height); + BView_forget_scroll_bar (view, bar->left, bar->top, + bar->width, bar->height); BScrollBar_delete (bar->scroll_bar); expose_frame (WINDOW_XFRAME (XWINDOW (bar->window)), bar->left, bar->top, bar->width, bar->height); @@ -4100,7 +4137,6 @@ haiku_scroll_bar_remove (struct scroll_bar *bar) wset_horizontal_scroll_bar (XWINDOW (bar->window), Qnil); else wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil); - unblock_input (); }; diff --git a/src/image.c b/src/image.c index e4b56e29cf..757e125006 100644 --- a/src/image.c +++ b/src/image.c @@ -542,12 +542,22 @@ image_create_bitmap_from_data (struct frame *f, char *bits, #endif /* HAVE_PGTK */ #ifdef HAVE_HAIKU - void *bitmap = BBitmap_new (width, height, 1); + void *bitmap; + int bytes_per_line, x, y; + + bitmap = BBitmap_new (width, height, 1); if (!bitmap) return -1; - BBitmap_import_mono_bits (bitmap, bits, width, height); + bytes_per_line = (width + 7) / 8; + + for (y = 0; y < height; y++) + { + for (x = 0; x < width; x++) + PUT_PIXEL (bitmap, x, y, (bits[8] >> (x % 8)) & 1); + bits += bytes_per_line; + } #endif id = image_allocate_bitmap_record (f); @@ -592,12 +602,19 @@ image_create_bitmap_from_data (struct frame *f, char *bits, return id; } +#ifdef HAVE_HAIKU +static char *slurp_file (int, ptrdiff_t *); +static Lisp_Object image_find_image_fd (Lisp_Object, int *); +static bool xbm_read_bitmap_data (struct frame *, char *, char *, + int *, int *, char **, bool); +#endif + /* Create bitmap from file FILE for frame F. */ ptrdiff_t image_create_bitmap_from_file (struct frame *f, Lisp_Object file) { -#if defined (HAVE_NTGUI) || defined (HAVE_HAIKU) +#if defined (HAVE_NTGUI) return -1; /* W32_TODO : bitmap support */ #else Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); @@ -610,7 +627,6 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) if (!bitmap) return -1; - id = image_allocate_bitmap_record (f); dpyinfo->bitmaps[id - 1].img = bitmap; dpyinfo->bitmaps[id - 1].refcount = 1; @@ -637,7 +653,6 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) dpyinfo->bitmaps[id - 1].img = bitmap; dpyinfo->bitmaps[id - 1].refcount = 1; dpyinfo->bitmaps[id - 1].file = xlispstrdup (file); - //dpyinfo->bitmaps[id - 1].depth = 1; dpyinfo->bitmaps[id - 1].height = gdk_pixbuf_get_width (bitmap); dpyinfo->bitmaps[id - 1].width = gdk_pixbuf_get_height (bitmap); dpyinfo->bitmaps[id - 1].pattern @@ -692,6 +707,63 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) return id; #endif /* HAVE_X_WINDOWS */ + +#ifdef HAVE_HAIKU + ptrdiff_t id, size; + int fd, width, height, rc, bytes_per_line, x, y; + char *contents, *data, *tmp; + void *bitmap; + + if (!STRINGP (image_find_image_fd (file, &fd))) + return -1; + + contents = slurp_file (fd, &size); + + if (!contents) + return -1; + + rc = xbm_read_bitmap_data (f, contents, contents + size, + &width, &height, &data, 0); + + if (!rc) + { + xfree (contents); + return -1; + } + + bitmap = BBitmap_new (width, height, 1); + + if (!bitmap) + { + xfree (contents); + xfree (data); + return -1; + } + + id = image_allocate_bitmap_record (f); + + dpyinfo->bitmaps[id - 1].img = bitmap; + dpyinfo->bitmaps[id - 1].depth = 1; + dpyinfo->bitmaps[id - 1].file = NULL; + dpyinfo->bitmaps[id - 1].height = height; + dpyinfo->bitmaps[id - 1].width = width; + dpyinfo->bitmaps[id - 1].refcount = 1; + + bytes_per_line = (width + 7) / 8; + tmp = data; + + for (y = 0; y < height; y++) + { + for (x = 0; x < width; x++) + PUT_PIXEL (bitmap, x, y, (tmp[x / 8] >> (x % 8)) & 1); + + tmp += bytes_per_line; + } + + xfree (contents); + xfree (data); + return id; +#endif } /* Free bitmap B. */ commit 672a296d3b353249ed829a7164c3db55ee204e47 Author: Po Lu Date: Sun May 8 09:06:40 2022 +0800 Use correct event structures to fetch time on XI2 * src/xterm.c (handle_one_xevent): Don't use generic `xi_event' to access the event time. diff --git a/src/xterm.c b/src/xterm.c index 848389ce96..2fc4c559a9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16807,7 +16807,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, ev.window = enter->event; ev.time = enter->time; - x_display_set_last_user_time (dpyinfo, xi_event->time); + x_display_set_last_user_time (dpyinfo, enter->time); #ifdef USE_MOTIF use_copy = true; @@ -16955,7 +16955,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, leave->deviceid, false); #endif - x_display_set_last_user_time (dpyinfo, xi_event->time); + x_display_set_last_user_time (dpyinfo, leave->time); #ifdef HAVE_XWIDGETS { @@ -17572,7 +17572,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { #ifndef USE_TOOLKIT_SCROLL_BARS struct scroll_bar *bar - = x_window_to_scroll_bar (xi_event->display, xev->event, 2); + = x_window_to_scroll_bar (dpyinfo->display, xev->event, 2); if (bar) x_scroll_bar_note_movement (bar, &ev); @@ -19149,7 +19149,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, device = xi_device_from_id (dpyinfo, pev->deviceid); source = xi_device_from_id (dpyinfo, pev->sourceid); - x_display_set_last_user_time (dpyinfo, xi_event->time); + x_display_set_last_user_time (dpyinfo, pev->time); if (!device) goto XI_OTHER; commit ca3e3c947192e97f2c494ac12a26ff0d259f0459 Author: Basil L. Contovounesios Date: Sat May 7 20:17:23 2022 +0300 ; Pacify some --without-x byte-compiler warnings. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 5f02087732..6396779d60 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -99,6 +99,7 @@ for more details on the structure of the associations.") "B_LINK_VISITED_COLOR" "B_LINK_ACTIVE_COLOR" "B_STATUS_BAR_COLOR" "B_SUCCESS_COLOR" "B_FAILURE_COLOR"]) +(defvar x-colors) ;; Also update `x-colors' to take that into account. (setq x-colors (append haiku-allowed-ui-colors x-colors)) diff --git a/test/src/image-tests.el b/test/src/image-tests.el index 3885981e0b..f710aadea7 100644 --- a/test/src/image-tests.el +++ b/test/src/image-tests.el @@ -53,6 +53,8 @@ ;;;; image-test-size +(declare-function image-size "image.c" (spec &optional pixels frame)) + (ert-deftest image-tests-image-size/gif () (image-skip-unless 'gif) (pcase (image-size (create-image (cdr (assq 'gif image-tests--images)))) @@ -126,6 +128,8 @@ ;;;; image-mask-p +(declare-function image-mask-p "image.c" (spec &optional frame)) + (ert-deftest image-tests-image-mask-p/gif () (image-skip-unless 'gif) (should-not (image-mask-p (create-image @@ -176,6 +180,8 @@ ;;;; image-metadata +(declare-function image-metadata "image.c" (spec &optional frame)) + ;; TODO: These tests could be expanded with files that actually ;; contain metadata. @@ -238,6 +244,7 @@ (ert-deftest image-tests-init-image-library () (skip-unless (fboundp 'init-image-library)) + (declare-function init-image-library "image.c" (type)) (should (init-image-library 'pbm)) ; built-in (should-not (init-image-library 'invalid-image-type))) commit 090d5f4446e89df4bc5ad9a043294b711493c7ac Author: Paul Eggert Date: Sat May 7 09:48:27 2022 -0700 * src/fns.c: Fix IDs in comments to match code. diff --git a/src/fns.c b/src/fns.c index 4673fde28c..2c206c62b2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4113,7 +4113,7 @@ hash_table_user_defined_call (ptrdiff_t nargs, Lisp_Object *args, return unbind_to (count, Ffuncall (nargs, args)); } -/* Ignore HT and compare KEY1 and KEY2 using 'eql'. +/* Ignore H and compare KEY1 and KEY2 using 'eql'. Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object @@ -4122,7 +4122,7 @@ cmpfn_eql (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) return Feql (key1, key2); } -/* Ignore HT and compare KEY1 and KEY2 using 'equal'. +/* Ignore H and compare KEY1 and KEY2 using 'equal'. Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object @@ -4132,7 +4132,7 @@ cmpfn_equal (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) } -/* Given HT, compare KEY1 and KEY2 using HT->user_cmp_function. +/* Given H, compare KEY1 and KEY2 using H->user_cmp_function. Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object @@ -4143,8 +4143,7 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, return hash_table_user_defined_call (ARRAYELTS (args), args, h); } -/* Ignore HT and return a hash code for KEY which uses 'eq' to compare - keys. */ +/* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */ static Lisp_Object hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) @@ -4154,7 +4153,7 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) return make_ufixnum (XHASH (key) ^ XTYPE (key)); } -/* Ignore HT and return a hash code for KEY which uses 'equal' to compare keys. +/* Ignore H and return a hash code for KEY which uses 'equal' to compare keys. The hash code is at most INTMASK. */ static Lisp_Object @@ -4163,7 +4162,7 @@ hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) return make_ufixnum (sxhash (key)); } -/* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys. +/* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. The hash code is at most INTMASK. */ static Lisp_Object @@ -4172,7 +4171,7 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) return (FLOATP (key) || BIGNUMP (key) ? hashfn_equal : hashfn_eq) (key, h); } -/* Given HT, return a hash code for KEY which uses a user-defined +/* Given H, return a hash code for KEY which uses a user-defined function to compare keys. */ Lisp_Object commit 97dd99c6f750021233baa90e0974378631d31b62 Author: Eli Zaretskii Date: Sat May 7 19:34:53 2022 +0300 Fix Bengali composition rules * lisp/language/indian.el (bengali-composable-pattern): Fix composition rules for U+09F0 and U+09FE. Patch from समीर सिंह Sameer Singh . (Bug#55303) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index a7205e28b6..ce46d32549 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -194,14 +194,15 @@ which used the Kaithi script are supported in this language environment.")) '(("a" . "\u0981") ; SIGN CANDRABINDU ("A" . "[\u0982\u0983]") ; SIGN ANUSVARA .. VISARGA ("V" . "[\u0985-\u0994\u09E0\u09E1]") ; independent vowel - ("C" . "[\u0995-\u09B9\u09DC-\u09DF\u09F1]") ; consonant + ("C" . "[\u0995-\u09B9\u09DC-\u09DF\u09F0\u09F1]") ; consonant ("B" . "[\u09AC\u09AF\u09B0\u09F0]") ; BA, YA, RA ("R" . "[\u09B0\u09F0]") ; RA ("n" . "\u09BC") ; NUKTA ("v" . "[\u09BE-\u09CC\u09D7\u09E2\u09E3]") ; vowel sign ("H" . "\u09CD") ; HALANT ("T" . "\u09CE") ; KHANDA TA - ("N" . "\u200C") ; ZWNJ + ("S" . "\u09FE") ; SANDHI MARK + ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ ("X" . "[\u0980-\u09FF]")))) ; all coverage (indian-compose-regexp @@ -209,7 +210,7 @@ which used the Kaithi script are supported in this language environment.")) ;; syllables with an independent vowel, or "\\(?:RH\\)?Vn?\\(?:J?HB\\)?v*n?a?A?\\|" ;; consonant-based syllables, or - "Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*[NJ]?v?a?A?\\)\\|" + "Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*[NJ]?v?a?A?S?\\)\\|" ;; another syllables with an independent vowel, or "\\(?:RH\\)?T\\|" ;; special consonant form, or commit fc0bd6057c676b9945aa739dd9365a350ca5acef Author: Lars Ingebrigtsen Date: Sat May 7 18:21:29 2022 +0200 Make 'delete-process' into a command * doc/lispref/processes.texi (Deleting Processes): Document missing PROCESS value. * src/process.c (Fdelete_process): Allow calling interactively (bug#10107). diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 18f446735b..668a577870 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1011,16 +1011,18 @@ terminated (due to calling @code{exit} or to a signal). If it is they exit. @end defopt -@defun delete-process process +@defun delete-process &optional process This function deletes a process, killing it with a @code{SIGKILL} signal if the process was running a program. The argument may be a process, the name of a process, a buffer, or the name of a buffer. (A buffer or buffer-name stands for the process that -@code{get-buffer-process} returns.) Calling @code{delete-process} on -a running process terminates it, updates the process status, and runs -the sentinel immediately. If the process has already terminated, -calling @code{delete-process} has no effect on its status, or on the -running of its sentinel (which will happen sooner or later). +@code{get-buffer-process} returns, and a missing or @code{nil} +@var{process} means that the current buffer's process should be +killed.) Calling @code{delete-process} on a running process +terminates it, updates the process status, and runs the sentinel +immediately. If the process has already terminated, calling +@code{delete-process} has no effect on its status, or on the running +of its sentinel (which will happen sooner or later). If the process object represents a network, serial, or pipe connection, its status changes to @code{closed}; otherwise, it changes diff --git a/etc/NEWS b/etc/NEWS index 6a60231b3a..ee7a127af0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -248,6 +248,13 @@ removed some time after that. * Changes in Emacs 29.1 +--- +** 'delete-process' is now a command. +When called interactively, it will kill the process running in the +current buffer (if any). This can be useful if you have runaway +output in the current buffer (from a process or a network connection), +and want to stop it. + +++ ** New command 'restart-emacs'. This is like 'save-buffers-kill-emacs', but instead of just killing diff --git a/src/process.c b/src/process.c index 08a02ad942..2f8863aef2 100644 --- a/src/process.c +++ b/src/process.c @@ -1071,13 +1071,24 @@ record_deleted_pid (pid_t pid, Lisp_Object filename) } -DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, +DEFUN ("delete-process", Fdelete_process, Sdelete_process, 0, 1, + "(list 'message)", doc: /* Delete PROCESS: kill it and forget about it immediately. PROCESS may be a process, a buffer, the name of a process or buffer, or -nil, indicating the current buffer's process. */) +nil, indicating the current buffer's process. + +Interactively, it will kill the current buffer's process. */) (register Lisp_Object process) { register struct Lisp_Process *p; + bool mess = false; + + /* We use this to see whether we were called interactively. */ + if (EQ (process, Qmessage)) + { + mess = true; + process = Qnil; + } process = get_process (process); p = XPROCESS (process); @@ -1131,6 +1142,8 @@ nil, indicating the current buffer's process. */) } } remove_process (process); + if (mess) + message ("Deleted process"); return Qnil; } @@ -8637,6 +8650,7 @@ sentinel or a process filter function has an error. */); DEFSYM (Qnull, "null"); DEFSYM (Qpipe_process_p, "pipe-process-p"); + DEFSYM (Qmessage, "message"); defsubr (&Sprocessp); defsubr (&Sget_process); commit 2e461ab2dcb407c868a38d833f38815c17a28c5a Author: Eli Zaretskii Date: Sat May 7 18:10:42 2022 +0300 ; Fix last change of Devanagari composition rules. diff --git a/lisp/language/indian.el b/lisp/language/indian.el index b240403b0a..a7205e28b6 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -183,7 +183,7 @@ which used the Kaithi script are supported in this language environment.")) ;; special consonant form, or "JHR\\|" ;; vedic accents with numerals, or - "1ss\\|3ss\\|s3ss\\|" + "1ss?\\|3ss\\|s3ss\\|" ;; any other singleton characters "X") table)) commit e59c42950f622b0e3b463cb8e37f504f6b347843 Author: Eli Zaretskii Date: Sat May 7 17:54:19 2022 +0300 Improve Devanagari character composition rules * lisp/language/indian.el (devanagari-composable-pattern): Add rules for Vedic accents. Suggested by Madhu . diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 0031405182..b240403b0a 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -169,6 +169,8 @@ which used the Kaithi script are supported in this language environment.")) ("H" . "\u094D") ; HALANT ("s" . "[\u0951\u0952]") ; stress sign ("t" . "[\u0953\u0954]") ; accent + ("1" . "\u0967") ; numeral 1 + ("3" . "\u0969") ; numeral 3 ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ ("X" . "[\u0900-\u097F]")))) ; all coverage @@ -180,6 +182,8 @@ which used the Kaithi script are supported in this language environment.")) "Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*n?a?s?t?A?\\)\\|" ;; special consonant form, or "JHR\\|" + ;; vedic accents with numerals, or + "1ss\\|3ss\\|s3ss\\|" ;; any other singleton characters "X") table)) commit 19d1b9275e7565fb67fd9e0587f08837ba8a3220 Author: Stefan Monnier Date: Sat May 7 10:21:26 2022 -0400 (dabbrev-completion): Fix bug#45768 Make `dabbrev-completion` go through `completion-at-point` so that it interacts correctly with Icomplete. Export a new `completion-capf` function while we're at it, since it can be useful elsewhere. * lisp/dabbrev.el (dabbrev-capf): New function, extracted from `dabbrev-completion`. (dabbrev-completion): Use it. diff --git a/etc/NEWS b/etc/NEWS index 671c30772e..6a60231b3a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -742,6 +742,9 @@ this script. ** dabbrev +--- +*** New function 'dabbrev-capf' for use on 'completion-at-point-functions' + +++ *** New user option 'dabbrev-ignored-buffer-modes'. Buffers with major modes in this list will be ignored. By default, diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 06a8ead834..b04128cf67 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -392,6 +392,14 @@ If the prefix argument is 16 (which comes from \\[universal-argument] \\[univers then it searches *all* buffers." (interactive "*P") (dabbrev--reset-global-variables) + (setq dabbrev--check-other-buffers (and arg t)) + (setq dabbrev--check-all-buffers + (and arg (= (prefix-numeric-value arg) 16))) + (let ((completion-at-point-functions '(dabbrev-capf))) + (completion-at-point))) + +(defun dabbrev-capf () + "Dabbrev completion function for `completion-at-point-functions'." (let* ((abbrev (dabbrev--abbrev-at-point)) (beg (progn (search-backward abbrev) (point))) (end (progn (search-forward abbrev) (point))) @@ -429,10 +437,7 @@ then it searches *all* buffers." (t (mapcar #'downcase completion-list))))))) (complete-with-action a list s p))))) - (setq dabbrev--check-other-buffers (and arg t)) - (setq dabbrev--check-all-buffers - (and arg (= (prefix-numeric-value arg) 16))) - (completion-in-region beg end table))) + (list beg end table))) ;;;###autoload (defun dabbrev-expand (arg) commit 7e97b33aa62c39111f33a94c487f0a174d06346d Author: Po Lu Date: Sat May 7 13:38:42 2022 +0000 Clean up some variables in the Haiku code * src/haikuterm.c: Add comments to some variables and clean up initializers. * src/haikuterm.h (haiku_frame_param_handlers): Move here instead. diff --git a/src/haikuterm.c b/src/haikuterm.c index ced16d9f09..f08fe68187 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -43,17 +43,24 @@ along with GNU Emacs. If not, see . */ /* Minimum and maximum values used for Haiku scroll bars. */ #define BE_SB_MAX 12000000 -struct haiku_display_info *x_display_list = NULL; -extern frame_parm_handler haiku_frame_parm_handlers[]; +/* The single Haiku display (if any). */ +struct haiku_display_info *x_display_list; /* This is used to determine when to evict the font lookup cache, which we do every 50 updates. */ static int up_to_date_count; +/* List of defined fringe bitmaps. */ static void **fringe_bmps; -static int max_fringe_bmp = 0; +/* The amount of fringe bitmaps in that list. */ +static int max_fringe_bmp; + +/* Alist of resources to their values. */ static Lisp_Object rdb; + +/* Non-zero means that a HELP_EVENT has been generated since Emacs + start. */ static bool any_help_event_p; char * diff --git a/src/haikuterm.h b/src/haikuterm.h index 30b474b1e1..1bff03ae39 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -205,6 +205,8 @@ extern struct font_driver const haikufont_driver; extern Lisp_Object tip_frame; extern struct frame *haiku_dnd_frame; +extern frame_parm_handler haiku_frame_parm_handlers[]; + struct scroll_bar { /* These fields are shared by all vectors. */ commit 987a212eb17b32cabcf46640417768bcccb2be5e Author: समीर सिंह Sameer Singh Date: Sat May 7 17:55:25 2022 +0530 Add support for the Kaithi script * lisp/language/indian.el ("Kaithi"): New language environment. Add composition rules for Kaithi. Add sample text and input method. * lisp/international/fontset.el (script-representative-chars) (setup-default-fontset): Support Kaithi. * lisp/leim/quail/indian.el ("kaithi"): New input method. * etc/HELLO: Add a Kaithi greeting. * etc/NEWS: Announce the new language environment and its input method. diff --git a/etc/HELLO b/etc/HELLO index dbbcc0493b..ac0cb823ea 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -59,6 +59,8 @@ Hindi (हिंदी) नमस्ते / नमस्कार । Inuktitut (ᐃᓄᒃᑎᑐᑦ) ᐊᐃ Italian (italiano) Ciao / Buon giorno Javanese (ꦧꦱꦗꦮꦶ) console.log("ꦲꦭꦺꦴ"); + +Kaithi (𑂍𑂶𑂟𑂲) 𑂩𑂰𑂧𑂩𑂰𑂧 Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ Khmer (ភាសាខ្មែរ) ជំរាបសួរ Lakota (Lakȟotiyapi) Taŋyáŋ yahí! diff --git a/etc/NEWS b/etc/NEWS index de3f093864..671c30772e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -731,6 +731,12 @@ This language environment supports Brahmi, which is a historical script that was used in ancient South Asia. A new input method, 'brahmi', is provided to type text in this script. +*** New language environment "Kaithi". +This language environment supports Kaithi or Kayasthi, which was +an important writing system of the past mainly used for administrative +purposes. A new input method, 'kaithi', is provided to type text in +this script. + * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 883f08905e..66f5068cf7 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -232,6 +232,7 @@ (elymaic #x10FE0) (old-uyghur #x10F70) (brahmi #x11013 #x11045 #x11052 #x11065) + (kaithi #x1108D #x110B0 #x110BD) (mahajani #x11150) (khojki #x11200) (khudawadi #x112B0) @@ -772,6 +773,7 @@ elymaic old-uyghur brahmi + kaithi makasar dives-akuru cuneiform diff --git a/lisp/language/indian.el b/lisp/language/indian.el index c3d59b6f77..0031405182 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -136,6 +136,17 @@ South Indian language Malayalam is supported in this language environment.")) The ancient Brahmi script is supported in this language environment.")) '("Indian")) ; Should we have an "Old" category? +(set-language-info-alist + "Kaithi" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "kaithi") + (sample-text . "Kaithi (𑂍𑂶𑂟𑂲) 𑂩𑂰𑂧𑂩𑂰𑂧") + (documentation . "\ +Languages such as Awadhi, Bhojpuri, Magahi and Maithili +which used the Kaithi script are supported in this language environment.")) + '("Indian")) + ;; Replace mnemonic characters in REGEXP according to TABLE. TABLE is ;; an alist of (MNEMONIC-STRING . REPLACEMENT-STRING). @@ -421,6 +432,33 @@ The ancient Brahmi script is supported in this language environment.")) (concat multiplier number-joiner numeral) 1 'font-shape-gstring)))) +;; Kaithi composition rules +(let ((consonant "[\x1108D-\x110AF]") + (nukta "\x110BA") + (vowel "[\x1108D-\x110C2]") + (anusvara-candrabindu "[\x11080\x11081]") + (virama "\x110B9") + (number-sign "\x110BD") + (number-sign-above "\x110CD") + (numerals "[\x966-\x96F]+") + (zwj "\x200D")) + (set-char-table-range composition-function-table + '(#x110B0 . #x110BA) + (list (vector + (concat consonant nukta "?\\(?:" virama zwj "?" consonant nukta "?\\)*\\(?:" + virama zwj "?\\|" vowel "*" nukta "?" anusvara-candrabindu "?\\)") + 1 'font-shape-gstring))) + (set-char-table-range composition-function-table + '(#x110BD . #x110BD) + (list (vector + (concat number-sign numerals) + 0 'font-shape-gstring))) + (set-char-table-range composition-function-table + '(#x110CD . #x110CD) + (list (vector + (concat number-sign-above numerals) + 0 'font-shape-gstring)))) + (provide 'indian) ;;; indian.el ends here diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index f2d5f9bad4..a52d44bc08 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -835,5 +835,106 @@ Full key sequences are listed below:") ("`/" ?𑁿) ) +(quail-define-package + "kaithi" "Kaithi" "𑂍𑂶" t "Kaithi phonetic input method. + + `\\=`' is used to switch levels instead of Alt-Gr. +" nil t t t t nil nil nil nil nil t) + +(quail-define-rules +("``" ?₹) +("1" ?१) +("`1" ?1) +("2" ?२) +("`2" ?2) +("3" ?३) +("`3" ?3) +("4" ?४) +("`4" ?4) +("5" ?५) +("`5" ?5) +("6" ?६) +("`6" ?6) +("7" ?७) +("`7" ?7) +("8" ?८) +("`8" ?8) +("9" ?९) +("0" ?०) +("`0" ?0) +("`\)" ?𑂻) +("`\\" ?𑃀) +("`|" ?𑃁) +("`" ?𑂗) +("q" ?𑂗) +("Q" ?𑂘) +("w" ?𑂙) +("W" ?𑂛) +("`w" ?𑂚) +("`W" ?𑂜) +("e" ?𑂵) +("E" ?𑂶) +("`e" ?𑂉) +("`E" ?𑂊) +("r" ?𑂩) +("R" ?𑃂) +("t" ?𑂞) +("T" ?𑂟) +("y" ?𑂨) +("Y" ?⸱) +("u" ?𑂳) +("U" ?𑂴) +("`u" ?𑂇) +("`U" ?𑂈) +("i" ?𑂱) +("I" ?𑂲) +("`i" ?𑂅) +("`I" ?𑂆) +("o" ?𑂷) +("O" ?𑂸) +("`o" ?𑂋) +("`O" ?𑂌) +("p" ?𑂣) +("P" ?𑂤) +("a" ?𑂰) +("A" ?𑂄) +("`a" ?𑂃) +("s" ?𑂮) +("S" ?𑂬) +("d" ?𑂠) +("D" ?𑂡) +("`d" ?𑂼) +("`D" #x110BD) ; Kaithi Number Sign +("f" ?𑂹) +("F" #x110CD) ; Kaithi Number Sign Above +("`f" ?𑂾) +("`F" ?𑂿) +("g" ?𑂏) +("G" ?𑂐) +("h" ?𑂯) +("H" ?𑂂) +("j" ?𑂔) +("J" ?𑂕) +("k" ?𑂍) +("K" ?𑂎) +("l" ?𑂪) +("z" ?𑂖) +("Z" ?𑂑) +("x" ?𑂭) +("X" ?𑂺) +("c" ?𑂒) +("C" ?𑂓) +("`c" #x200C) ; ZWNJ +("`C" #x200D) ; ZWJ +("v" ?𑂫) +("b" ?𑂥) +("B" ?𑂦) +("n" ?𑂢) +("N" ?𑂝) +("m" ?𑂧) +("M" ?𑂁) +("`m" ?𑂀) +) + ;;; indian.el ends here commit f7c56a0d739d1397b5fb2b1beeeea6b74a1d5886 Author: Lars Ingebrigtsen Date: Sat May 7 15:05:45 2022 +0200 Explain better what the interactive prefix does in scroll-down/up * lisp/window.el (scroll-up-command, scroll-down-command): * lisp/image-mode.el (image-scroll-up, image-scroll-down): Actually explain what the interactive prefix does (bug#44503). diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 721f2f2bbd..ea5d7ff0f3 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -282,10 +282,17 @@ Stop if the top edge of the image is reached." (defun image-scroll-up (&optional n) "Scroll image in current window upward by N lines. Stop if the bottom edge of the image is reached. -If ARG is omitted or nil, scroll upward by a near full screen. + +Interactively, giving this command a numerical prefix will scroll +up by that many lines (and down by that many lines if the number +is negative). Without a prefix, scroll up by a full screen. +If given a `C-u -' prefix, scroll a full page down instead. + +If N is omitted or nil, scroll upward by a near full screen. A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. -If ARG is the atom `-', scroll downward by nearly full screen. +A negative N means scroll downward. + +If N is the atom `-', scroll downward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." (interactive "P") (cond ((null n) @@ -303,10 +310,17 @@ When calling from a program, supply as argument a number, nil, or `-'." (defun image-scroll-down (&optional n) "Scroll image in current window downward by N lines. Stop if the top edge of the image is reached. -If ARG is omitted or nil, scroll downward by a near full screen. + +Interactively, giving this command a numerical prefix will scroll +down by that many lines (and up by that many lines if the number +is negative). Without a prefix, scroll down by a full screen. +If given a `C-u -' prefix, scroll a full page up instead. + +If N is omitted or nil, scroll downward by a near full screen. A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll upward. -If ARG is the atom `-', scroll upward by nearly full screen. +A negative N means scroll upward. + +If N is the atom `-', scroll upward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." (interactive "P") (cond ((null n) diff --git a/lisp/window.el b/lisp/window.el index 9f78784612..52003f7b7b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10031,6 +10031,11 @@ When point is already on that position, then signal an error." (defun scroll-up-command (&optional arg) "Scroll text of selected window upward ARG lines; or near full screen if no ARG. +Interactively, giving this command a numerical prefix will scroll +up by that many lines (and down by that many lines if the number +is negative). Without a prefix, scroll up by a full screen. +If given a `C-u -' prefix, scroll a full page down instead. + If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot scroll window further, move cursor to the bottom line. When point is already on that position, then signal an error. @@ -10063,6 +10068,11 @@ If ARG is the atom `-', scroll downward by nearly full screen." (defun scroll-down-command (&optional arg) "Scroll text of selected window down ARG lines; or near full screen if no ARG. +Interactively, giving this command a numerical prefix will scroll +down by that many lines (and up by that many lines if the number +is negative). Without a prefix, scroll down by a full screen. +If given a `C-u -' prefix, scroll a full page up instead. + If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot scroll window further, move cursor to the top line. When point is already on that position, then signal an error. commit 5ac6af4e886e630e039d282bb6f3965d7367c461 Author: Lars Ingebrigtsen Date: Sat May 7 14:42:18 2022 +0200 Document the `x' DWIM action in the manual * doc/emacs/package.texi (Package Menu): Mention the DWIM action of the `x' command. diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index bd3ae2aa6a..fc2a093ec4 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -89,6 +89,11 @@ list of available packages from package archive servers. If the network is unavailable, it falls back on the most recently retrieved list. +The main command to use in the package list buffer is the @key{x} +command. If the package under point isn't installed already, this +command will install it. If the package under point is already +installed, this command will delete it. + The following commands are available in the package menu: @table @kbd @@ -162,7 +167,10 @@ installed versions (marked with status @samp{obsolete}). @findex package-menu-execute Download and install all packages marked with @kbd{i}, and their dependencies; also, delete all packages marked with @kbd{d} -(@code{package-menu-execute}). This also removes the marks. +(@code{package-menu-execute}). This also removes the marks. If no +packages are marked, this command will install the package under point +(if it isn't installed already), or delete the package under point (if +it's already installed). @item g @item r diff --git a/etc/NEWS b/etc/NEWS index 5dd87e3e9e..de3f093864 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -748,6 +748,7 @@ this includes "binary" buffers like 'archive-mode' and 'image-mode'. This command allows you to upgrade packages without using 'M-x list-packages'. ++++ *** New DWIM action on 'x'. If no packages are marked, 'x' will install the package under point if it isn't already, and remove it if it is installed. commit c2a84365d8c24ad2ebbb95ac8526c279aefa678c Author: Lars Ingebrigtsen Date: Sat May 7 14:35:15 2022 +0200 Remove tar-mode dabbrev-ignored-buffer-modes * lisp/dabbrev.el (dabbrev-ignored-buffer-modes): Remove tar-mode from the default, because it isn't really a binary mode. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index adbfca01a3..06a8ead834 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -239,8 +239,7 @@ See also `dabbrev-ignored-buffer-names' and :group 'dabbrev :version "21.1") -(defcustom dabbrev-ignored-buffer-modes - '(archive-mode image-mode tar-mode) +(defcustom dabbrev-ignored-buffer-modes '(archive-mode image-mode) "Inhibit looking for abbreviations in buffers derived from these modes. See also `dabbrev-ignored-buffer-names' and `dabbrev-ignored-buffer-regexps'." commit c56070beb6cb7bc383c7f39215c915e1f43fd578 Author: Lars Ingebrigtsen Date: Sat May 7 14:31:42 2022 +0200 Make `x' in package-menu-mode more DWIM * lisp/emacs-lisp/package.el (package-menu-mode): Make the doc string more helpful. (package-menu-execute): Make `x' when no files are installed DWIM. diff --git a/etc/NEWS b/etc/NEWS index 2e7a1d8638..5dd87e3e9e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -748,6 +748,10 @@ this includes "binary" buffers like 'archive-mode' and 'image-mode'. This command allows you to upgrade packages without using 'M-x list-packages'. +*** New DWIM action on 'x'. +If no packages are marked, 'x' will install the package under point if +it isn't already, and remove it if it is installed. + ** Miscellaneous +++ diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 58c1349e1c..c1e14a4acb 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2885,7 +2885,13 @@ either a full name or nil, and EMAIL is a valid email address." (define-derived-mode package-menu-mode tabulated-list-mode "Package Menu" "Major mode for browsing a list of packages. -Letters do not insert themselves; instead, they are commands. +The most useful commands here are: + + `x': Install the package under point if it isn't already installed, + and delete it if it's already installed, + `i': mark a package for installation, and + `d': mark a package for deletion. Use the `x' command to perform the + actions on the marked files. \\ \\{package-menu-mode-map}" :interactive nil @@ -3632,8 +3638,13 @@ packages list, respectively." (defun package-menu-execute (&optional noquery) "Perform marked Package Menu actions. Packages marked for installation are downloaded and installed, -packages marked for deletion are removed, -and packages marked for upgrading are downloaded and upgraded. +packages marked for deletion are removed, and packages marked for +upgrading are downloaded and upgraded. + +If no packages are marked, the action taken depends on the state +of the package under point. If it's not already installed, this +command will install the package, and if it's installed, it will +delete the package. Optional argument NOQUERY non-nil means do not ask the user to confirm." (interactive nil package-menu-mode) @@ -3651,8 +3662,20 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." ((eq cmd ?I) (push pkg-desc install-list)))) (forward-line))) + ;; Nothing marked. (unless (or delete-list install-list) - (user-error "No operations specified")) + ;; Not on a package line. + (unless (tabulated-list-get-id) + (user-error "No operations specified")) + (let* ((id (tabulated-list-get-id)) + (status (package-menu-get-status))) + (cond + ((member status '("installed")) + (push id delete-list)) + ((member status '("available" "avail-obso" "new" "dependency")) + (push id install-list)) + (t (user-error "No default action available for status: %s" + status))))) (let-alist (package-menu--partition-transaction install-list delete-list) (when (or noquery (package-menu--prompt-transaction-p .delete .install .upgrade)) commit ccec59f2b2c5344b10fa4b006bb5dc1c59555fb1 Author: Lars Ingebrigtsen Date: Sat May 7 13:56:19 2022 +0200 Improve inferior-python-mode scroll behaviour * lisp/progmodes/python.el (inferior-python-mode): Use scroll-convervatively instead of trying to do this with a comint filter (which produces flickering) (bug#31115). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 11ed732d28..825e94572a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2646,6 +2646,7 @@ banner and the initial prompt are received separately." (defun python-comint-postoutput-scroll-to-bottom (output) "Faster version of `comint-postoutput-scroll-to-bottom'. Avoids `recenter' calls until OUTPUT is completely sent." + (declare (obsolete nil "29.1")) ; Not used. (when (and (not (string= "" output)) (python-shell-comint-end-of-output-p (ansi-color-filter-apply output))) @@ -2951,11 +2952,11 @@ variable. (setq-local comint-output-filter-functions '(ansi-color-process-output python-shell-comint-watch-for-first-prompt-output-filter - python-comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)) (setq-local comint-highlight-input nil) (setq-local compilation-error-regexp-alist python-shell-compilation-regexp-alist) + (setq-local scroll-conservatively 1) (add-hook 'completion-at-point-functions #'python-shell-completion-at-point nil 'local) (define-key inferior-python-mode-map "\t" commit 7952dcc23363b18f74203124d023b063bef359cf Author: Lars Ingebrigtsen Date: Sat May 7 13:45:35 2022 +0200 Fix compilation warnings in newer subr tests * test/lisp/subr-tests.el (test-local-set-state): Fix compilation warnings. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 8f3ee66e00..89803e5ce2 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1058,20 +1058,21 @@ final or penultimate step during initialization.")) (should (equal (kbd "C-x ( C-d C-x )") "")) (should (equal (kbd "C-x ( C-x )") ""))) +(defvar subr-test--global) (ert-deftest test-local-set-state () - (setq global 1) + (setq subr-test--global 1) (with-temp-buffer - (setq-local local 2) - (let ((state (buffer-local-set-state global 10 - local 20 - unexist 30))) - (should (= global 10)) - (should (= local 20)) - (should (= unexist 30)) + (setq-local subr-test--local 2) + (let ((state (buffer-local-set-state subr-test--global 10 + subr-test--local 20 + subr-test--unexist 30))) + (should (= subr-test--global 10)) + (should (= subr-test--local 20)) + (should (= subr-test--unexist 30)) (buffer-local-restore-state state) - (should (= global 1)) - (should (= local 2)) - (should-not (boundp 'unexist))))) + (should (= subr-test--global 1)) + (should (= subr-test--local 2)) + (should-not (boundp 'subr-test--unexist))))) (provide 'subr-tests) ;;; subr-tests.el ends here commit 8df69384f3951356dfb539e2cf72d905f82d00ae Author: Lars Ingebrigtsen Date: Sat May 7 13:19:49 2022 +0200 Allow dabbrev to ignore binary buffers * doc/emacs/abbrevs.texi (Dynamic Abbrevs): Document it. * lisp/dabbrev.el (dabbrev-ignored-buffer-names) (dabbrev-ignored-buffer-regexps): Link to it. (dabbrev-ignored-buffer-modes): New user option (bug#19392). (dabbrev--filter-buffer-modes): New function. (dabbrev--select-buffers, dabbrev--make-friend-buffer-list): Use it. diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi index 9f339a0357..07f66ec10a 100644 --- a/doc/emacs/abbrevs.texi +++ b/doc/emacs/abbrevs.texi @@ -411,10 +411,13 @@ away in the buffer to search for an expansion. @vindex dabbrev-check-all-buffers @vindex dabbrev-check-other-buffers +@vindex dabbrev-ignored-buffer-modes After scanning the current buffer, @kbd{M-/} normally searches other buffers. The variables @code{dabbrev-check-all-buffers} and @code{dabbrev-check-other-buffers} can be used to determine which -other buffers, if any, are searched. +other buffers, if any, are searched. Buffers that have major modes +derived from any of the modes in @code{dabbrev-ignored-buffer-modes} +are ignored. @vindex dabbrev-ignored-buffer-names @vindex dabbrev-ignored-buffer-regexps diff --git a/etc/NEWS b/etc/NEWS index a2f7f03852..2e7a1d8638 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -734,6 +734,13 @@ script that was used in ancient South Asia. A new input method, * Changes in Specialized Modes and Packages in Emacs 29.1 +** dabbrev + ++++ +*** New user option 'dabbrev-ignored-buffer-modes'. +Buffers with major modes in this list will be ignored. By default, +this includes "binary" buffers like 'archive-mode' and 'image-mode'. + ** Package +++ diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 220a2f52e9..adbfca01a3 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -225,18 +225,28 @@ or matched by `dabbrev-ignored-buffer-regexps'." (defcustom dabbrev-ignored-buffer-names '("*Messages*" "*Buffer List*") "List of buffer names that dabbrev should not check. -See also `dabbrev-ignored-buffer-regexps'." +See also `dabbrev-ignored-buffer-regexps' and +`dabbrev-ignored-buffer-modes'." :type '(repeat (string :tag "Buffer name")) :group 'dabbrev :version "20.3") (defcustom dabbrev-ignored-buffer-regexps nil "List of regexps matching names of buffers that dabbrev should not check. -See also `dabbrev-ignored-buffer-names'." +See also `dabbrev-ignored-buffer-names' and +`dabbrev-ignored-buffer-modes'." :type '(repeat regexp) :group 'dabbrev :version "21.1") +(defcustom dabbrev-ignored-buffer-modes + '(archive-mode image-mode tar-mode) + "Inhibit looking for abbreviations in buffers derived from these modes. +See also `dabbrev-ignored-buffer-names' and +`dabbrev-ignored-buffer-regexps'." + :type '(repeat symbol) + :version "29.1") + (defcustom dabbrev-check-other-buffers t "Should \\[dabbrev-expand] look in other buffers? nil: Don't look in other buffers. @@ -632,19 +642,29 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." "Return a list of other buffers to search for a possible abbrev. The current buffer is not included in the list. -This function makes a list of all the buffers returned by `buffer-list', -then discards buffers whose names match `dabbrev-ignored-buffer-names' -or `dabbrev-ignored-buffer-regexps'. It also discards buffers for which -`dabbrev-friend-buffer-function', if it is bound, returns nil when called -with the buffer as argument. -It returns the list of the buffers that are not discarded." +This function makes a list of all the buffers returned by +`buffer-list', then discards buffers whose names match +`dabbrev-ignored-buffer-names' or +`dabbrev-ignored-buffer-regexps', and major modes that match +`dabbrev-ignored-buffer-modes'. It also discards buffers for +which `dabbrev-friend-buffer-function', if it is bound, returns +nil when called with the buffer as argument. It returns the list +of the buffers that are not discarded." (dabbrev-filter-elements - buffer (buffer-list) + buffer (dabbrev--filter-buffer-modes) (and (not (eq (current-buffer) buffer)) (not (dabbrev--ignore-buffer-p buffer)) (boundp 'dabbrev-friend-buffer-function) (funcall dabbrev-friend-buffer-function buffer)))) +(defun dabbrev--filter-buffer-modes () + (seq-filter (lambda (buffer) + (not (apply + #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + dabbrev-ignored-buffer-modes))) + (buffer-list))) + (defun dabbrev--try-find (abbrev reverse n ignore-case) "Search for ABBREV, backwards if REVERSE, N times. If IGNORE-CASE is non-nil, ignore case while searching. @@ -779,7 +799,7 @@ of the start of the occurrence." (setq list (append list (dabbrev-filter-elements - buffer (buffer-list) + buffer (dabbrev--filter-buffer-modes) (and (not (memq buffer list)) (not (dabbrev--ignore-buffer-p buffer))))))) ;; Remove the current buffer. commit d632c3d7db62f5de3dea68324e6f3937827be385 Author: Po Lu Date: Sat May 7 19:00:04 2022 +0800 Fix mouse face dismissal in some widget popups * src/xterm.c (handle_one_xevent): Accept XINotifyUngrab as well. diff --git a/src/xterm.c b/src/xterm.c index c841240a72..848389ce96 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16909,7 +16909,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_X_TOOLKIT if (popup_activated () - && leave->mode == XINotifyPassiveUngrab) + && (leave->mode == XINotifyPassiveUngrab + || leave->mode == XINotifyUngrab)) any = x_any_window_to_frame (dpyinfo, leave->event); #endif commit ea58276462d93f24c75473c69154ef7a4a47b63c Author: Lars Ingebrigtsen Date: Sat May 7 12:46:55 2022 +0200 Allow inhibiting linkification in *Help* buffers * doc/lispref/help.texi (Keys in Documentation): Document it. lisp/help-mode.el (help-make-xrefs): Implement a new \+ syntax to inhibit buttonification. diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index d53bfad8e9..f029a1c97c 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -362,6 +362,10 @@ depending on the value of @code{text-quoting-style}. quotes the following character and is discarded; thus, @samp{\=`} puts @samp{`} into the output, @samp{\=\[} puts @samp{\[} into the output, and @samp{\=\=} puts @samp{\=} into the output. + +@item \+ +This indicates that the symbol directly following should not be marked +as link in the @file{*Help*} buffer. @end table @strong{Please note:} Each @samp{\} must be doubled when written in a diff --git a/etc/NEWS b/etc/NEWS index b595eae7e1..a2f7f03852 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -461,6 +461,15 @@ This allows you to enter emoji using short strings, eg :face_palm: or ** Help ++++ +*** New doc string syntax to indicate that symbols shouldn't be links. +When displaying doc strings in *Help* buffers, strings that are +"`like-this'" are made into links (if they point to a bound +function/variable). This can lead to false positives when talking +about values that are symbols that happen to have the same names as +functions/variables. To inhibit this buttonification, the new +"\\+`like-this'" syntax can be used. + +++ *** New user option 'help-window-keep-selected'. If non-nil, commands to show the info manual and the source will reuse diff --git a/lisp/help-mode.el b/lisp/help-mode.el index a0a587cd81..4a65f40507 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -452,6 +452,7 @@ Commands: "\\(symbol\\|program\\|property\\)\\|" ; Don't link "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" "[ \t\n]+\\)?" + "\\(\\\\\\+\\)?" "['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]")) "Regexp matching doc string references to symbols. @@ -628,27 +629,28 @@ that." ;; Quoted symbols (save-excursion (while (re-search-forward help-xref-symbol-regexp nil t) - (let* ((data (match-string 8)) - (sym (intern-soft data))) - (if sym - (cond - ((match-string 3) ; `variable' &c - (and (or (boundp sym) ; `variable' doesn't ensure + (when-let ((sym (intern-soft (match-string 9)))) + (if (match-string 8) + (delete-region (match-beginning 8) + (match-end 8)) + (cond + ((match-string 3) ; `variable' &c + (and (or (boundp sym) ; `variable' doesn't ensure ; it's actually bound - (get sym 'variable-documentation)) - (help-xref-button 8 'help-variable sym))) - ((match-string 4) ; `function' &c - (and (fboundp sym) ; similarly - (help-xref-button 8 'help-function sym))) - ((match-string 5) ; `face' - (and (facep sym) - (help-xref-button 8 'help-face sym))) - ((match-string 6)) ; nothing for `symbol' - ((match-string 7) - (help-xref-button 8 'help-function-def sym)) - ((cl-some (lambda (x) (funcall (nth 1 x) sym)) - describe-symbol-backends) - (help-xref-button 8 'help-symbol sym))))))) + (get sym 'variable-documentation)) + (help-xref-button 9 'help-variable sym))) + ((match-string 4) ; `function' &c + (and (fboundp sym) ; similarly + (help-xref-button 9 'help-function sym))) + ((match-string 5) ; `face' + (and (facep sym) + (help-xref-button 9 'help-face sym))) + ((match-string 6)) ; nothing for `symbol' + ((match-string 7) + (help-xref-button 9 'help-function-def sym)) + ((cl-some (lambda (x) (funcall (nth 1 x) sym)) + describe-symbol-backends) + (help-xref-button 9 'help-symbol sym))))))) ;; An obvious case of a key substitution: (save-excursion (while (re-search-forward diff --git a/test/lisp/help-mode-tests.el b/test/lisp/help-mode-tests.el index c0c1cf8b53..b5bdf6b8d4 100644 --- a/test/lisp/help-mode-tests.el +++ b/test/lisp/help-mode-tests.el @@ -81,7 +81,7 @@ Lisp concepts such as car, cdr, cons cell and list.") (insert (format fmt fn)) (goto-char (point-min)) (re-search-forward help-xref-symbol-regexp) - (help-xref-button 8 'help-function) + (help-xref-button 9 'help-function) (should-not (button-at (1- beg))) (should-not (button-at (+ beg (length (symbol-name fn))))) (should (eq (button-type (button-at beg)) 'help-function)))))) commit e13744780fea9c11a4fed3de08bd0384ce2de8e8 Author: Lars Ingebrigtsen Date: Sat May 7 12:15:30 2022 +0200 Make the icomplete-in-buffer doc string document more * lisp/icomplete.el (icomplete-in-buffer): Note what this variable does and doesn't do (bug#45768). diff --git a/lisp/icomplete.el b/lisp/icomplete.el index ee1a131a6e..a0f105a628 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -139,7 +139,9 @@ See `icomplete-delay-completions-threshold'." :type 'integer) (defvar icomplete-in-buffer nil - "If non-nil, also use Icomplete when completing in non-mini buffers.") + "If non-nil, also use Icomplete when completing in non-mini buffers. +This affects commands like `complete-in-region', but not commands +like `dabbrev-completion', which uses its own completion setup.") (defcustom icomplete-minibuffer-setup-hook nil "Icomplete-specific customization of minibuffer setup. commit e8488bcc9cbbeafe6307a73b2386ced986327618 Author: Lars Ingebrigtsen Date: Sat May 7 12:05:48 2022 +0200 Avoid having font locking triggering unnecessary auto-saving * lisp/subr.el (with-silent-modifications): Use it to restore the ticks (bug#11303). * src/buffer.c (Finternal__set_buffer_modified_tick): New function. diff --git a/etc/NEWS b/etc/NEWS index f7dddd36de..b595eae7e1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1507,6 +1507,15 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 +--- +** 'with-silent-modifications' also restores buffer modification ticks. +'with-silent-modifications' is a macro meant to be used by the font +locking machinery to allow applying text properties without changing +the modification status of the buffer. However, it didn't restore the +buffer modification ticks, so applying font locking to a modified +buffer that had already been auto-saved would trigger another +auto-saving. This is no longer the case. + --- ** 'prin1' doesn't always escape "." and "?" in symbols any more. Previously, symbols like 'foo.bar' would be printed by 'prin1' as diff --git a/lisp/subr.el b/lisp/subr.el index 5af802fa18..01549cc6f7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4594,14 +4594,19 @@ like `buffer-modified-p', checking whether the file is locked by someone else, running buffer modification hooks, and other things of that nature." (declare (debug t) (indent 0)) - (let ((modified (make-symbol "modified"))) + (let ((modified (make-symbol "modified")) + (tick (make-symbol "tick"))) `(let* ((,modified (buffer-modified-p)) + (,tick (buffer-modified-tick)) (buffer-undo-list t) (inhibit-read-only t) (inhibit-modification-hooks t)) (unwind-protect (progn ,@body) + ;; We restore the buffer tick count, too, because otherwise + ;; we'll trigger a new auto-save. + (internal--set-buffer-modified-tick ,tick) (unless ,modified (restore-buffer-modified-p nil)))))) diff --git a/src/buffer.c b/src/buffer.c index f8a7a4f510..6334e197f0 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1499,6 +1499,18 @@ use current buffer as BUFFER. */) return modiff_to_integer (BUF_MODIFF (decode_buffer (buffer))); } +DEFUN ("internal--set-buffer-modified-tick", + Finternal__set_buffer_modified_tick, Sinternal__set_buffer_modified_tick, + 1, 2, 0, + doc: /* Set BUFFER's tick counter to TICK. +No argument or nil as argument means use current buffer as BUFFER. */) + (Lisp_Object tick, Lisp_Object buffer) +{ + CHECK_FIXNUM (tick); + BUF_MODIFF (decode_buffer (buffer)) = XFIXNUM (tick); + return Qnil; +} + DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick, Sbuffer_chars_modified_tick, 0, 1, 0, doc: /* Return BUFFER's character-change tick counter. @@ -6418,6 +6430,7 @@ will run for `clone-indirect-buffer' calls as well. */); defsubr (&Sforce_mode_line_update); defsubr (&Sset_buffer_modified_p); defsubr (&Sbuffer_modified_tick); + defsubr (&Sinternal__set_buffer_modified_tick); defsubr (&Sbuffer_chars_modified_tick); defsubr (&Srename_buffer); defsubr (&Sother_buffer); commit 2fe4523518db061067b62b004e619e91653bb36a Author: Po Lu Date: Sat May 7 17:01:44 2022 +0800 Cache color lookup failures as well * src/xterm.c (x_parse_color): Cache color lookup failures too. * src/xterm.h (struct color_name_cache_entry): New field `valid'. diff --git a/src/xterm.c b/src/xterm.c index 2141964c74..c841240a72 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6933,11 +6933,12 @@ x_parse_color (struct frame *f, const char *color_name, XColor *color) { unsigned short r, g, b; - Display *dpy = FRAME_X_DISPLAY (f); - Colormap cmap = FRAME_X_COLORMAP (f); + Display *dpy; + Colormap cmap; struct x_display_info *dpyinfo; struct color_name_cache_entry *cache_entry; unsigned int hash, idx; + int rc; /* Don't pass #RGB strings directly to XParseColor, because that follows the X convention of zero-extending each channel @@ -6949,37 +6950,49 @@ x_parse_color (struct frame *f, const char *color_name, color->red = r; color->green = g; color->blue = b; + return 1; } + /* Some X servers send BadValue on empty color names. */ + if (!strlen (color_name)) + return 0; + + cmap = FRAME_X_COLORMAP (f); + dpy = FRAME_X_DISPLAY (f); dpyinfo = FRAME_DISPLAY_INFO (f); + hash = x_hash_string_ignore_case (color_name); idx = hash % dpyinfo->color_names_size; - for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names[idx]; + for (cache_entry = dpyinfo->color_names[idx]; cache_entry; cache_entry = cache_entry->next) { if (!xstrcasecmp (cache_entry->name, color_name)) { - *color = cache_entry->rgb; - return 1; + if (cache_entry->valid) + *color = cache_entry->rgb; + + return cache_entry->valid; } } - /* Some X servers send BadValue on empty color names. */ - if (!strlen (color_name)) - return 0; - - if (XParseColor (dpy, cmap, color_name, color) == 0) - /* No caching of negative results, currently. */ - return 0; + block_input (); + rc = XParseColor (dpy, cmap, color_name, color); + unblock_input (); cache_entry = xzalloc (sizeof *cache_entry); - cache_entry->rgb = *color; + + if (rc) + cache_entry->rgb = *color; + + cache_entry->valid = rc; cache_entry->name = xstrdup (color_name); - cache_entry->next = FRAME_DISPLAY_INFO (f)->color_names[idx]; - FRAME_DISPLAY_INFO (f)->color_names[idx] = cache_entry; - return 1; + cache_entry->next = dpyinfo->color_names[idx]; + + dpyinfo->color_names[idx] = cache_entry; + + return rc; } diff --git a/src/xterm.h b/src/xterm.h index 3e06564bee..66c4b17823 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -196,8 +196,15 @@ extern cairo_pattern_t *x_bitmap_stipple (struct frame *, Pixmap); struct color_name_cache_entry { struct color_name_cache_entry *next; + + /* The color values of the cached color entry. */ XColor rgb; + + /* The name of the cached color. */ char *name; + + /* Whether or not RGB is valid (i.e. the color actually exists). */ + bool_bf valid : 1; }; #ifdef HAVE_XINPUT2 commit 293a97d61e1977440f96b7fc91f281a06250ea72 Author: Po Lu Date: Sat May 7 06:19:53 2022 +0000 Fix 32-bit Haiku build * src/haiku_support.cc (MessageReceived): Fix type of `old_what'. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 105da3969f..5dfb25d6dd 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2989,7 +2989,7 @@ class EmacsFilePanelCallbackLooper : public BLooper BEntry entry; BPath path; entry_ref ref; - int old_what; + int32 old_what; if (msg->what == FILE_PANEL_SELECTION || ((msg->FindInt32 ("old_what", &old_what) == B_OK commit a775528d17ce4cb070c36af1023a2dfecad24569 Author: Po Lu Date: Sat May 7 06:17:46 2022 +0000 Implement `sticky' frame parameter on Haiku * src/haiku_support.cc (BWindow_set_sticky): New function. * src/haiku_support.h: Update prototypes. * src/haikufns.c (haiku_set_sticky, haiku_frame_parm_handlers): New frame param handler. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 300a78cd73..105da3969f 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -5067,3 +5067,18 @@ be_select_font (void (*process_pending_signals_function) (void), return true; } + +void +BWindow_set_sticky (void *window, bool sticky) +{ + BWindow *w = (BWindow *) window; + + if (w->LockLooper ()) + { + w->SetFlags (sticky ? (w->Flags () + | B_SAME_POSITION_IN_ALL_WORKSPACES) + : w->Flags () & ~B_SAME_POSITION_IN_ALL_WORKSPACES); + + w->UnlockLooper (); + } +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 1433783c9f..5ded9300d8 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -504,6 +504,7 @@ extern bool BWindow_is_active (void *); extern void BWindow_set_override_redirect (void *, bool); extern void BWindow_dimensions (void *, int *, int *); extern void BWindow_set_z_group (void *, enum haiku_z_group); +extern void BWindow_set_sticky (void *, bool); extern void BWindow_Flush (void *); extern void BFont_close (void *); diff --git a/src/haikufns.c b/src/haikufns.c index 2f26623fa5..8596317de2 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1783,6 +1783,15 @@ haiku_set_inhibit_double_buffering (struct frame *f, unblock_input (); } +static void +haiku_set_sticky (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + block_input (); + BWindow_set_sticky (FRAME_HAIKU_WINDOW (f), !NILP (new_value)); + unblock_input (); +} + DEFUN ("haiku-set-mouse-absolute-pixel-position", @@ -2713,7 +2722,7 @@ frame_parm_handler haiku_frame_parm_handlers[] = gui_set_fullscreen, gui_set_font_backend, gui_set_alpha, - NULL, /* set sticky */ + haiku_set_sticky, NULL, /* set tool bar pos */ haiku_set_inhibit_double_buffering, haiku_set_undecorated, commit d14d86696e0f43e872291f592727538193153a51 Merge: f7c4a62048 afdf72eeb2 Author: Stefan Kangas Date: Sat May 7 06:30:32 2022 +0200 Merge from origin/emacs-28 afdf72eeb2 Fix bug#55274 5bfac7c774 Provide reference for OTF tags in the ELisp manual commit f7c4a620484bedcd0aad97a9f987e8d924b3070e Merge: 43a640c20a 936009cfe5 Author: Stefan Kangas Date: Sat May 7 06:30:32 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: 936009cfe5 Be more resilient towards errors during error handling commit 43a640c20adaaae7942d44c91cf3df3e5b4495ef Author: Po Lu Date: Sat May 7 03:20:35 2022 +0000 Fix race conditions in the Haiku file dialog * src/haiku_support.cc (current_file_panel_port): Delete variable. (class EmacsWindow, MessageReceived): Stop handling file panel events here. (class EmacsFilePanelCallbackLooper): New class. (be_popup_file_dialog): Use a separate looper to handle file panel events. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index b8fa963c62..300a78cd73 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -195,10 +195,6 @@ static void *grab_view = NULL; static BLocker grab_view_locker; static bool drag_and_drop_in_progress; -/* Port used to send data to the main thread while a file panel is - active. */ -static port_id volatile current_file_panel_port; - /* Many places require us to lock the child frame data, and then lock the locker of some random window. Unfortunately, locking such a window might be delayed due to an arriving message, which then @@ -853,8 +849,6 @@ class EmacsWindow : public BWindow void MessageReceived (BMessage *msg) { - int32 old_what = 0; - if (msg->WasDropped ()) { BPoint whereto; @@ -886,49 +880,6 @@ class EmacsWindow : public BWindow haiku_write (MENU_BAR_SELECT_EVENT, &rq); } - else if (msg->what == FILE_PANEL_SELECTION - || ((msg->FindInt32 ("old_what", &old_what) == B_OK - && old_what == FILE_PANEL_SELECTION))) - { - const char *str_path, *name; - char *file_name, *str_buf; - BEntry entry; - BPath path; - entry_ref ref; - - file_name = NULL; - - if (msg->FindRef ("refs", &ref) == B_OK && - entry.SetTo (&ref, 0) == B_OK && - entry.GetPath (&path) == B_OK) - { - str_path = path.Path (); - - if (str_path) - file_name = strdup (str_path); - } - - if (msg->FindRef ("directory", &ref), - entry.SetTo (&ref, 0) == B_OK && - entry.GetPath (&path) == B_OK) - { - name = msg->GetString ("name"); - str_path = path.Path (); - - if (name) - { - str_buf = (char *) alloca (std::strlen (str_path) - + std::strlen (name) + 2); - snprintf (str_buf, std::strlen (str_path) - + std::strlen (name) + 2, "%s/%s", - str_path, name); - file_name = strdup (str_buf); - } - } - - write_port (current_file_panel_port, 0, - &file_name, sizeof file_name); - } else BWindow::MessageReceived (msg); } @@ -3026,6 +2977,125 @@ class EmacsFontSelectionDialog : public BWindow } }; +class EmacsFilePanelCallbackLooper : public BLooper +{ + port_id comm_port; + + void + MessageReceived (BMessage *msg) + { + const char *str_path, *name; + char *file_name, *str_buf; + BEntry entry; + BPath path; + entry_ref ref; + int old_what; + + if (msg->what == FILE_PANEL_SELECTION + || ((msg->FindInt32 ("old_what", &old_what) == B_OK + && old_what == FILE_PANEL_SELECTION))) + { + file_name = NULL; + + if (msg->FindRef ("refs", &ref) == B_OK + && entry.SetTo (&ref, 0) == B_OK + && entry.GetPath (&path) == B_OK) + { + str_path = path.Path (); + + if (str_path) + file_name = strdup (str_path); + } + else if (msg->FindRef ("directory", &ref) == B_OK + && entry.SetTo (&ref, 0) == B_OK + && entry.GetPath (&path) == B_OK) + { + name = msg->GetString ("name"); + str_path = path.Path (); + + if (name) + { + str_buf = (char *) alloca (std::strlen (str_path) + + std::strlen (name) + 2); + snprintf (str_buf, std::strlen (str_path) + + std::strlen (name) + 2, "%s/%s", + str_path, name); + file_name = strdup (str_buf); + } + } + + write_port (comm_port, 0, &file_name, sizeof file_name); + } + + BLooper::MessageReceived (msg); + } + +public: + EmacsFilePanelCallbackLooper (void) : BLooper () + { + comm_port = create_port (1, "file panel port"); + } + + ~EmacsFilePanelCallbackLooper (void) + { + delete_port (comm_port); + } + + char * + ReadFileName (void (*process_pending_signals_function) (void)) + { + object_wait_info infos[2]; + ssize_t status; + int32 reply_type; + char *file_name; + + file_name = NULL; + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = comm_port; + infos[1].type = B_OBJECT_TYPE_PORT; + infos[1].events = B_EVENT_READ; + + while (true) + { + status = wait_for_objects (infos, 2); + + if (status == B_INTERRUPTED || status == B_WOULD_BLOCK) + continue; + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + if (infos[1].events & B_EVENT_READ) + { + status = read_port (comm_port, + &reply_type, &file_name, + sizeof file_name); + + if (status < B_OK) + file_name = NULL; + + goto out; + } + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_READ; + } + + out: + return file_name; + } + + status_t + InitCheck (void) + { + return comm_port >= B_OK ? B_OK : comm_port; + } +}; + static int32 start_running_application (void *data) { @@ -4403,23 +4473,23 @@ be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, const char *prompt, void (*process_pending_signals_function) (void)) { - BWindow *w, *panel_window; + BWindow *panel_window; BEntry path; BMessage msg (FILE_PANEL_SELECTION); BFilePanel panel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, NULL, NULL, (dir_only_p ? B_DIRECTORY_NODE : B_FILE_NODE | B_DIRECTORY_NODE)); - object_wait_info infos[2]; - ssize_t status; - int32 reply_type; char *file_name; + EmacsFilePanelCallbackLooper *looper; - current_file_panel_port = create_port (1, "file panel port"); - file_name = NULL; + looper = new EmacsFilePanelCallbackLooper; - if (current_file_panel_port < B_OK) - return NULL; + if (looper->InitCheck () < B_OK) + { + delete looper; + return NULL; + } if (default_dir) { @@ -4427,11 +4497,8 @@ be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, default_dir = NULL; } - w = (BWindow *) window; panel_window = panel.Window (); - panel.SetMessage (&msg); - if (default_dir) panel.SetPanelDirectory (&path); @@ -4442,45 +4509,16 @@ be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, panel_window->SetFeel (B_MODAL_APP_WINDOW_FEEL); panel.SetHideWhenDone (false); - panel.SetTarget (BMessenger (w)); + panel.SetTarget (BMessenger (looper)); + panel.SetMessage (&msg); panel.Show (); - infos[0].object = port_application_to_emacs; - infos[0].type = B_OBJECT_TYPE_PORT; - infos[0].events = B_EVENT_READ; - - infos[1].object = current_file_panel_port; - infos[1].type = B_OBJECT_TYPE_PORT; - infos[1].events = B_EVENT_READ; - - while (true) - { - status = wait_for_objects (infos, 2); + looper->Run (); + file_name = looper->ReadFileName (process_pending_signals_function); - if (status == B_INTERRUPTED || status == B_WOULD_BLOCK) - continue; - - if (infos[0].events & B_EVENT_READ) - process_pending_signals_function (); - - if (infos[1].events & B_EVENT_READ) - { - status = read_port (current_file_panel_port, - &reply_type, &file_name, - sizeof file_name); - - if (status < B_OK) - file_name = NULL; - - goto out; - } - - infos[0].events = B_EVENT_READ; - infos[1].events = B_EVENT_READ; - } + if (looper->Lock ()) + looper->Quit (); - out: - delete_port (current_file_panel_port); return file_name; } commit 76233917c47e7d4ed1d283b09ec67a8dbd6cdf4b Author: Po Lu Date: Sat May 7 09:34:35 2022 +0800 Fix freezes with some oddball menus * src/xmenu.c (x_activate_menubar): Clear flag if dispatching the event failed. * src/xterm.c (handle_one_xevent): Check for sensitive CascadeButton instead of row column type. diff --git a/src/xmenu.c b/src/xmenu.c index 4c8828412d..aaf53569a7 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -677,7 +677,10 @@ x_activate_menubar (struct frame *f) } } #endif - XtDispatchEvent (f->output_data.x->saved_menu_event); + /* The cascade button might have been deleted, so don't activate the + popup if it no widget was found to dispatch to. */ + popup_activated_flag + = XtDispatchEvent (f->output_data.x->saved_menu_event); #endif unblock_input (); diff --git a/src/xterm.c b/src/xterm.c index 6b5c272ef9..2141964c74 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -665,6 +665,7 @@ along with GNU Emacs. If not, see . */ #ifdef USE_MOTIF #include +#include #endif #ifdef USE_X_TOOLKIT @@ -16635,14 +16636,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, && event->xbutton.same_screen) { #ifdef USE_MOTIF - unsigned char column_type; Widget widget; widget = XtWindowToWidget (dpyinfo->display, event->xbutton.window); - XtVaGetValues (widget, XmNrowColumnType, &column_type, NULL); - if (column_type != XmMENU_BAR) + if (widget && XmIsCascadeButton (widget) + && XtIsSensitive (widget)) { #endif if (!f->output_data.x->saved_menu_event) commit 95ed2310155f4ddad9f10a21be8a734ed7c5200f Author: Stefan Monnier Date: Fri May 6 16:44:54 2022 -0400 (icomplete-exhibit): Fix use in-buffer Also prefer #' to quote function names and remove redundant :group args. * lisp/icomplete.el (icomplete-exhibit): Don't presume the completion field ends at `point-max`. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 2986aa192c..ee1a131a6e 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -153,8 +153,7 @@ with other features and packages. For instance: will constrain Emacs to a maximum minibuffer height of 3 lines when icompletion is occurring." - :type 'hook - :group 'icomplete) + :type 'hook) ;;;_* Initialization @@ -174,11 +173,11 @@ Used to implement the option `icomplete-show-matches-on-no-input'.") (defvar icomplete-minibuffer-map (let ((map (make-sparse-keymap))) - (define-key map [?\M-\t] 'icomplete-force-complete) - (define-key map [remap minibuffer-complete-and-exit] 'icomplete-ret) - (define-key map [?\C-j] 'icomplete-force-complete-and-exit) - (define-key map [?\C-.] 'icomplete-forward-completions) - (define-key map [?\C-,] 'icomplete-backward-completions) + (define-key map [?\M-\t] #'icomplete-force-complete) + (define-key map [remap minibuffer-complete-and-exit] #'icomplete-ret) + (define-key map [?\C-j] #'icomplete-force-complete-and-exit) + (define-key map [?\C-.] #'icomplete-forward-completions) + (define-key map [?\C-,] #'icomplete-backward-completions) map) "Keymap used by `icomplete-mode' in the minibuffer.") @@ -394,18 +393,18 @@ if that doesn't produce a completion match." (defvar icomplete-fido-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-k") 'icomplete-fido-kill) - (define-key map (kbd "C-d") 'icomplete-fido-delete-char) - (define-key map (kbd "RET") 'icomplete-fido-ret) - (define-key map (kbd "C-m") 'icomplete-fido-ret) - (define-key map (kbd "DEL") 'icomplete-fido-backward-updir) - (define-key map (kbd "M-j") 'icomplete-fido-exit) - (define-key map (kbd "C-s") 'icomplete-forward-completions) - (define-key map (kbd "C-r") 'icomplete-backward-completions) - (define-key map (kbd "") 'icomplete-forward-completions) - (define-key map (kbd "") 'icomplete-backward-completions) - (define-key map (kbd "C-.") 'icomplete-forward-completions) - (define-key map (kbd "C-,") 'icomplete-backward-completions) + (define-key map (kbd "C-k") #'icomplete-fido-kill) + (define-key map (kbd "C-d") #'icomplete-fido-delete-char) + (define-key map (kbd "RET") #'icomplete-fido-ret) + (define-key map (kbd "C-m") #'icomplete-fido-ret) + (define-key map (kbd "DEL") #'icomplete-fido-backward-updir) + (define-key map (kbd "M-j") #'icomplete-fido-exit) + (define-key map (kbd "C-s") #'icomplete-forward-completions) + (define-key map (kbd "C-r") #'icomplete-backward-completions) + (define-key map (kbd "") #'icomplete-forward-completions) + (define-key map (kbd "") #'icomplete-backward-completions) + (define-key map (kbd "C-.") #'icomplete-forward-completions) + (define-key map (kbd "C-,") #'icomplete-backward-completions) map) "Keymap used by `fido-mode' in the minibuffer.") @@ -431,7 +430,7 @@ if that doesn't produce a completion match." This global minor mode makes minibuffer completion behave more like `ido-mode' than regular `icomplete-mode'." - :global t :group 'icomplete + :global t (remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup) (remove-hook 'minibuffer-setup-hook #'icomplete--fido-mode-setup) (when fido-mode @@ -457,7 +456,7 @@ You can use the following key bindings to navigate and select completions: \\{icomplete-minibuffer-map}" - :global t :group 'icomplete + :global t (remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup) (remove-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup) (when icomplete-mode @@ -532,7 +531,7 @@ Usually run by inclusion in `minibuffer-setup-hook'." (setq icomplete--in-region-buffer nil) (delete-overlay icomplete-overlay) (kill-local-variable 'completion-show-inline-help) - (remove-hook 'post-command-hook 'icomplete-post-command-hook t) + (remove-hook 'post-command-hook #'icomplete-post-command-hook t) (message nil))) (when (and completion-in-region-mode icomplete-mode (icomplete-simple-completing-p)) @@ -543,7 +542,7 @@ Usually run by inclusion in `minibuffer-setup-hook'." (unless (memq icomplete-minibuffer-map (cdr tem)) (setcdr tem (make-composed-keymap icomplete-minibuffer-map (cdr tem))))) - (add-hook 'post-command-hook 'icomplete-post-command-hook nil t))) + (add-hook 'post-command-hook #'icomplete-post-command-hook nil t))) (defun icomplete--sorted-completions () (or completion-all-sorted-completions @@ -630,12 +629,12 @@ Usually run by inclusion in `minibuffer-setup-hook'." (defvar icomplete-vertical-mode-minibuffer-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-n") 'icomplete-forward-completions) - (define-key map (kbd "C-p") 'icomplete-backward-completions) - (define-key map (kbd "") 'icomplete-forward-completions) - (define-key map (kbd "") 'icomplete-backward-completions) - (define-key map (kbd "M-<") 'icomplete-vertical-goto-first) - (define-key map (kbd "M->") 'icomplete-vertical-goto-last) + (define-key map (kbd "C-n") #'icomplete-forward-completions) + (define-key map (kbd "C-p") #'icomplete-backward-completions) + (define-key map (kbd "") #'icomplete-forward-completions) + (define-key map (kbd "") #'icomplete-backward-completions) + (define-key map (kbd "M-<") #'icomplete-vertical-goto-first) + (define-key map (kbd "M->") #'icomplete-vertical-goto-last) map) "Keymap used by `icomplete-vertical-mode' in the minibuffer.") @@ -691,7 +690,7 @@ See `icomplete-mode' and `minibuffer-setup-hook'." (icomplete-simple-completing-p)) ;Shouldn't be necessary. (let ((saved-point (point))) (save-excursion - (goto-char (point-max)) + (goto-char (icomplete--field-end)) ; Insert the match-status information: (when (and (or icomplete-show-matches-on-no-input (not (equal (icomplete--field-string) @@ -1043,7 +1042,7 @@ matches exist." (push first prospects))) (concat determ "{" - (mapconcat 'identity prospects icomplete-separator) + (mapconcat #'identity prospects icomplete-separator) (concat (and limit (concat icomplete-separator ellipsis)) "}"))) ;; Restore the base-size info, since completion-all-sorted-completions commit 499f5f062efa031228dc20c5153849151f7a7614 Author: Lars Ingebrigtsen Date: Fri May 6 22:13:41 2022 +0200 Make elisp-mode-syntax-propertize tighter to reflect syntax * lisp/progmodes/elisp-mode.el (elisp-mode-syntax-propertize): ?\N and #s are case sensitive, so don't case-fold. (And adjust regexps.) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 0b647d247b..775b6ebab4 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -239,22 +239,23 @@ Comments in the form will be lost." (defun elisp-mode-syntax-propertize (start end) (goto-char start) - (funcall - (syntax-propertize-rules - ;; Empty symbol. - ("##" (0 (unless (nth 8 (syntax-ppss)) - (string-to-syntax "_")))) - ;; Unicode character names. (The longest name is 88 characters - ;; long.) - ("\\?\\\\N{[-A-Z ]\\{,88\\}}" - (0 (unless (nth 8 (syntax-ppss)) - (string-to-syntax "_")))) - ((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector. - (seq (group-n 1 "s") "(") ; Record. - (seq (group-n 1 (+ "^")) "["))) ; Char-table. - (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) - (string-to-syntax "'"))))) - start end)) + (let ((case-fold-search nil)) + (funcall + (syntax-propertize-rules + ;; Empty symbol. + ("##" (0 (unless (nth 8 (syntax-ppss)) + (string-to-syntax "_")))) + ;; Unicode character names. (The longest name is 88 characters + ;; long.) + ("\\?\\\\N{[-A-Za-z0-9 ]\\{,100\\}}" + (0 (unless (nth 8 (syntax-ppss)) + (string-to-syntax "_")))) + ((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector. + (seq (group-n 1 "s") "(") ; Record. + (seq (group-n 1 (+ "^")) "["))) ; Char-table. + (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "'"))))) + start end))) (defcustom emacs-lisp-mode-hook nil "Hook run when entering Emacs Lisp mode." commit 0b3b295776ce723885c9997ab26d57314db2a5df Author: Lars Ingebrigtsen Date: Fri May 6 21:13:32 2022 +0200 Make down-list signal an error if called inside a string * lisp/emacs-lisp/lisp.el (down-list): Signal an error inside a string (bug#5588). diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 4aeca9c6b0..ffca0dcf4f 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -171,6 +171,8 @@ This command assumes point is not in a string or comment. If INTERACTIVE is non-nil, as it is interactively, report errors as appropriate for this kind of usage." (interactive "^p\nd") + (when (ppss-comment-or-string-start (syntax-ppss)) + (user-error "This command doesn't work in strings or comments")) (if interactive (condition-case _ (down-list arg nil) commit cbd59395bdccd924ebe39430f32d2d72546a841a Author: Juri Linkov Date: Fri May 6 21:06:47 2022 +0300 Add char-folding of double quotes in isearch-fold-quotes-mode (bug#24510) * lisp/isearch.el (isearch-fold-quotes-mode): Add char-folding of double quotation marks. * test/lisp/subr-tests.el (test-local-set-state): Test values after setting state. diff --git a/lisp/isearch.el b/lisp/isearch.el index b404efd42a..96168f94bd 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -4467,7 +4467,6 @@ CASE-FOLD non-nil means the search was case-insensitive." (isearch-update)) - (defvar isearch-fold-quotes-mode--state) (define-minor-mode isearch-fold-quotes-mode "Minor mode to aid searching for \\=` characters in help modes." @@ -4480,7 +4479,8 @@ CASE-FOLD non-nil means the search was case-insensitive." (thread-last (regexp-quote string) (replace-regexp-in-string "`" "[`‘]") - (replace-regexp-in-string "'" "['’]"))))) + (replace-regexp-in-string "'" "['’]") + (replace-regexp-in-string "\"" "[\"“”]"))))) (buffer-local-restore-state isearch-fold-quotes-mode--state))) (provide 'isearch) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 6bcac2a5eb..8f3ee66e00 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1065,6 +1065,9 @@ final or penultimate step during initialization.")) (let ((state (buffer-local-set-state global 10 local 20 unexist 30))) + (should (= global 10)) + (should (= local 20)) + (should (= unexist 30)) (buffer-local-restore-state state) (should (= global 1)) (should (= local 2)) commit c57a6644ef97b3197c35c0c3ade60acd5607eef4 Author: Eric Abrahamsen Date: Fri May 6 10:14:08 2022 -0700 Fix handling of IMAP search strings * lisp/gnus/gnus-search.el (gnus-search-imap-handle-string): This was a misunderstanding of what `multibyte-string-p' means. The check was actually supposed to be whether the string was non-ascii or not. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 17724c3a51..369df81d9b 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1337,7 +1337,11 @@ elements are present." (cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap) (str string)) (with-slots (literal-plus) engine - (if (multibyte-string-p str) + ;; TODO: Figure out how Exchange IMAP servers actually work. They + ;; do not accept any CHARSET but US-ASCII, but they do report + ;; Literal+ capability. So what do we do? Will quoted strings + ;; always work? + (if (string-match-p "[^[:ascii:]]" str) ;; If LITERAL+ is available, use it and encode string as ;; UTF-8. (if literal-plus commit b7e1176323386935e34dbc98ec7d445c728cc83a Author: Lars Ingebrigtsen Date: Fri May 6 19:09:12 2022 +0200 Further log-view-file-next fix-ups * doc/emacs/maintaining.texi (VC Change Log): Remove the entries for commands now removed from most VCs. * lisp/vc/log-view.el (log-view-mode-menu): Disable menu entries (bug#14531). diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index fc2b2a24e2..cca8441daa 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1055,15 +1055,6 @@ prefix argument is a repeat count. Move to the next revision entry. A numeric prefix argument is a repeat count. -@item P -Move to the log of the previous file, if showing logs for a multi-file -VC fileset. Otherwise, just move to the beginning of the log. A -numeric prefix argument is a repeat count. - -@item N -Move to the log of the next file, if showing logs for a multi-file VC -fileset. A numeric prefix argument is a repeat count. - @item a Annotate the revision on the current line (@pxref{Old Revisions}). diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index c773492c2d..415b1564ed 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -162,9 +162,15 @@ ["Previous Log Entry" log-view-msg-prev :help "Go to the previous count'th log message"] ["Next File" log-view-file-next - :help "Go to the next count'th file"] + :help "Go to the next count'th file" + :active (derived-mode-p vc-cvs-log-view-mode + vc-rcs-log-view-mode + vc-sccs-log-view-mode)] ["Previous File" log-view-file-prev - :help "Go to the previous count'th file"])) + :help "Go to the previous count'th file" + :active (derived-mode-p vc-cvs-log-view-mode + vc-rcs-log-view-mode + vc-sccs-log-view-mode)])) (defvar log-view-mode-hook nil "Hook run at the end of `log-view-mode'.") commit 6d4cc2358b009462ab0e196946a1a89474c30264 Author: Eric Abrahamsen Date: Fri May 6 09:37:07 2022 -0700 Don't force Gnus cache usage in nnvirtual * lisp/gnus/nnvirtual.el (nnvirtual-retrieve-headers): We're not sure why this was happening, but it shouldn't be necessary. Simply calling `gnus-retrieve-headers' directly will use the cache if the user has configured it. diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index cc87a707ce..ae4265de7f 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -114,14 +114,9 @@ It is computed from the marks of individual component groups.") (gnus-check-server (gnus-find-method-for-group cgroup) t) (gnus-request-group cgroup t) - (setq prefix (gnus-group-real-prefix cgroup)) - ;; FIX FIX FIX we want to check the cache! - ;; This is probably evil if people have set - ;; gnus-use-cache to nil themselves, but I - ;; have no way of finding the true value of it. - (let ((gnus-use-cache t)) - (setq result (gnus-retrieve-headers - articles cgroup nil)))) + (setq prefix (gnus-group-real-prefix cgroup) + result (gnus-retrieve-headers + articles cgroup nil))) (set-buffer nntp-server-buffer) ;; If we got HEAD headers, we convert them into NOV ;; headers. This is slow, inefficient and, come to think commit 2d2c448efe9ef02e60a24e10918bbc18213da242 Author: Lars Ingebrigtsen Date: Fri May 6 18:38:09 2022 +0200 Fix forward-sexp for Unicode names in Emacs Lisp mode * lisp/progmodes/elisp-mode.el (elisp-mode-syntax-propertize): Make forward-sexp work for Unicode character names (bug#23354). diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 409055289d..0b647d247b 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -244,6 +244,11 @@ Comments in the form will be lost." ;; Empty symbol. ("##" (0 (unless (nth 8 (syntax-ppss)) (string-to-syntax "_")))) + ;; Unicode character names. (The longest name is 88 characters + ;; long.) + ("\\?\\\\N{[-A-Z ]\\{,88\\}}" + (0 (unless (nth 8 (syntax-ppss)) + (string-to-syntax "_")))) ((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector. (seq (group-n 1 "s") "(") ; Record. (seq (group-n 1 (+ "^")) "["))) ; Char-table. commit 6ccc4b6bc8a14daca6b3e3250574752c90c1eb9b Author: Noam Postavsky Date: Fri May 6 18:31:00 2022 +0200 Handle elisp #-syntax better in Emacs Lisp mode * elisp-mode.el (elisp-mode-syntax-propertize): New function. (emacs-lisp-mode): Set it as syntax-propertize-function (bug#15998). diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index a4088fa467..409055289d 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -237,6 +237,20 @@ Comments in the form will be lost." (if (bolp) (delete-char -1)) (indent-region start (point))))) +(defun elisp-mode-syntax-propertize (start end) + (goto-char start) + (funcall + (syntax-propertize-rules + ;; Empty symbol. + ("##" (0 (unless (nth 8 (syntax-ppss)) + (string-to-syntax "_")))) + ((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector. + (seq (group-n 1 "s") "(") ; Record. + (seq (group-n 1 (+ "^")) "["))) ; Char-table. + (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "'"))))) + start end)) + (defcustom emacs-lisp-mode-hook nil "Hook run when entering Emacs Lisp mode." :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode) @@ -310,6 +324,7 @@ be used instead. #'elisp-eldoc-var-docstring nil t) (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-vc-external-roots-function #'elisp-load-path-roots) + (setq-local syntax-propertize-function #'elisp-mode-syntax-propertize) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local) (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t) commit afdf72eeb2afb5cf96a2f0168c94b97448026666 Author: Michael Albinus Date: Fri May 6 17:33:41 2022 +0200 Fix bug#55274 * lisp/dired-aux.el (dired-do-compress-to): Use `file-local-name' for shell out-file. (Bug#55274) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index f16568f919..e00910cfe8 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1242,7 +1242,8 @@ and `dired-compress-files-alist'." (when (zerop (dired-shell-command (format-spec (cdr rule) - `((?o . ,(shell-quote-argument out-file)) + `((?o . ,(shell-quote-argument + (file-local-name out-file))) (?i . ,(mapconcat (lambda (in-file) (shell-quote-argument commit 7deaa2e36bafefd5bcd1278444f93212c68ddc19 Author: Stefan Monnier Date: Fri May 6 11:09:58 2022 -0400 * lisp/emacs-lisp/smie.el (smie-auto-fill): Fix bug#19342 diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 2bab131913..61d52026b3 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1846,7 +1846,9 @@ to which that point should be aligned, if we were to reindent it.") (move-to-column fc) (syntax-ppss)))) (while - (and (with-demoted-errors "SMIE Error: %S" + ;; We silence the error completely since errors are "normal" in + ;; some cases and an error message would be annoying (bug#19342). + (and (ignore-error scan-error (save-excursion (let ((end (point)) (bsf nil) ;Best-so-far. commit 1cda7cfb390c9612caf73e977d64d9e0eff5735c Author: Lars Ingebrigtsen Date: Fri May 6 16:21:07 2022 +0200 Respect help-window-keep-selected in shortdoc buttons * lisp/help-fns.el (help-fns--mention-shortdoc-groups): Respect help-window-keep-selected. * lisp/emacs-lisp/shortdoc.el (shortdoc-display-group): Allow reusing the window. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index ebf3c6b1fe..340fe766c1 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1298,16 +1298,20 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (keymap-lookup (current-global-map) "C-x x g"))) ;;;###autoload -(defun shortdoc-display-group (group &optional function) +(defun shortdoc-display-group (group &optional function same-window) "Pop to a buffer with short documentation summary for functions in GROUP. -If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." +If FUNCTION is non-nil, place point on the entry for FUNCTION (if any). +If SAME-WINDOW, don't pop to a new window." (interactive (list (completing-read "Show summary for functions in: " (mapcar #'car shortdoc--groups)))) (when (stringp group) (setq group (intern group))) (unless (assq group shortdoc--groups) (error "No such documentation group %s" group)) - (pop-to-buffer (format "*Shortdoc %s*" group)) + (funcall (if same-window + #'pop-to-buffer-same-window + #'pop-to-buffer) + (format "*Shortdoc %s*" group)) (let ((inhibit-read-only t) (prev nil)) (erase-buffer) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 0cb2c6d5d7..927a4f0d2c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -837,7 +837,8 @@ the C sources, too." (insert-text-button (symbol-name group) 'action (lambda (_) - (shortdoc-display-group group object)) + (shortdoc-display-group group object + help-window-keep-selected)) 'follow-link t 'help-echo (purecopy "mouse-1, RET: show documentation group"))) groups) commit afc14e4f661194969ef1622e2d9310cfbf662aff Author: Lars Ingebrigtsen Date: Fri May 6 16:09:38 2022 +0200 Move buffer-local-set-state to subr because it's used at runtime * lisp/subr.el (buffer-local-set-state) (buffer-local-set-state--get, buffer-local-restore-state): Moved from easy-mmode.el because they have to be available run-time. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 2568eaeb76..54cac11616 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -825,42 +825,6 @@ Interactively, COUNT is the prefix numeric argument, and defaults to 1." ,@body)) (put ',prev-sym 'definition-name ',base)))) - -(defmacro buffer-local-set-state (&rest pairs) - "Like `setq-local', but allow restoring the previous state of locals later. -This macro returns an object that can be passed to `buffer-local-restore-state' -in order to restore the state of the local variables set via this macro. - -\(fn [VARIABLE VALUE]...)" - (declare (debug setq)) - (unless (zerop (mod (length pairs) 2)) - (error "PAIRS must have an even number of variable/value members")) - `(prog1 - (buffer-local-set-state--get ',pairs) - (setq-local ,@pairs))) - -;;;###autoload -(defun buffer-local-set-state--get (pairs) - (let ((states nil)) - (while pairs - (push (list (car pairs) - (and (boundp (car pairs)) - (local-variable-p (car pairs))) - (and (boundp (car pairs)) - (symbol-value (car pairs)))) - states) - (setq pairs (cddr pairs))) - (nreverse states))) - -;;;###autoload -(defun buffer-local-restore-state (states) - "Restore values of buffer-local variables recorded in STATES. -STATES should be an object returned by `buffer-local-set-state'." - (pcase-dolist (`(,variable ,local ,value) states) - (if local - (set variable value) - (kill-local-variable variable)))) - (provide 'easy-mmode) ;;; easy-mmode.el ends here diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index c0a16f9198..b79c6b2a08 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -8852,18 +8852,7 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). (function-put 'easy-mmode-defsyntax 'lisp-indent-function '1) -(autoload 'buffer-local-set-state--get "easy-mmode" "\ - - -\(fn PAIRS)" nil nil) - -(autoload 'buffer-local-restore-state "easy-mmode" "\ -Restore buffer local variable values in STATES. -STATES is an object returned by `buffer-local-set-state'. - -\(fn STATES)" nil nil) - -(register-definition-prefixes "easy-mmode" '("buffer-local-set-state" "easy-mmode-")) +(register-definition-prefixes "easy-mmode" '("easy-mmode-")) ;;;*** diff --git a/lisp/subr.el b/lisp/subr.el index dec3b9190e..5af802fa18 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -207,6 +207,39 @@ Also see `local-variable-p'." (:success t) (void-variable nil))) +(defmacro buffer-local-set-state (&rest pairs) + "Like `setq-local', but allow restoring the previous state of locals later. +This macro returns an object that can be passed to `buffer-local-restore-state' +in order to restore the state of the local variables set via this macro. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + `(prog1 + (buffer-local-set-state--get ',pairs) + (setq-local ,@pairs))) + +(defun buffer-local-set-state--get (pairs) + (let ((states nil)) + (while pairs + (push (list (car pairs) + (and (boundp (car pairs)) + (local-variable-p (car pairs))) + (and (boundp (car pairs)) + (symbol-value (car pairs)))) + states) + (setq pairs (cddr pairs))) + (nreverse states))) + +(defun buffer-local-restore-state (states) + "Restore values of buffer-local variables recorded in STATES. +STATES should be an object returned by `buffer-local-set-state'." + (pcase-dolist (`(,variable ,local ,value) states) + (if local + (set variable value) + (kill-local-variable variable)))) + (defmacro push (newelt place) "Add NEWELT to the list stored in the generalized variable PLACE. This is morally equivalent to (setf PLACE (cons NEWELT PLACE)), diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el b/test/lisp/emacs-lisp/easy-mmode-tests.el index 697bf6c215..f6d0719672 100644 --- a/test/lisp/emacs-lisp/easy-mmode-tests.el +++ b/test/lisp/emacs-lisp/easy-mmode-tests.el @@ -60,16 +60,4 @@ (easy-mmode-test-mode 'toggle) (should (eq easy-mmode-test-mode t)))) -(ert-deftest test-local-set-state () - (setq global 1) - (with-temp-buffer - (setq-local local 2) - (let ((state (buffer-local-set-state global 10 - local 20 - unexist 30))) - (buffer-local-restore-state state) - (should (= global 1)) - (should (= local 2)) - (should-not (boundp 'unexist))))) - ;;; easy-mmode-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 3725f180f3..6bcac2a5eb 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1058,5 +1058,17 @@ final or penultimate step during initialization.")) (should (equal (kbd "C-x ( C-d C-x )") "")) (should (equal (kbd "C-x ( C-x )") ""))) +(ert-deftest test-local-set-state () + (setq global 1) + (with-temp-buffer + (setq-local local 2) + (let ((state (buffer-local-set-state global 10 + local 20 + unexist 30))) + (buffer-local-restore-state state) + (should (= global 1)) + (should (= local 2)) + (should-not (boundp 'unexist))))) + (provide 'subr-tests) ;;; subr-tests.el ends here commit 92bbe911e99968c04509c553767fa83bfdcbeb18 Author: Eli Zaretskii Date: Fri May 6 15:15:27 2022 +0300 ; Improve documentation of 'buffer-local-set-state' * lisp/emacs-lisp/easy-mmode.el (buffer-local-set-state) (buffer-local-restore-state): Doc fixes. * doc/lispref/modes.texi (Defining Minor Modes): Fix a typo and improve wording and indexing. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index bfd9724173..a0c1c488fe 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1912,14 +1912,15 @@ This means ``use in modes derived from @code{text-mode}, but nowhere else''. (There's an implicit @code{nil} element at the end.) @end defmac +@findex buffer-local-restore-state @defmac buffer-local-set-state variable value... -Minor modes often set buffer-local variables that alters some features +Minor modes often set buffer-local variables that affect some features in Emacs. When a minor mode is switched off, the mode is expected to restore the previous state of these variables. This convenience macro helps with doing that: It works much like @code{setq-local}, but returns an object that can be used to restore these values back to -their previous values/states (with the -@code{buffer-local-restore-state} function). +their previous values/states (using the companion function +@code{buffer-local-restore-state}). @end defmac @node Mode Line Format diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index bade14ec3d..2568eaeb76 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -827,9 +827,9 @@ Interactively, COUNT is the prefix numeric argument, and defaults to 1." (defmacro buffer-local-set-state (&rest pairs) - "Like `setq-local', but return an object that allows restoring previous state. -Use `buffer-local-restore-state' on the returned object to -restore the state. + "Like `setq-local', but allow restoring the previous state of locals later. +This macro returns an object that can be passed to `buffer-local-restore-state' +in order to restore the state of the local variables set via this macro. \(fn [VARIABLE VALUE]...)" (declare (debug setq)) @@ -854,8 +854,8 @@ restore the state. ;;;###autoload (defun buffer-local-restore-state (states) - "Restore buffer local variable values in STATES. -STATES is an object returned by `buffer-local-set-state'." + "Restore values of buffer-local variables recorded in STATES. +STATES should be an object returned by `buffer-local-set-state'." (pcase-dolist (`(,variable ,local ,value) states) (if local (set variable value) commit 7601a77d8a6ab567bd221777ca2964c934e1e4b9 Author: Lars Ingebrigtsen Date: Fri May 6 14:14:31 2022 +0200 Make compilation-parse-errors more resilient * lisp/progmodes/compile.el (compilation-parse-errors): Be more resilient in the presence of regexp alist not being completely set up (bug#55282). diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 6753cf0b02..2c5f4687ac 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1520,7 +1520,8 @@ to `compilation-error-regexp-alist' if RULES is nil." ;; FIXME-omake: Doing it here seems wrong, at least it should depend on ;; whether or not omake's own error messages are recognized. (cond - ((not omake-included) nil) + ((or (not omake-included) (not pat)) + nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) ;; Not anchored or anchored but already allows empty spaces. (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) @@ -1539,7 +1540,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) - (while (re-search-forward pat end t) + (while (and pat (re-search-forward pat end t)) (when (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) commit 79bbbb1fcf565d37f20353181df99f8b55cd2c4f Author: Po Lu Date: Fri May 6 12:06:16 2022 +0000 Improve font specs generated by the Haiku font dialog * src/haikufont.c (Fx_select_font): Use `nil' instead of `unspecified' to be consistent with other font dialogs. diff --git a/src/haikufont.c b/src/haikufont.c index f8cf45284d..e0db086aa0 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -1231,14 +1231,11 @@ in the font selection dialog. */) lfamily = build_string_from_utf8 (family); lweight = (pattern.specified & FSPEC_WEIGHT - ? haikufont_weight_to_lisp (pattern.weight) - : Qunspecified); + ? haikufont_weight_to_lisp (pattern.weight) : Qnil); lslant = (pattern.specified & FSPEC_SLANT - ? haikufont_slant_to_lisp (pattern.slant) - : Qunspecified); + ? haikufont_slant_to_lisp (pattern.slant) : Qnil); lwidth = (pattern.specified & FSPEC_WIDTH - ? haikufont_width_to_lisp (pattern.width) - : Qunspecified); + ? haikufont_width_to_lisp (pattern.width) : Qnil); ladstyle = (pattern.specified & FSPEC_STYLE ? intern (pattern.style) : Qnil); lsize = (size >= 0 ? make_fixnum (size) : Qnil); commit e41b7cc9353c63552219ff520da0adfef39157f2 Author: Lars Ingebrigtsen Date: Fri May 6 14:04:55 2022 +0200 Fix inhibiting reading the user init file with "emacs -x" * lisp/startup.el (command-line): Really inhibit loading the user init file with "emacs -x". diff --git a/lisp/startup.el b/lisp/startup.el index 57a38a295e..0b7d90ecf2 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1236,6 +1236,14 @@ please check its value") (t (setq argval nil argi orig-argi))))) + + ;; We handle "-scripteval" further down, but we have to + ;; inhibit loading the user init file first. (This is for + ;; "emacs -x" handling.) + (when (equal argi "-scripteval") + (setq init-file-user nil + noninteractive t)) + (cond ;; The --display arg is handled partly in C, partly in Lisp. ;; When it shows up here, we just put it back to be handled commit 44b5f0cd8732165747880109f7c5783534a3fbb0 Author: Lars Ingebrigtsen Date: Fri May 6 13:45:11 2022 +0200 Remove the P/N/M-p/M-n bindings from the general log-view map * lisp/vc/log-view.el (log-view-mode-map): Remove the P/N/M-p/M-n bindings (that are only usable in some VCs). * lisp/vc/vc-sccs.el (vc-sccs-log-view-mode): * lisp/vc/vc-rcs.el (vc-rcs-log-view-mode): * lisp/vc/vc-cvs.el (vc-cvs-log-view-mode): New modes that bind the P/N/M-p/M-n commands (bug#14531). diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 9952345db5..c773492c2d 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -134,11 +134,7 @@ "n" #'log-view-msg-next "p" #'log-view-msg-prev "TAB" #'log-view-msg-next - "" #'log-view-msg-prev - "N" #'log-view-file-next - "P" #'log-view-file-prev - "M-n" #'log-view-file-next - "M-p" #'log-view-file-prev) + "" #'log-view-msg-prev) (easy-menu-define log-view-mode-menu log-view-mode-map "Log-View Display Menu." diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 8f06d5a847..1f81ff2e0f 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -26,6 +26,7 @@ (require 'vc-rcs) (eval-when-compile (require 'vc)) +(require 'log-view) (declare-function vc-checkout "vc" (file &optional rev)) (declare-function vc-expand-dirs "vc" (file-or-dir-list backend)) @@ -1257,6 +1258,14 @@ ignore file." (if sort (sort-lines nil (point-min) (point-max))) (save-buffer))))) +(defvar-keymap vc-cvs-log-view-mode-map + "N" #'log-view-file-next + "P" #'log-view-file-prev + "M-n" #'log-view-file-next + "M-p" #'log-view-file-prev) + +(define-derived-mode vc-cvs-log-view-mode log-view-mode "CVS-Log-View") + (provide 'vc-cvs) ;;; vc-cvs.el ends here diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 170f5c8d46..0a2b8fa53c 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -40,6 +40,7 @@ (eval-when-compile (require 'cl-lib) (require 'vc)) +(require 'log-view) (declare-function vc-read-revision "vc" (prompt &optional files backend default initial-input)) @@ -1456,6 +1457,14 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." `((headers ,desc ,@headers) (revisions ,@revs))))) +(defvar-keymap vc-rcs-log-view-mode-map + "N" #'log-view-file-next + "P" #'log-view-file-prev + "M-n" #'log-view-file-next + "M-p" #'log-view-file-prev) + +(define-derived-mode vc-rcs-log-view-mode log-view-mode "RCS-Log-View") + (provide 'vc-rcs) ;;; vc-rcs.el ends here diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index 1035ee9ce9..9622bf5e09 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -27,6 +27,7 @@ (eval-when-compile (require 'vc)) +(require 'log-view) ;;; ;;; Customization options @@ -518,6 +519,14 @@ If NAME is nil or a revision number string it's just passed through." (file-name-directory (vc-master-name file)))) (vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1)))) +(defvar-keymap vc-sccs-log-view-mode-map + "N" #'log-view-file-next + "P" #'log-view-file-prev + "M-n" #'log-view-file-next + "M-p" #'log-view-file-prev) + +(define-derived-mode vc-sccs-log-view-mode log-view-mode "SCCS-Log-View") + (provide 'vc-sccs) ;;; vc-sccs.el ends here commit deb66cb32d94e1bef373b79ec099021c11065566 Author: Lars Ingebrigtsen Date: Fri May 6 13:30:12 2022 +0200 Don't override search-default-mode set by user in info/help * lisp/info.el (Info-mode): * lisp/help-mode.el (help-mode): Don't override isearch mode set by the user. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 38a2f93a3c..a0a587cd81 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -416,7 +416,8 @@ Commands: (setq-local help-mode--current-data nil) (setq-local bookmark-make-record-function #'help-bookmark-make-record) - (isearch-fold-quotes-mode)) + (unless search-default-mode + (isearch-fold-quotes-mode))) ;;;###autoload (defun help-mode-setup () diff --git a/lisp/info.el b/lisp/info.el index 0bdb2f2e7a..514cf7b3f4 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4491,7 +4491,8 @@ Advanced commands: (setq-local font-lock-defaults '(Info-mode-font-lock-keywords t t)) (Info-set-mode-line) (setq-local bookmark-make-record-function #'Info-bookmark-make-record) - (isearch-fold-quotes-mode)) + (unless search-default-mode + (isearch-fold-quotes-mode))) ;; When an Info buffer is killed, make sure the associated tags buffer ;; is killed too. commit 16dc1d597b70524782da58677a88135d20c1a617 Author: Lars Ingebrigtsen Date: Fri May 6 13:28:20 2022 +0200 Char-fold quotation characters in *info* and *Help* * lisp/info.el (Info-mode): * lisp/help-mode.el (help-mode): Use it. * lisp/isearch.el (isearch-fold-quotes-mode): New minor mode (bug#24510). diff --git a/etc/NEWS b/etc/NEWS index fa7e2c4dcc..f7dddd36de 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -136,6 +136,13 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 +--- +** Isearch in *Help* and *info* now char-folds quote characters by default. +This means that you can say 'C-s `foo' (GRAVE ACCENT) if the buffer +contains "‘foo" (LEFT SINGLE QUOTATION MARK) and the like. These +quotation characters look somewhat similar in some fonts. To switch +this off, disable the new 'isearch-fold-quotes-mode' minor mode. + --- ** Sorting commands no longer necessarily change modification status. In earlier Emacs versions, commands like 'M-x sort-lines' would always @@ -1636,6 +1643,12 @@ functions. * Lisp Changes in Emacs 29.1 +--- +*** New minor mode 'isearch-fold-quotes-mode'. +This sets up 'search-default-mode' so that quote characters are +char-folded into each other. It is used, by default, in *Help* and +*info* buffers. + +++ ** New macro 'buffer-local-set-state'. This is a helper macro to be used by minor modes that wish to restore diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 94bd591131..38a2f93a3c 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -415,7 +415,8 @@ Commands: help-mode-tool-bar-map) (setq-local help-mode--current-data nil) (setq-local bookmark-make-record-function - #'help-bookmark-make-record)) + #'help-bookmark-make-record) + (isearch-fold-quotes-mode)) ;;;###autoload (defun help-mode-setup () diff --git a/lisp/info.el b/lisp/info.el index abfb77b055..0bdb2f2e7a 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4490,7 +4490,8 @@ Advanced commands: (setq-local revert-buffer-function #'Info-revert-buffer-function) (setq-local font-lock-defaults '(Info-mode-font-lock-keywords t t)) (Info-set-mode-line) - (setq-local bookmark-make-record-function #'Info-bookmark-make-record)) + (setq-local bookmark-make-record-function #'Info-bookmark-make-record) + (isearch-fold-quotes-mode)) ;; When an Info buffer is killed, make sure the associated tags buffer ;; is killed too. diff --git a/lisp/isearch.el b/lisp/isearch.el index 8397bb95c6..b404efd42a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -4466,6 +4466,23 @@ CASE-FOLD non-nil means the search was case-insensitive." (isearch-search) (isearch-update)) + + +(defvar isearch-fold-quotes-mode--state) +(define-minor-mode isearch-fold-quotes-mode + "Minor mode to aid searching for \\=` characters in help modes." + :lighter "" + (if isearch-fold-quotes-mode + (setq-local isearch-fold-quotes-mode--state + (buffer-local-set-state + search-default-mode + (lambda (string &optional _lax) + (thread-last + (regexp-quote string) + (replace-regexp-in-string "`" "[`‘]") + (replace-regexp-in-string "'" "['’]"))))) + (buffer-local-restore-state isearch-fold-quotes-mode--state))) + (provide 'isearch) ;;; isearch.el ends here commit 3b088bbed217f4387dfd75df32ec8e92adc9da1d Author: Lars Ingebrigtsen Date: Fri May 6 13:21:07 2022 +0200 Regenerate ldefs-boot.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index a049f65e4d..c0a16f9198 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -1130,6 +1130,9 @@ consider all symbols (if they match PATTERN). Return list of symbols and documentation found. +The *Apropos* window will be selected if `help-window-select' is +non-nil. + \(fn PATTERN &optional DO-ALL)" t nil) (autoload 'apropos-library "apropos" "\ @@ -7685,6 +7688,12 @@ If NODISPLAY is non-nil, don't redisplay the article buffer. \(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil) +(autoload 'gnus-article-outlook-rearrange-citation "deuglify" "\ +Repair broken citations. +If NODISPLAY is non-nil, don't redisplay the article buffer. + +\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil) + (autoload 'gnus-outlook-deuglify-article "deuglify" "\ Full deuglify of broken Outlook (Express) articles. Treat \"smartquotes\", unwrap lines, repair attribution and @@ -7696,7 +7705,7 @@ article buffer. (autoload 'gnus-article-outlook-deuglify-article "deuglify" "\ Deuglify broken Outlook (Express) articles and redisplay." '(gnus-article-mode gnus-summary-mode) nil) -(register-definition-prefixes "deuglify" '("gnus-")) +(register-definition-prefixes "deuglify" '("gnus-outlook-")) ;;;*** @@ -8843,7 +8852,18 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). (function-put 'easy-mmode-defsyntax 'lisp-indent-function '1) -(register-definition-prefixes "easy-mmode" '("easy-mmode-")) +(autoload 'buffer-local-set-state--get "easy-mmode" "\ + + +\(fn PAIRS)" nil nil) + +(autoload 'buffer-local-restore-state "easy-mmode" "\ +Restore buffer local variable values in STATES. +STATES is an object returned by `buffer-local-set-state'. + +\(fn STATES)" nil nil) + +(register-definition-prefixes "easy-mmode" '("buffer-local-set-state" "easy-mmode-")) ;;;*** @@ -9230,6 +9250,11 @@ If regular expression is nil, repeat last search. Query replace FROM with TO in all files of a class tree. With prefix arg, process files of marked classes only. +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + \(fn FROM TO)" t nil) (autoload 'ebrowse-tags-search-member-use "ebrowse" "\ @@ -11613,7 +11638,13 @@ Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[fileloop-continue]. -For non-interactive use, superseded by `fileloop-initialize-replace'. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + +For non-interactive use, this is superseded by `fileloop-initialize-replace'. \(fn FROM TO &optional DELIMITED FILES)" t nil) @@ -13947,7 +13978,7 @@ and choose the directory as the fortune-file. Minimum set of parameters to filter for live (on-session) framesets. DO NOT MODIFY. See `frameset-filter-alist' for a full description.") -(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (parent-frame . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-system . :never)) frameset-session-filter-alist) "\ +(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (bottom . frameset-filter-shelve-param) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:bottom . frameset-filter-unshelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:left . frameset-filter-unshelve-param) (GUI:right . frameset-filter-unshelve-param) (GUI:top . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (left . frameset-filter-shelve-param) (parent-frame . :never) (mouse-wheel-frame . :never) (right . frameset-filter-shelve-param) (top . frameset-filter-shelve-param) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-system . :never)) frameset-session-filter-alist) "\ Parameters to filter for persistent framesets. DO NOT MODIFY. See `frameset-filter-alist' for a full description.") @@ -19265,7 +19296,10 @@ mode doesn't have any Info manuals known to Emacs, the command will prompt for MODE to use, with completion. With prefix arg, the command always prompts for MODE. -\(fn SYMBOL &optional MODE)" t nil) +Is SAME-WINDOW, try to reuse the current window instead of +popping up a new one. + +\(fn SYMBOL &optional MODE SAME-WINDOW)" t nil) (put 'info-lookup-file 'info-file "emacs") (autoload 'info-lookup-file "info-look" "\ @@ -20463,6 +20497,10 @@ sleep in seconds. (autoload 'linum-mode "linum" "\ Toggle display of line numbers in the left margin (Linum mode). +This mode has been largely replaced by `display-line-numbers-mode' +\(which is much faster and has fewer interaction problems with other +modes). + Linum mode is a buffer-local minor mode. This is a minor mode. If called interactively, toggle the `Linum @@ -24325,7 +24363,7 @@ Coloring: ;;;### (autoloads nil "org" "org/org.el" (0 0 0 0)) ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 5 2)) package--builtin-versions) +(push (purecopy '(org 9 5 3)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -25238,6 +25276,11 @@ to install it but still mark it as selected. \(fn PKG &optional DONT-SELECT)" t nil) +(autoload 'package-update "package" "\ +Update package NAME if a newer version exists. + +\(fn NAME)" t nil) + (autoload 'package-install-from-buffer "package" "\ Install a package from the current buffer. The current buffer is assumed to be a single .el or .tar file or @@ -26984,6 +27027,10 @@ command \\[fileloop-continue]. (autoload 'project-query-replace-regexp "project" "\ Query-replace REGEXP in all the files of the project. Stops when a match is found and prompts for whether to replace it. +At that prompt, the user must type a character saying what to do +with the match. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. If you exit the `query-replace', you can later continue the `query-replace' loop using the command \\[fileloop-continue]. @@ -32955,38 +33002,6 @@ Studlify-case the current buffer." t nil) ;;;### (autoloads nil "subr-x" "emacs-lisp/subr-x.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/subr-x.el -(autoload 'if-let "subr-x" "\ -Bind variables according to SPEC and evaluate THEN or ELSE. -Evaluate each binding in turn, as in `let*', stopping if a -binding value is nil. If all are non-nil return the value of -THEN, otherwise the last form in ELSE. - -Each element of SPEC is a list (SYMBOL VALUEFORM) that binds -SYMBOL to the value of VALUEFORM. An element can additionally be -of the form (VALUEFORM), which is evaluated and checked for nil; -i.e. SYMBOL can be omitted if only the test result is of -interest. It can also be of the form SYMBOL, then the binding of -SYMBOL is checked for nil. - -As a special case, interprets a SPEC of the form (SYMBOL SOMETHING) -like ((SYMBOL SOMETHING)). This exists for backward compatibility -with an old syntax that accepted only one binding. - -\(fn SPEC THEN &rest ELSE)" nil t) - -(function-put 'if-let 'lisp-indent-function '2) - -(autoload 'when-let "subr-x" "\ -Bind variables according to SPEC and conditionally evaluate BODY. -Evaluate each binding in turn, stopping if a binding value is nil. -If all are non-nil, return the value of the last form in BODY. - -The variable list SPEC is the same as in `if-let'. - -\(fn SPEC &rest BODY)" nil t) - -(function-put 'when-let 'lisp-indent-function '1) - (autoload 'string-truncate-left "subr-x" "\ Truncate STRING to LENGTH, replacing initial surplus with \"...\". @@ -33026,7 +33041,7 @@ Query the user for a process and return the process object. \(fn PROMPT)" nil nil) -(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "named-let" "replace-region-contents" "string-" "thread-" "when-let*" "with-memoization")) +(register-definition-prefixes "subr-x" '("hash-table-" "internal--thread-argument" "named-let" "replace-region-contents" "string-" "thread-" "with-")) ;;;*** commit b6bced1a66969e7645f96c36030eb4e9d90a6dc0 Author: Lars Ingebrigtsen Date: Fri May 6 13:20:47 2022 +0200 Autoload the buffer-local-set* things * lisp/emacs-lisp/easy-mmode.el (buffer-local-set-state--get) (buffer-local-restore-state): Autoload. Perhaps it would be better to move these functions to subr.el or something... diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 33c0472ea8..bade14ec3d 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -839,6 +839,7 @@ restore the state. (buffer-local-set-state--get ',pairs) (setq-local ,@pairs))) +;;;###autoload (defun buffer-local-set-state--get (pairs) (let ((states nil)) (while pairs @@ -851,6 +852,7 @@ restore the state. (setq pairs (cddr pairs))) (nreverse states))) +;;;###autoload (defun buffer-local-restore-state (states) "Restore buffer local variable values in STATES. STATES is an object returned by `buffer-local-set-state'." commit b13356487fc3eaf82bfe51bee24ddf70c27c5834 Author: Lars Ingebrigtsen Date: Fri May 6 13:10:45 2022 +0200 Add new helper macros for minor modes to restore variables * doc/lispref/modes.texi (Defining Minor Modes): Document it. * lisp/emacs-lisp/easy-mmode.el (buffer-local-set-state): New macro. (buffer-local-set-state--get): Helper function. (buffer-local-restore-state): New function. * lisp/textmodes/word-wrap-mode.el (word-wrap-whitespace-mode): Use it to simplify code. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ff09a78749..bfd9724173 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1912,6 +1912,15 @@ This means ``use in modes derived from @code{text-mode}, but nowhere else''. (There's an implicit @code{nil} element at the end.) @end defmac +@defmac buffer-local-set-state variable value... +Minor modes often set buffer-local variables that alters some features +in Emacs. When a minor mode is switched off, the mode is expected to +restore the previous state of these variables. This convenience macro +helps with doing that: It works much like @code{setq-local}, but +returns an object that can be used to restore these values back to +their previous values/states (with the +@code{buffer-local-restore-state} function). +@end defmac @node Mode Line Format @section Mode Line Format diff --git a/etc/NEWS b/etc/NEWS index 6637eda00c..fa7e2c4dcc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1636,6 +1636,12 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** New macro 'buffer-local-set-state'. +This is a helper macro to be used by minor modes that wish to restore +buffer-local variables back to their original states when the mode is +switched off. + --- ** New macro 'with-buffer-unmodified-if-unchanged'. If the buffer is marked as unmodified, and code does modifications diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 8a76eaf58c..33c0472ea8 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -825,6 +825,39 @@ Interactively, COUNT is the prefix numeric argument, and defaults to 1." ,@body)) (put ',prev-sym 'definition-name ',base)))) + +(defmacro buffer-local-set-state (&rest pairs) + "Like `setq-local', but return an object that allows restoring previous state. +Use `buffer-local-restore-state' on the returned object to +restore the state. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + `(prog1 + (buffer-local-set-state--get ',pairs) + (setq-local ,@pairs))) + +(defun buffer-local-set-state--get (pairs) + (let ((states nil)) + (while pairs + (push (list (car pairs) + (and (boundp (car pairs)) + (local-variable-p (car pairs))) + (and (boundp (car pairs)) + (symbol-value (car pairs)))) + states) + (setq pairs (cddr pairs))) + (nreverse states))) + +(defun buffer-local-restore-state (states) + "Restore buffer local variable values in STATES. +STATES is an object returned by `buffer-local-set-state'." + (pcase-dolist (`(,variable ,local ,value) states) + (if local + (set variable value) + (kill-local-variable variable)))) (provide 'easy-mmode) diff --git a/lisp/textmodes/word-wrap-mode.el b/lisp/textmodes/word-wrap-mode.el index 1459a3395c..c354fc773a 100644 --- a/lisp/textmodes/word-wrap-mode.el +++ b/lisp/textmodes/word-wrap-mode.el @@ -60,26 +60,15 @@ The characters to break on are defined by `word-wrap-whitespace-characters'." (if word-wrap-whitespace-mode (progn (setq-local word-wrap-mode--previous-state - (list (category-table) - (local-variable-p 'word-wrap-by-category) - word-wrap-by-category - (local-variable-p 'word-wrap) - word-wrap)) + (cons (category-table) + (buffer-local-set-state + word-wrap-by-category t + word-wrap t))) (set-category-table (copy-category-table)) (dolist (char word-wrap-whitespace-characters) - (modify-category-entry char ?|)) - (setq-local word-wrap-by-category t - word-wrap t)) - (pcase-let ((`(,table ,lby-cat ,by-cat - ,lwrap ,wrap) - word-wrap-mode--previous-state)) - (if lby-cat - (setq-local word-wrap-by-category by-cat) - (kill-local-variable 'word-wrap-by-category)) - (if lwrap - (setq-local word-wrap wrap) - (kill-local-variable 'word-wrap)) - (set-category-table table)))) + (modify-category-entry char ?|))) + (set-category-table (car word-wrap-mode--previous-state)) + (buffer-local-restore-state (cdr word-wrap-mode--previous-state)))) ;;;###autoload (define-globalized-minor-mode global-word-wrap-whitespace-mode diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el b/test/lisp/emacs-lisp/easy-mmode-tests.el index 0a3bbb189b..697bf6c215 100644 --- a/test/lisp/emacs-lisp/easy-mmode-tests.el +++ b/test/lisp/emacs-lisp/easy-mmode-tests.el @@ -60,6 +60,16 @@ (easy-mmode-test-mode 'toggle) (should (eq easy-mmode-test-mode t)))) -(provide 'easy-mmode-tests) +(ert-deftest test-local-set-state () + (setq global 1) + (with-temp-buffer + (setq-local local 2) + (let ((state (buffer-local-set-state global 10 + local 20 + unexist 30))) + (buffer-local-restore-state state) + (should (= global 1)) + (should (= local 2)) + (should-not (boundp 'unexist))))) ;;; easy-mmode-tests.el ends here commit 0bda1803bb83de41d4f1d55ee3e2437f2177c076 Author: Michael Albinus Date: Fri May 6 10:37:57 2022 +0200 Fix thinko in tramp-skeleton-write-region * lisp/net/tramp.el (tramp-skeleton-write-region): Fix typos. Flush cache in time. (Bug#55247) (tramp-handle-lock-file): Suppress messages in `write-region'. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b889f1f884..34f256147b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3377,83 +3377,80 @@ BODY is the backend specific code." "Skeleton for `tramp-*-handle-write-region'. BODY is the backend specific code." (declare (indent 7) (debug t)) - `(with-parsed-tramp-file-name (expand-file-name ,filename) nil - (setq ,filename (expand-file-name ,filename) - ,lockname (file-truename (or ,lockname ,filename))) - ;; Sometimes, there is another file name handler responsible for - ;; VISIT, for example `jka-compr-handler'. We must respect this. - ;; See Bug#55166. - (let ((handler (and (stringp ,visit) - (let ((inhibit-file-name-handlers - (cons 'tramp-file-name-handler - inhibit-file-name-handlers)) - (inhibit-file-name-operation 'write-region)) - (find-file-name-handler ,visit 'write-region))))) + ;; Sometimes, there is another file name handler responsible for + ;; VISIT, for example `jka-compr-handler'. We must respect this. + ;; See Bug#55166. + `(let* ((filename (expand-file-name ,filename)) + (lockname (file-truename (or ,lockname filename))) + (handler (and (stringp ,visit) + (let ((inhibit-file-name-handlers + (cons 'tramp-file-name-handler + inhibit-file-name-handlers)) + (inhibit-file-name-operation 'write-region)) + (find-file-name-handler ,visit 'write-region))))) + (with-parsed-tramp-file-name filename nil (if handler (progn (tramp-message v 5 "Calling handler `%s' for visiting `%s'" handler ,visit) (funcall handler 'write-region - ,start ,end ,filename ,append ,visit ,lockname ,mustbenew)) + ,start ,end filename ,append ,visit lockname ,mustbenew)) - (when (and ,mustbenew (file-exists-p ,filename) + (when (and ,mustbenew (file-exists-p filename) (or (eq ,mustbenew 'excl) (not (y-or-n-p (format - "File %s exists; overwrite anyway?" ,filename))))) - (tramp-error v 'file-already-exists ,filename)) + "File %s exists; overwrite anyway?" filename))))) + (tramp-error v 'file-already-exists filename)) - (let ((file-locked (eq (file-locked-p ,lockname) t)) + (let ((file-locked (eq (file-locked-p lockname) t)) (uid (or (file-attribute-user-id - (file-attributes ,filename 'integer)) + (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) (gid (or (file-attribute-group-id - (file-attributes ,filename 'integer)) + (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer))) (curbuf (current-buffer))) ;; Lock file. (when (and (not (auto-save-file-name-p - (file-name-nondirectory ,filename))) - (file-remote-p ,lockname) + (file-name-nondirectory filename))) + (file-remote-p lockname) (not file-locked)) (setq file-locked t) ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file ,lockname)) + (tramp-compat-funcall 'lock-file lockname)) ;; The body. ,@body + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + ;; We must protect `last-coding-system-used', now we have ;; set it to its correct value. - (let (last-coding-system-used (need-chown t)) + (let (last-coding-system-used) ;; Set file modification time. (when (or (eq ,visit t) (stringp ,visit)) - (let ((file-attr (file-attributes ,filename 'integer))) + (when-let ((file-attr (file-attributes filename 'integer))) (set-visited-file-modtime ;; We must pass modtime explicitly, because FILENAME ;; can be different from (buffer-file-name), f.e. if ;; `file-precious-flag' is set. (or (file-attribute-modification-time file-attr) (current-time))) - (when (and (= (file-attribute-user-id file-attr) uid) - (= (file-attribute-group-id file-attr) gid)) - (setq need-chown nil)))) - - ;; Set the ownership. - (when need-chown - (tramp-set-file-uid-gid ,filename uid gid))) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) + ;; Set the ownership. + (unless (and (= (file-attribute-user-id file-attr) uid) + (= (file-attribute-group-id file-attr) gid)) + (tramp-set-file-uid-gid filename uid gid))))) ;; Unlock file. (when file-locked ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file ,lockname)) + (tramp-compat-funcall 'unlock-file lockname)) ;; Sanity check. (unless (equal curbuf (current-buffer)) @@ -3463,7 +3460,7 @@ BODY is the backend specific code." (when (and (null noninteractive) (or (eq ,visit t) (string-or-null-p ,visit))) - (tramp-message v 0 "Wrote %s" ,filename)) + (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook)))))) (put #'tramp-skeleton-write-region 'tramp-suppress-trace t) @@ -4366,7 +4363,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (make-symbolic-link info lockname 'ok-if-already-exists) (error (with-file-modes #o0644 - (write-region info nil lockname))))))))) + (write-region info nil lockname nil 'no-message))))))))) (defun tramp-handle-make-lock-file-name (file) "Like `make-lock-file-name' for Tramp files." commit ded4413acc6a894bd47736672cceb960bf0fad7d Author: Po Lu Date: Fri May 6 07:28:23 2022 +0000 Fix calculation of display resolution on Haiku * src/haiku_support.cc (BScreen_px_dim): Rename to `be_get_screen_dimensions'. (BScreen_res): Rename to `be_get_display_resolution' and fix resolution computation. * src/haiku_support.h: Update prototypes. * src/haikufns.c (compute_tip_xy, Fx_display_pixel_width) (Fx_display_pixel_height, Fx_display_mm_height) (Fx_display_mm_width): Update accordingly. * src/haikuterm.c (haiku_term_init): Likewise. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 0ab31bc98d..b8fa963c62 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -3265,15 +3265,18 @@ BWindow_activate (void *window) /* Return the pixel dimensions of the main screen in WIDTH and HEIGHT. */ void -BScreen_px_dim (int *width, int *height) +be_get_screen_dimensions (int *width, int *height) { BScreen screen; + BRect frame; + if (!screen.IsValid ()) gui_abort ("Invalid screen"); - BRect frame = screen.Frame (); - *width = frame.right - frame.left; - *height = frame.bottom - frame.top; + frame = screen.Frame (); + + *width = 1 + frame.right - frame.left; + *height = 1 + frame.bottom - frame.top; } /* Resize VIEW to WIDTH, HEIGHT. */ @@ -4129,25 +4132,32 @@ BAlert_delete (void *alert) delete (BAlert *) alert; } -/* Place the resolution of the monitor in DPI in RSSX and RSSY. */ +/* Place the resolution of the monitor in DPI in X_OUT and Y_OUT. */ void -BScreen_res (double *rrsx, double *rrsy) +be_get_display_resolution (double *x_out, double *y_out) { BScreen s (B_MAIN_SCREEN_ID); + monitor_info i; + double x_inches, y_inches; + BRect frame; + if (!s.IsValid ()) gui_abort ("Invalid screen for resolution checks"); - monitor_info i; if (s.GetMonitorInfo (&i) == B_OK) { - *rrsx = (double) i.width / (double) 2.54; - *rrsy = (double) i.height / (double) 2.54; - } - else - { - *rrsx = 72.27; - *rrsy = 72.27; + frame = s.Frame (); + + x_inches = (double) i.width * 25.4; + y_inches = (double) i.height * 25.4; + + *x_out = (double) BE_RECT_WIDTH (frame) / x_inches; + *y_out = (double) BE_RECT_HEIGHT (frame) / y_inches; + return; } + + *x_out = 72.0; + *y_out = 72.0; } /* Add WINDOW to OTHER_WINDOW's subset and parent it to diff --git a/src/haiku_support.h b/src/haiku_support.h index 0fe2af3329..1433783c9f 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -549,8 +549,8 @@ extern void BView_scroll_bar_update (void *, int, int, int, int, bool); extern void *BBitmap_transform_bitmap (void *, void *, uint32_t, double, int, int); -extern void BScreen_px_dim (int *, int *); -extern void BScreen_res (double *, double *); +extern void be_get_display_resolution (double *, double *); +extern void be_get_screen_dimensions (int *, int *); /* Functions for creating and freeing cursors. */ extern void *BCursor_create_default (void); diff --git a/src/haikufns.c b/src/haikufns.c index e88ded23ff..2f26623fa5 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1203,7 +1203,11 @@ compute_tip_xy (struct frame *f, /* Default min and max values. */ min_x = 0; min_y = 0; - BScreen_px_dim (&max_x, &max_y); + + be_get_screen_dimensions (&max_x, &max_y); + + max_x = max_x - 1; + max_y = max_y - 1; block_input (); BView_get_mouse (FRAME_HAIKU_VIEW (f), &x, &y); @@ -1917,7 +1921,7 @@ DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, int width, height; check_haiku_display_info (terminal); - BScreen_px_dim (&width, &height); + be_get_screen_dimensions (&width, &height); return make_fixnum (width); } @@ -1930,7 +1934,7 @@ DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_heigh int width, height; check_haiku_display_info (terminal); - BScreen_px_dim (&width, &height); + be_get_screen_dimensions (&width, &height); return make_fixnum (width); } @@ -1941,7 +1945,7 @@ DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); int width, height; - BScreen_px_dim (&width, &height); + be_get_screen_dimensions (&width, &height); return make_fixnum (height / (dpyinfo->resy / 25.4)); } @@ -1953,7 +1957,7 @@ DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); int width, height; - BScreen_px_dim (&width, &height); + be_get_screen_dimensions (&width, &height); return make_fixnum (width / (dpyinfo->resx / 25.4)); } diff --git a/src/haikuterm.c b/src/haikuterm.c index b903e017e4..ced16d9f09 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3939,9 +3939,9 @@ haiku_term_init (void) dpyinfo->display = BApplication_setup (); dpyinfo->next = x_display_list; dpyinfo->n_planes = be_get_display_planes (); - x_display_list = dpyinfo; + be_get_display_resolution (&dpyinfo->resx, &dpyinfo->resy); - BScreen_res (&dpyinfo->resx, &dpyinfo->resy); + x_display_list = dpyinfo; terminal = haiku_create_terminal (dpyinfo); if (current_kboard == initial_kboard) commit 5bfac7c7747895c9d743d2a0edd25cb4317ea629 Author: Eli Zaretskii Date: Fri May 6 10:27:20 2022 +0300 Provide reference for OTF tags in the ELisp manual * doc/lispref/display.texi (Low-Level Font): Provide the canonical reference URL for OTF tags. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index d9e93160ea..61aca5b88a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3866,7 +3866,10 @@ required; and @code{gpos} is a list of OpenType GPOS feature tag symbols, or @code{nil} if none is required. If @code{gsub} or @code{gpos} is a list, a @code{nil} element in that list means that the font must not match any of the remaining tag symbols. The -@code{gpos} element may be omitted. +@code{gpos} element may be omitted. For the list of OpenType script, +language, and feature tags, see +@uref{https://docs.microsoft.com/en-us/typography/opentype/spec/ttoreg, +the list of registered OTF tags}. @item :type @cindex font backend commit 7609c6cadb071df8eeded71263c66c5ca94860b3 Merge: 8fe3d46d35 69c56cbe6e Author: Stefan Kangas Date: Fri May 6 06:30:28 2022 +0200 Merge from origin/emacs-28 69c56cbe6e ; * src/w32notify.c: Fix a typo in a comment. 3b9e60ba2f ; * src/window.c (Fset_window_start): Mention the effect o... commit 8fe3d46d35b7cb876c2b50048eb709c086c5d45a Author: Po Lu Date: Fri May 6 04:11:38 2022 +0000 Fix more problems with display of composite glyph strings on Haiku * src/haikuterm.c (haiku_draw_composite_glyph_string_foreground): Fix pen size of placeholder rectangle. diff --git a/src/haikuterm.c b/src/haikuterm.c index 341288133e..b903e017e4 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1349,6 +1349,8 @@ haiku_draw_composite_glyph_string_foreground (struct glyph_string *s) BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); else BView_SetHighColor (view, s->face->foreground); + + BView_SetPenSize (view, 1); BView_StrokeRectangle (view, s->x, s->y, s->width, s->height); } commit f515ff05e086e74b203b91fb4fba319e24e0fb54 Author: Po Lu Date: Fri May 6 11:55:35 2022 +0800 Fix mouse face persisting inside Lucid menus on XI2 * src/xmenu.c (create_and_show_popup_menu): Call `x_mouse_leave' on Lucid as well when the input extension is being used. * src/xterm.c (x_mouse_leave): Enable on Lucid XI2 builds. * src/xterm.h: Update prototypes. diff --git a/src/xmenu.c b/src/xmenu.c index 0dbc8058f9..4c8828412d 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1844,6 +1844,11 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, #ifdef HAVE_XINPUT2 prepare_for_entry_into_toolkit_menu (f); + +#ifdef USE_LUCID + if (dpyinfo->supports_xi2) + x_mouse_leave (dpyinfo); +#endif #endif /* Display the menu. */ lw_popup_menu (menu, &dummy); diff --git a/src/xterm.c b/src/xterm.c index 1f3e44c553..6b5c272ef9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10333,12 +10333,21 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, } -#if !defined USE_X_TOOLKIT && !defined USE_GTK +#if (defined USE_LUCID && defined HAVE_XINPUT2) \ + || (!defined USE_X_TOOLKIT && !defined USE_GTK) /* Handle an event saying the mouse has moved out of an Emacs frame. */ void x_mouse_leave (struct x_display_info *dpyinfo) { + Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; + + if (hlinfo->mouse_face_mouse_frame) + { + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = NULL; + } + x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame); } #endif diff --git a/src/xterm.h b/src/xterm.h index 74e6d1a96c..3e06564bee 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1386,7 +1386,8 @@ extern bool x_alloc_lighter_color_for_widget (Widget, Display *, Colormap, extern bool x_alloc_nearest_color (struct frame *, Colormap, XColor *); extern void x_query_colors (struct frame *f, XColor *, int); extern void x_clear_area (struct frame *f, int, int, int, int); -#if !defined USE_X_TOOLKIT && !defined USE_GTK +#if (defined USE_LUCID && defined HAVE_XINPUT2) \ + || (!defined USE_X_TOOLKIT && !defined USE_GTK) extern void x_mouse_leave (struct x_display_info *); #endif commit d6b5ac0f949b08cab78921b1d95a47ca0a95bc36 Author: Po Lu Date: Fri May 6 11:32:19 2022 +0800 * lwlib/lwlib.c (lw_separator_p): Fix empty strings being separators. diff --git a/lwlib/lwlib.c b/lwlib/lwlib.c index 30546b60e5..863f65c915 100644 --- a/lwlib/lwlib.c +++ b/lwlib/lwlib.c @@ -1324,10 +1324,14 @@ lw_separator_p (const char *label, enum menu_separator *type, int motif_p) { /* Old-style separator, maybe. It's a separator if it contains only dashes. */ - while (*label == '-') - ++label; - separator_p = *label == 0; - *type = SEPARATOR_SHADOW_ETCHED_IN; + if (*label == '-') + { + while (*label == '-') + ++label; + separator_p = *label == 0; + + *type = SEPARATOR_SHADOW_ETCHED_IN; + } } return separator_p; commit e379d2e8c18e8d9a0f859a8d90621fc898a9caf7 Author: Po Lu Date: Fri May 6 11:01:39 2022 +0800 Fix menu dismissal problems on Xt builds with XI2 * src/xmenu.c (prepare_for_entry_into_toolkit_menu) (leave_toolkit_menu): New functions. (create_and_show_popup_menu): Replace some of the grab logic with resetting the XI event mask instead. diff --git a/src/xmenu.c b/src/xmenu.c index 418628d491..0dbc8058f9 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1618,6 +1618,84 @@ popup_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) menu_item_selection = client_data; } + +#ifdef HAVE_XINPUT2 +static void +prepare_for_entry_into_toolkit_menu (struct frame *f) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + Lisp_Object tail, frame; + struct x_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (!dpyinfo->supports_xi2) + return; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + + if (FRAME_X_P (f) + && FRAME_DISPLAY_INFO (f) == dpyinfo + && !FRAME_TOOLTIP_P (f)) + XISelectEvents (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + &mask, 1); + } +} + +static void +leave_toolkit_menu (void *data) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + Lisp_Object tail, frame; + struct x_display_info *dpyinfo; + struct frame *f; + + dpyinfo = FRAME_DISPLAY_INFO ((struct frame *) data); + + if (!dpyinfo->supports_xi2) + return; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + + if (FRAME_X_P (f) + && FRAME_DISPLAY_INFO (f) == dpyinfo + && !FRAME_TOOLTIP_P (f)) + XISelectEvents (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + &mask, 1); + } +} +#endif + /* ID is the LWLIB ID of the dialog box. */ static void @@ -1720,11 +1798,9 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, #ifdef HAVE_XINPUT2 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); - bool any_xi_grab_p = false; /* Clear the XI2 grab, and if any XI2 grab was set, place a core grab on the frame's edit widget. */ - if (dpyinfo->supports_xi2) XGrabServer (dpyinfo->display); @@ -1735,7 +1811,6 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, { if (dpyinfo->devices[i].grab) { - any_xi_grab_p = true; dpyinfo->devices[i].grab = 0; XIUngrabDevice (dpyinfo->display, @@ -1745,20 +1820,6 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, } } - if (any_xi_grab_p) - { -#ifndef USE_MOTIF - XGrabPointer (dpyinfo->display, - FRAME_X_WINDOW (f), - False, (PointerMotionMask - | PointerMotionHintMask - | ButtonReleaseMask - | ButtonPressMask), - GrabModeSync, GrabModeAsync, - None, None, CurrentTime); -#endif - } - #ifdef USE_MOTIF if (dpyinfo->supports_xi2) { @@ -1781,6 +1842,9 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, #endif #endif +#ifdef HAVE_XINPUT2 + prepare_for_entry_into_toolkit_menu (f); +#endif /* Display the menu. */ lw_popup_menu (menu, &dummy); @@ -1791,17 +1855,15 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, popup_activated_flag = 1; -#if defined HAVE_XINPUT2 && !defined USE_MOTIF - if (any_xi_grab_p) - XAllowEvents (dpyinfo->display, AsyncPointer, CurrentTime); -#endif - x_activate_timeout_atimer (); { specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_int (pop_down_menu, (int) menu_id); +#ifdef HAVE_XINPUT2 + record_unwind_protect_ptr (leave_toolkit_menu, f); +#endif /* Process events that apply to the menu. */ popup_get_selection (0, FRAME_DISPLAY_INFO (f), menu_id, true); commit e2fcbd8dbd091bb72915297c92a801cbe66f13c9 Author: Po Lu Date: Fri May 6 09:35:23 2022 +0800 Fix more issues with DND state on multiple displays * src/xterm.c (handle_one_xevent): Don't update DND state on the wrong display. diff --git a/src/xterm.c b/src/xterm.c index 74dfc10044..1f3e44c553 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15002,7 +15002,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, popup_activated_flag = 1; #endif - if (x_dnd_in_progress) + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); if (x_dnd_in_progress && x_dnd_use_toplevels @@ -16267,7 +16268,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, } - if (x_dnd_in_progress) + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); goto OTHER; @@ -16651,7 +16653,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case CirculateNotify: - if (x_dnd_in_progress) + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); goto OTHER; commit d5c1fec6abf046dad5d7318d9c6fa3a9fae13dea Author: Po Lu Date: Fri May 6 08:39:14 2022 +0800 Improve safety of DND when Emacs is connected to multiple displays * src/xterm.c (x_dnd_begin_drag_and_drop): Don't check movement frame unless we know it comes from the right display. diff --git a/src/xterm.c b/src/xterm.c index 80d34c114d..74dfc10044 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10035,116 +10035,133 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, unblock_input (); pending_signals = signals_were_pending; - if (x_dnd_movement_frame) - { - XSETFRAME (frame_object, x_dnd_movement_frame); - XSETINT (x, x_dnd_movement_x); - XSETINT (y, x_dnd_movement_y); - x_dnd_movement_frame = NULL; - - if (!NILP (Vx_dnd_movement_function) - && !FRAME_TOOLTIP_P (XFRAME (frame_object)) - && x_dnd_movement_x >= 0 - && x_dnd_movement_y >= 0 - && x_dnd_frame - && (XFRAME (frame_object) != x_dnd_frame - || x_dnd_allow_current_frame)) - { - x_dnd_old_window_attrs = root_window_attrs; - x_dnd_unwind_flag = true; - - ref = SPECPDL_INDEX (); - record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); - call2 (Vx_dnd_movement_function, frame_object, - Fposn_at_x_y (x, y, frame_object, Qnil)); - x_dnd_unwind_flag = false; - unbind_to (ref, Qnil); - } - } - - if (hold_quit.kind != NO_EVENT) + /* Ignore mouse movement from displays that aren't the DND + display. */ +#ifndef USE_GTK + if (event_display == FRAME_DISPLAY_INFO (f)) { - if (hold_quit.kind == SELECTION_REQUEST_EVENT) +#endif + if (x_dnd_movement_frame) { - x_dnd_old_window_attrs = root_window_attrs; - x_dnd_unwind_flag = true; - - ref = SPECPDL_INDEX (); - record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); - x_handle_selection_event ((struct selection_input_event *) &hold_quit); - x_dnd_unwind_flag = false; - unbind_to (ref, Qnil); - continue; + XSETFRAME (frame_object, x_dnd_movement_frame); + XSETINT (x, x_dnd_movement_x); + XSETINT (y, x_dnd_movement_y); + x_dnd_movement_frame = NULL; + + if (!NILP (Vx_dnd_movement_function) + && !FRAME_TOOLTIP_P (XFRAME (frame_object)) + && x_dnd_movement_x >= 0 + && x_dnd_movement_y >= 0 + && x_dnd_frame + && (XFRAME (frame_object) != x_dnd_frame + || x_dnd_allow_current_frame)) + { + x_dnd_old_window_attrs = root_window_attrs; + x_dnd_unwind_flag = true; + + ref = SPECPDL_INDEX (); + record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); + call2 (Vx_dnd_movement_function, frame_object, + Fposn_at_x_y (x, y, frame_object, Qnil)); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + } } - if (x_dnd_in_progress) + if (hold_quit.kind != NO_EVENT) { - if (x_dnd_last_seen_window != None - && x_dnd_last_protocol_version != -1) - x_dnd_send_leave (f, x_dnd_last_seen_window); - else if (x_dnd_last_seen_window != None - && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) - && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE - && x_dnd_motif_setup_p) + if (hold_quit.kind == SELECTION_REQUEST_EVENT) { - dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, - XM_DRAG_REASON_DROP_START); - dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; - dmsg.timestamp = hold_quit.timestamp; - dmsg.side_effects - = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), - x_dnd_wanted_action), - XM_DROP_SITE_VALID, - xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), - x_dnd_wanted_action), - XM_DROP_ACTION_DROP_CANCEL); - dmsg.x = 0; - dmsg.y = 0; - dmsg.index_atom = FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection; - dmsg.source_window = FRAME_X_WINDOW (f); - - x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, - x_dnd_last_seen_window, - hold_quit.timestamp); - xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), - x_dnd_last_seen_window, &dmsg); + x_dnd_old_window_attrs = root_window_attrs; + x_dnd_unwind_flag = true; + + ref = SPECPDL_INDEX (); + record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); + x_handle_selection_event ((struct selection_input_event *) &hold_quit); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + continue; } - x_dnd_end_window = x_dnd_last_seen_window; - x_dnd_last_seen_window = None; - x_dnd_last_seen_toplevel = None; - x_dnd_in_progress = false; - x_dnd_frame = NULL; - } + if (x_dnd_in_progress) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.timestamp = hold_quit.timestamp; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, + hold_quit.timestamp); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } - x_set_dnd_targets (NULL, 0); - x_dnd_waiting_for_finish = false; + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } - if (x_dnd_use_toplevels) - x_dnd_free_toplevels (); + x_set_dnd_targets (NULL, 0); + x_dnd_waiting_for_finish = false; - x_dnd_return_frame_object = NULL; - x_dnd_movement_frame = NULL; + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (); + + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; - FRAME_DISPLAY_INFO (f)->grabbed = 0; + FRAME_DISPLAY_INFO (f)->grabbed = 0; #ifdef USE_GTK - current_hold_quit = NULL; + current_hold_quit = NULL; #endif - /* Restore the old event mask. */ - XSelectInput (FRAME_X_DISPLAY (f), - FRAME_DISPLAY_INFO (f)->root_window, - root_window_attrs.your_event_mask); + /* Restore the old event mask. */ + XSelectInput (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + root_window_attrs.your_event_mask); #ifdef HAVE_XKB - if (FRAME_DISPLAY_INFO (f)->supports_xkb) - XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, - XkbStateNotifyMask, 0); + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); #endif - /* Delete the Motif drag initiator info if it was set up. */ - if (x_dnd_motif_setup_p) - XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection); - quit (); + /* Delete the Motif drag initiator info if it was set up. */ + if (x_dnd_motif_setup_p) + XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection); + quit (); + } +#ifndef USE_GTK + } + else + { + if (x_dnd_movement_frame) + x_dnd_movement_frame = NULL; + + if (hold_quit.kind != NO_EVENT) + EVENT_INIT (hold_quit); } +#endif } x_set_dnd_targets (NULL, 0); commit 9007e10a0fc94190404c6a988f7d52d162901940 Author: Paul Eggert Date: Thu May 5 15:36:33 2022 -0700 Gnulib update via admin/merge-gnulib diff --git a/lib/cdefs.h b/lib/cdefs.h index cb2514504f..7b8ed5b344 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -164,13 +164,13 @@ || (__builtin_constant_p (__l) && (__l) > 0)) /* Length is known to be safe at compile time if the __L * __S <= __OBJSZ - condition can be folded to a constant and if it is true. The -1 check is - redundant because since it implies that __glibc_safe_len_cond is true. */ + condition can be folded to a constant and if it is true, or unknown (-1) */ #define __glibc_safe_or_unknown_len(__l, __s, __osz) \ - (__glibc_unsigned_or_positive (__l) \ - && __builtin_constant_p (__glibc_safe_len_cond ((__SIZE_TYPE__) (__l), \ - __s, __osz)) \ - && __glibc_safe_len_cond ((__SIZE_TYPE__) (__l), __s, __osz)) + ((__osz) == (__SIZE_TYPE__) -1 \ + || (__glibc_unsigned_or_positive (__l) \ + && __builtin_constant_p (__glibc_safe_len_cond ((__SIZE_TYPE__) (__l), \ + (__s), (__osz))) \ + && __glibc_safe_len_cond ((__SIZE_TYPE__) (__l), (__s), (__osz)))) /* Conversely, we know at compile time that the length is unsafe if the __L * __S <= __OBJSZ condition can be folded to a constant and if it is diff --git a/lib/libc-config.h b/lib/libc-config.h index 8fec489378..a56665b1ce 100644 --- a/lib/libc-config.h +++ b/lib/libc-config.h @@ -121,6 +121,7 @@ # undef __attr_dealloc # undef __attr_dealloc_free # undef __attribute__ +# undef __attribute_alloc_align__ # undef __attribute_alloc_size__ # undef __attribute_artificial__ # undef __attribute_const__ @@ -129,6 +130,7 @@ # undef __attribute_format_arg__ # undef __attribute_format_strfmon__ # undef __attribute_malloc__ +# undef __attribute_maybe_unused__ # undef __attribute_noinline__ # undef __attribute_nonstring__ # undef __attribute_pure__ @@ -142,16 +144,24 @@ # undef __extern_always_inline # undef __extern_inline # undef __flexarr +# undef __fortified_attr_access # undef __fortify_function # undef __glibc_c99_flexarr_available +# undef __glibc_fortify +# undef __glibc_fortify_n # undef __glibc_has_attribute # undef __glibc_has_builtin # undef __glibc_has_extension +# undef __glibc_likely # undef __glibc_macro_warning # undef __glibc_macro_warning1 # undef __glibc_objsize # undef __glibc_objsize0 +# undef __glibc_safe_len_cond +# undef __glibc_safe_or_unknown_len # undef __glibc_unlikely +# undef __glibc_unsafe_len +# undef __glibc_unsigned_or_positive # undef __inline # undef __ptr_t # undef __restrict @@ -159,6 +169,7 @@ # undef __va_arg_pack # undef __va_arg_pack_len # undef __warnattr +# undef __wur /* Include our copy of glibc . */ # include diff --git a/lib/md5.h b/lib/md5.h index 5b92eac5ec..611c230b81 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -24,6 +24,9 @@ #include # if HAVE_OPENSSL_MD5 +# ifndef OPENSSL_API_COMPAT +# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ +# endif # include # endif diff --git a/lib/regcomp.c b/lib/regcomp.c index b607c85320..122c3de58c 100644 --- a/lib/regcomp.c +++ b/lib/regcomp.c @@ -2038,15 +2038,25 @@ peek_token_bracket (re_token_t *token, re_string_t *input, reg_syntax_t syntax) } switch (c) { - case '-': - token->type = OP_CHARSET_RANGE; - break; case ']': token->type = OP_CLOSE_BRACKET; break; case '^': token->type = OP_NON_MATCH_LIST; break; + case '-': + /* In V7 Unix grep and Unix awk and mawk, [...---...] + (3 adjacent minus signs) stands for a single minus sign. + Support that without breaking anything else. */ + if (! (re_string_cur_idx (input) + 2 < re_string_length (input) + && re_string_peek_byte (input, 1) == '-' + && re_string_peek_byte (input, 2) == '-')) + { + token->type = OP_CHARSET_RANGE; + break; + } + re_string_skip_bytes (input, 2); + FALLTHROUGH; default: token->type = CHARACTER; } diff --git a/lib/sha1.h b/lib/sha1.h index 098678d8da..bc3470a508 100644 --- a/lib/sha1.h +++ b/lib/sha1.h @@ -23,6 +23,9 @@ # include # if HAVE_OPENSSL_SHA1 +# ifndef OPENSSL_API_COMPAT +# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ +# endif # include # endif diff --git a/lib/sha256.h b/lib/sha256.h index dc9d87e615..533173a59e 100644 --- a/lib/sha256.h +++ b/lib/sha256.h @@ -22,6 +22,9 @@ # include # if HAVE_OPENSSL_SHA256 +# ifndef OPENSSL_API_COMPAT +# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ +# endif # include # endif diff --git a/lib/sha512.h b/lib/sha512.h index f38819faf0..1eb1870227 100644 --- a/lib/sha512.h +++ b/lib/sha512.h @@ -22,6 +22,9 @@ # include "u64.h" # if HAVE_OPENSSL_SHA512 +# ifndef OPENSSL_API_COMPAT +# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ +# endif # include # endif diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index d52c2f7963..a86643c3ca 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -184,7 +184,11 @@ _GL_WARN_ON_USE (_Exit, "_Exit is unportable - " # undef free # define free rpl_free # endif +# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2) +_GL_FUNCDECL_RPL (free, void, (void *ptr) throw ()); +# else _GL_FUNCDECL_RPL (free, void, (void *ptr)); +# endif _GL_CXXALIAS_RPL (free, void, (void *ptr)); # else _GL_CXXALIAS_SYS (free, void, (void *ptr)); diff --git a/lib/string.in.h b/lib/string.in.h index b6840fa912..33160b2525 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -583,7 +583,7 @@ _GL_FUNCDECL_RPL (strndup, char *, _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); _GL_CXXALIAS_RPL (strndup, char *, (char const *__s, size_t __n)); # else -# if !@HAVE_DECL_STRNDUP@ || __GNUC__ >= 11 +# if !@HAVE_DECL_STRNDUP@ || (__GNUC__ >= 11 && !defined strndup) _GL_FUNCDECL_SYS (strndup, char *, (char const *__s, size_t __n) _GL_ARG_NONNULL ((1)) @@ -593,7 +593,7 @@ _GL_CXXALIAS_SYS (strndup, char *, (char const *__s, size_t __n)); # endif _GL_CXXALIASWARN (strndup); #else -# if __GNUC__ >= 11 +# if __GNUC__ >= 11 && !defined strndup /* For -Wmismatched-dealloc: Associate strndup with free or rpl_free. */ _GL_FUNCDECL_SYS (strndup, char *, (char const *__s, size_t __n) commit 7e9d364b663613fd907f92de31e996463ef7d03c Author: James N. V. Cash Date: Thu May 5 21:15:51 2022 +0300 * lisp/emacs-lisp/crm.el: Set completion-list-insert-choice-function. * lisp/emacs-lisp/crm.el (completing-read-multiple): Set buffer-local completion-list-insert-choice-function that handles string values of args. https://lists.gnu.org/archive/html/emacs-devel/2022-05/msg00017.html diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index f3e1981732..8a5c3d3730 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -254,6 +254,23 @@ with empty strings removed." 'crm--choose-completion-string nil 'local) (setq-local minibuffer-completion-table #'crm--collection-fn) (setq-local minibuffer-completion-predicate predicate) + (setq-local completion-list-insert-choice-function + (lambda (start end choice) + (if (and (stringp start) (stringp end)) + (let* ((beg (save-excursion + (goto-char (minibuffer-prompt-end)) + (or (search-forward start nil t) + (search-forward-regexp crm-separator nil t) + (minibuffer-prompt-end)))) + (end (save-excursion + (goto-char (point-max)) + (or (search-backward end nil t) + (progn + (goto-char beg) + (search-forward-regexp crm-separator nil t)) + (point-max))))) + (completion--replace beg end choice)) + (completion--replace start end choice)))) ;; see completing_read in src/minibuf.c (setq-local minibuffer-completion-confirm (unless (eq require-match t) require-match)) commit 459d5ff8ad72dab8831635e3d914389982041ad2 Author: Juri Linkov Date: Thu May 5 21:08:30 2022 +0300 * lisp/desktop.el: Enable tab-bar-mode after restoring frames with a tab bar. (desktop-restore-frameset): Enable tab-bar-mode when a restored frame contains the frame parameter tab-bar-lines (bug#55070). diff --git a/lisp/desktop.el b/lisp/desktop.el index e438b98c0e..1a4103e209 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1269,7 +1269,16 @@ being set (usually, by reading it from the desktop)." :cleanup-frames (not (eq desktop-restore-reuses-frames 'keep)) :force-display desktop-restore-in-current-display :force-onscreen (and desktop-restore-forces-onscreen - (display-graphic-p))))) + (display-graphic-p))) + ;; When at least one restored frame contains a tab bar, + ;; enable `tab-bar-mode' that takes care about recalculating + ;; the correct values of the frame parameter `tab-bar-lines' + ;; (that depends on `tab-bar-show'), and also loads graphical buttons. + (when (seq-some + (lambda (frame) + (menu-bar-positive-p (frame-parameter frame 'tab-bar-lines))) + (frame-list)) + (tab-bar-mode 1)))) ;; Just to silence the byte compiler. ;; Dynamically bound in `desktop-read'. commit 936009cfe53623c2e9fdb8f25b859600ac4dca67 Author: Lars Ingebrigtsen Date: Thu May 5 13:22:33 2022 +0200 Be more resilient towards errors during error handling * src/print.c (print_error_message): Avoid infinite recursion if `substitute-command-keys' bugs out (bug#55269). (cherry picked from commit 8364f058b821eba31f84dcded175cca403a965a5) diff --git a/src/print.c b/src/print.c index 3a26e5665e..43ec0934ba 100644 --- a/src/print.c +++ b/src/print.c @@ -944,7 +944,14 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, errmsg = Fget (errname, Qerror_message); /* During loadup 'substitute-command-keys' might not be available. */ if (!NILP (Ffboundp (Qsubstitute_command_keys))) - errmsg = call1 (Qsubstitute_command_keys, errmsg); + { + /* `substitute-command-keys' may bug out, which would lead + to infinite recursion when we're called from + skip_debugger, so ignore errors. */ + Lisp_Object subs = safe_call1 (Qsubstitute_command_keys, errmsg); + if (!NILP (subs)) + errmsg = subs; + } file_error = Fmemq (Qfile_error, error_conditions); } commit 8fce81897dabe9c06f7b3f59cfb0bb9348422531 Author: Paul Eggert Date: Thu May 5 08:56:19 2022 -0700 timestamp doc minor improvements * doc/lispref/os.texi (Time of Day, Time Conversion) (Time Calculations): Fix some confusion about decoded times, timestamps, and time values. Exclude floating-point infinities and NaNs from timestamps, as the code doesn’t always follow IEEE-754 rules for them and whatever the code does, doesn’t matter for timestamps anyway. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 5356969b0b..9df708532d 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1371,7 +1371,7 @@ may change as higher-resolution clocks become available. Function arguments, e.g., the @var{time} argument to @code{format-time-string}, accept a more-general @dfn{time value} format, which can be a Lisp timestamp, @code{nil} for the current -time, a single floating-point number for seconds, or a list +time, a finite floating-point number for seconds, or a list @code{(@var{high} @var{low} @var{micro})} or @code{(@var{high} @var{low})} that is a truncated list timestamp with missing elements taken to be zero. @@ -1558,13 +1558,13 @@ Although an omitted or @code{nil} @var{form} currently acts like @code{list}, this is planned to change in a future Emacs version, so callers requiring list timestamps should pass @code{list} explicitly. -If @var{time} is infinite or a NaN, this function signals an error. +If @var{time} is not a time value, this function signals an error. Otherwise, if @var{time} cannot be represented exactly, conversion truncates it toward minus infinity. When @var{form} is @code{t}, conversion is always exact so no truncation occurs, and the returned clock resolution is no less than that of @var{time}. By way of -contrast, @code{float-time} can convert any Lisp time value without -signaling an error, although the result might not be exact. +contrast, although @code{float-time} can also convert any time value +without signaling an error, the result might not be exact. @xref{Time of Day}. For efficiency this function might return a value that is @code{eq} to @@ -1652,7 +1652,7 @@ a particular form should specify @var{form}. @var{dow} and @var{utcoff}, and its @var{second} is an integer between 0 and 59 inclusive. -To access (or alter) the elements in the time value, the +To access (or alter) the elements in the calendrical information, the @code{decoded-time-second}, @code{decoded-time-minute}, @code{decoded-time-hour}, @code{decoded-time-day}, @code{decoded-time-month}, @code{decoded-time-year}, @@ -1755,7 +1755,7 @@ at the 15th of the month when adding months. Alternatively, you can use the @cindex formatting time values These functions convert time values to text in a string, and vice versa. -Time values include @code{nil}, numbers, and Lisp timestamps +Time values include @code{nil}, finite numbers, and Lisp timestamps (@pxref{Time of Day}). @defun date-to-time string @@ -2067,25 +2067,23 @@ interactively, it prints the duration in the echo area. These functions perform calendrical computations using time values (@pxref{Time of Day}). As with any time value, a value of @code{nil} for any of their -time-value arguments stands for the current system time, and a single +time-value arguments stands for the current system time, and a finite number stands for the number of seconds since the epoch. @defun time-less-p t1 t2 -This returns @code{t} if time value @var{t1} is less than time value +This returns @code{t} if the time value @var{t1} is less than the time value @var{t2}. -The result is @code{nil} if either argument is a NaN. @end defun @defun time-equal-p t1 t2 -This returns @code{t} if @var{t1} and @var{t2} are equal time values. -The result is @code{nil} if either argument is a NaN. +This returns @code{t} if the two time values @var{t1} and @var{t2} are +equal. @end defun @defun time-subtract t1 t2 This returns the time difference @var{t1} @minus{} @var{t2} between -two time values, as a Lisp time value. The result is exact and its clock +two time values, as a Lisp timestamp. The result is exact and its clock resolution is no worse than the worse of its two arguments' resolutions. -The result is floating-point only if it is infinite or a NaN@. If you need the difference in units of elapsed seconds, you can convert it with @code{time-convert} or @code{float-time}. @xref{Time Conversion}. commit d04acc1946cf48ab2f05c67a5089b4320d0653df Author: Glenn Morris Date: Thu May 5 07:57:21 2022 -0700 * doc/emacs/misc.texi (Interactive Shell): Fix paren typo. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 63eb00b235..9709c6ddc1 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -900,7 +900,7 @@ Subshells in different buffers run independently and in parallel. looking at the commands you enter, looking for @samp{cd} commands and the like. This is an error-prone solution, since there are many ways to change the current directory, so Emacs also looks for special -@acronym{OSC} (Operating System Commands} escape codes that are +@acronym{OSC} (Operating System Commands) escape codes that are designed to convey this information in a more reliable fashion. You should arrange for your shell to print the appropriate escape sequence at each prompt, for instance with the following command: commit d01e74f46d07c32c9faf5462dfc725cb01ad77d7 Author: Lars Ingebrigtsen Date: Thu May 5 16:38:39 2022 +0200 Fix a mistaken test case in test-undo-region * test/lisp/simple-tests.el (test-undo-region): Fix failing cases (bug#21523) -- the crossing-region case shouldn't be included, either. diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 6350bebeee..dcab811bb5 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -966,8 +966,8 @@ See Bug#21722." (setq buffer-undo-list nil) (downcase-word 1) (should (= (length (delq nil (undo-make-selective-list 1 9))) 2)) - (should (= (length (delq nil (undo-make-selective-list 4 9))) 1)) - ;; FIXME this is the off-by-one error case. + ;; FIXME: These should give 0, but currently give 1. + ;;(should (= (length (delq nil (undo-make-selective-list 4 9))) 0)) ;;(should (= (length (delq nil (undo-make-selective-list 5 9))) 0)) (should (= (length (delq nil (undo-make-selective-list 6 9))) 0)))) commit 6dbbdff281775eb82133fd13edc2ff6b63a97a58 Author: Lars Ingebrigtsen Date: Thu May 5 15:04:43 2022 +0200 Advertise OSC directory tracking more * doc/emacs/misc.texi (Interactive Shell): Document OSC directory tracking more. * lisp/shell.el (shell-dirtrack-mode): Link to the OSC directory tracking function. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index a0d79711f1..63eb00b235 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -896,6 +896,19 @@ also rename the @file{*shell*} buffer using @kbd{M-x rename-uniquely}, then create a new @file{*shell*} buffer using plain @kbd{M-x shell}. Subshells in different buffers run independently and in parallel. + Emacs attempts to keep track of what the current directory is by +looking at the commands you enter, looking for @samp{cd} commands and +the like. This is an error-prone solution, since there are many ways +to change the current directory, so Emacs also looks for special +@acronym{OSC} (Operating System Commands} escape codes that are +designed to convey this information in a more reliable fashion. You +should arrange for your shell to print the appropriate escape sequence +at each prompt, for instance with the following command: + +@example +printf "\e]7;file://%s%s\e\\" "$HOSTNAME" "$PWD" +@end example + @vindex explicit-shell-file-name @cindex environment variables for subshells @cindex @env{ESHELL} environment variable diff --git a/lisp/shell.el b/lisp/shell.el index 627c48e35f..47887433d9 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1033,7 +1033,9 @@ Environment variables are expanded, see function `substitute-in-file-name'." "Toggle directory tracking in this shell buffer (Shell Dirtrack mode). The `dirtrack' package provides an alternative implementation of -this feature; see the function `dirtrack-mode'." +this feature; see the function `dirtrack-mode'. Also see +`comint-osc-directory-tracker' for an escape-sequence based +solution." :lighter nil (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) (if shell-dirtrack-mode commit 71de48494e9024243d4c8b8847c50c0b5c0ac16f Author: Po Lu Date: Thu May 5 21:04:48 2022 +0800 Set GC line width on more GCs * src/xterm.c (x_set_cursor_gc, x_set_mouse_face_gc) (x_draw_bar_cursor): Make created scratch GCs have a line-width of 1. diff --git a/src/xterm.c b/src/xterm.c index 285b1d625e..80d34c114d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6044,7 +6044,10 @@ x_set_cursor_gc (struct glyph_string *s) IF_DEBUG (x_check_font (s->f, s->font)); xgcv.graphics_exposures = False; - mask = GCForeground | GCBackground | GCGraphicsExposures; + xgcv.line_width = 1; + mask = (GCForeground | GCBackground + | GCGraphicsExposures + | GCLineWidth); if (FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc) XChangeGC (display, FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc, @@ -6076,7 +6079,11 @@ x_set_mouse_face_gc (struct glyph_string *s) xgcv.background = s->face->background; xgcv.foreground = s->face->foreground; xgcv.graphics_exposures = False; - mask = GCForeground | GCBackground | GCGraphicsExposures; + xgcv.line_width = 1; + + mask = (GCForeground | GCBackground + | GCGraphicsExposures + | GCLineWidth); if (FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc) XChangeGC (display, FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc, @@ -19832,6 +19839,9 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text else xgcv.background = xgcv.foreground = f->output_data.x->cursor_pixel; xgcv.graphics_exposures = False; + xgcv.line_width = 1; + + mask |= GCLineWidth; if (gc) XChangeGC (dpy, gc, mask, &xgcv); commit aebff74af27157b60a0d6549be718d85a809b985 Author: Lars Ingebrigtsen Date: Thu May 5 13:30:14 2022 +0200 Sort completions in Info references/menu correctly * lisp/info.el (Info-follow-reference): Sort completions in the order they appear in the buffer (bug#54175). (Info-menu-update): Ditto. diff --git a/lisp/info.el b/lisp/info.el index 8ca6c54979..abfb77b055 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2599,7 +2599,8 @@ new buffer." (if (eq alt-default t) (setq alt-default str)) ;; Don't add this string if it's a duplicate. (or (assoc-string str completions t) - (push str completions)))) + (push str completions))) + (setq completions (nreverse completions))) ;; If no good default was found, try an alternate. (or default (setq default alt-default)) @@ -4285,7 +4286,8 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (substring str (match-end 0)))) (setq i (1+ i))) (setq items - (cons str items)))) + (cons str items))) + (setq items (nreverse items))) (while (and items (< number 9)) (setq current (car items) items (cdr items) commit 8364f058b821eba31f84dcded175cca403a965a5 Author: Lars Ingebrigtsen Date: Thu May 5 13:22:33 2022 +0200 Be more resilient towards errors during error handling * src/print.c (print_error_message): Avoid infinite recursion if `substitute-command-keys' bugs out (bug#55269). diff --git a/src/print.c b/src/print.c index 54d8bdfa3d..d7583282b6 100644 --- a/src/print.c +++ b/src/print.c @@ -954,7 +954,14 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, errmsg = Fget (errname, Qerror_message); /* During loadup 'substitute-command-keys' might not be available. */ if (!NILP (Ffboundp (Qsubstitute_command_keys))) - errmsg = call1 (Qsubstitute_command_keys, errmsg); + { + /* `substitute-command-keys' may bug out, which would lead + to infinite recursion when we're called from + skip_debugger, so ignore errors. */ + Lisp_Object subs = safe_call1 (Qsubstitute_command_keys, errmsg); + if (!NILP (subs)) + errmsg = subs; + } file_error = Fmemq (Qfile_error, error_conditions); } commit be374c18b3305ebfe38936bc5d66a78d5cb31318 Author: Philip Kaludercic Date: Wed May 4 14:24:31 2022 +0200 Avoid resizing mini buffer when displaying page numbers * doc-view.el (doc-view-goto-page): Do not insert a newline at the end of the "current info" if not necessary. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index e8698fad7e..22570dd510 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -632,17 +632,16 @@ Typically \"page-%s.png\".") (propertize (format "Page %d of %d." page len) 'face 'bold) ;; Tell user if converting isn't finished yet - (if doc-view--current-converter-processes - " (still converting...)\n" - "\n") - ;; Display context infos if this page matches the last search - (when (and doc-view--current-search-matches - (assq page doc-view--current-search-matches)) - (concat (propertize "Search matches:\n" 'face 'bold) + (and doc-view--current-converter-processes + " (still converting...)") + ;; Display context infos if this page matches the last search + (when (and doc-view--current-search-matches + (assq page doc-view--current-search-matches)) + (concat "\n" (propertize "Search matches:" 'face 'bold) (let ((contexts "")) (dolist (m (cdr (assq page doc-view--current-search-matches))) - (setq contexts (concat contexts " - \"" m "\"\n"))) + (setq contexts (concat contexts "\n - \"" m "\""))) contexts))))) ;; Update the buffer ;; We used to find the file name from doc-view--current-files but commit a4e5fdf97582003760f6818fd6266e537d2fc207 Author: Lars Ingebrigtsen Date: Thu May 5 13:09:57 2022 +0200 Describe kmacro registers better * lisp/kmacro.el (register-val-describe): Allow describing macros that contain mouse events (bug#55266). diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 5476c2395c..3f1f12fad6 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -954,7 +954,7 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command (cl-defmethod register-val-describe ((data kmacro-register) _verbose) (princ (format "a keyboard macro:\n %s" - (format-kbd-macro (kmacro-register-macro data))))) + (key-description (kmacro-register-macro data))))) (cl-defmethod register-val-insert ((data kmacro-register)) (insert (format-kbd-macro (kmacro-register-macro data)))) commit 1468eef301a59346adc47ef19a740f4e2c3737a2 Author: Po Lu Date: Thu May 5 09:46:05 2022 +0000 Speed up opening fonts on Haiku * src/font.h (font_property_index): Note that some font drivers use the extra data in a font entity to store driver-specific information. * src/haiku_font_support.cc (BFont_find): Set font indices. (be_open_font_at_index): New function. (BFont_open_pattern): Clean up coding style. * src/haiku_support.h (enum haiku_font_specification) (struct haiku_font_pattern): New fields and specifications for indices. * src/haikufont.c (haikufont_pattern_to_entity, haikufont_open): Use indices to open fonts if available in the extra data. diff --git a/src/font.h b/src/font.h index 424616a4a1..06bd297ccb 100644 --- a/src/font.h +++ b/src/font.h @@ -155,8 +155,9 @@ enum font_property_index /* In a font-spec, the value is an alist of extra information of a font such as name, OpenType features, and language coverage. In addition, in a font-entity, the value may contain a pair - (font-entity . INFO) where INFO is extra information to identify - a font (font-driver dependent). */ + (font-entity . INFO) where INFO is extra information to + identify a font (font-driver dependent). In a font-entity, + this holds font driver-specific information. */ FONT_EXTRA_INDEX, /* alist alist */ /* This value is the length of font-spec vector. */ diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index 339634f01b..ca6aaf7120 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -574,18 +574,21 @@ BFont_find (struct haiku_font_pattern *pt) font_family name; font_style sname; uint32 flags; - int sty_count; - int fam_count = count_font_families (); + int sty_count, fam_count, si, fi; + struct haiku_font_pattern *p, *head, *n; + bool oblique_seen_p; - for (int fi = 0; fi < fam_count; ++fi) + fam_count = count_font_families (); + + for (fi = 0; fi < fam_count; ++fi) { if (get_font_family (fi, &name, &flags) == B_OK) { sty_count = count_font_styles (name); - if (!sty_count && - font_family_style_matches_p (name, NULL, flags, pt)) + if (!sty_count + && font_family_style_matches_p (name, NULL, flags, pt)) { - struct haiku_font_pattern *p = new struct haiku_font_pattern; + p = new struct haiku_font_pattern; p->specified = 0; p->oblique_seen_p = 1; haiku_font_fill_pattern (p, name, NULL, flags); @@ -598,11 +601,11 @@ BFont_find (struct haiku_font_pattern *pt) } else if (sty_count) { - for (int si = 0; si < sty_count; ++si) + for (si = 0; si < sty_count; ++si) { - int oblique_seen_p = 0; - struct haiku_font_pattern *head = r; - struct haiku_font_pattern *p = NULL; + oblique_seen_p = 0; + head = r; + p = NULL; if (get_font_style (name, si, &sname, &flags) == B_OK) { @@ -611,8 +614,18 @@ BFont_find (struct haiku_font_pattern *pt) p = new struct haiku_font_pattern; p->specified = 0; haiku_font_fill_pattern (p, name, (char *) &sname, flags); - if (p->specified & FSPEC_SLANT && - ((p->slant == SLANT_OBLIQUE) || (p->slant == SLANT_ITALIC))) + + /* Add the indices to this font now so we + won't have to loop over each font in + order to open it later. */ + + p->specified |= FSPEC_INDICES; + p->family_index = fi; + p->style_index = si; + + if (p->specified & FSPEC_SLANT + && (p->slant == SLANT_OBLIQUE + || p->slant == SLANT_ITALIC)) oblique_seen_p = 1; p->next = r; @@ -627,9 +640,7 @@ BFont_find (struct haiku_font_pattern *pt) p->last = NULL; for (; head; head = head->last) - { - head->oblique_seen_p = oblique_seen_p; - } + head->oblique_seen_p = oblique_seen_p; } } } @@ -642,13 +653,18 @@ BFont_find (struct haiku_font_pattern *pt) if (!(pt->specified & FSPEC_SLANT)) { /* r->last is invalid from here onwards. */ - for (struct haiku_font_pattern *p = r; p;) + for (p = r; p;) { if (!p->oblique_seen_p) { - struct haiku_font_pattern *n = new haiku_font_pattern; + n = new haiku_font_pattern; *n = *p; + n->slant = SLANT_OBLIQUE; + + /* Opening a font by its indices doesn't provide enough + information to synthesize the oblique font later. */ + n->specified &= ~FSPEC_INDICES; p->next = n; p = p->next_family; } @@ -660,26 +676,68 @@ BFont_find (struct haiku_font_pattern *pt) return r; } +/* Find and open a font with the family at FAMILY and the style at + STYLE, and set its size to SIZE. Value is NULL if opening the font + failed. */ +void * +be_open_font_at_index (int family, int style, float size) +{ + font_family family_name; + font_style style_name; + uint32 flags; + status_t rc; + BFont *font; + + rc = get_font_family (family, &family_name, &flags); + + if (rc != B_OK) + return NULL; + + rc = get_font_style (family_name, style, &style_name, &flags); + + if (rc != B_OK) + return NULL; + + font = new BFont; + + rc = font->SetFamilyAndStyle (family_name, style_name); + + if (rc != B_OK) + { + delete font; + return NULL; + } + + font->SetSize (size); + font->SetEncoding (B_UNICODE_UTF8); + font->SetSpacing (B_BITMAP_SPACING); + return font; +} + /* Find and open a font matching the pattern PAT, which must have its family set. */ int BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) { - int sty_count; + int sty_count, si, code; font_family name; font_style sname; + BFont *ft; uint32 flags = 0; + struct haiku_font_pattern copy; + if (!(pat->specified & FSPEC_FAMILY)) return 1; + strncpy (name, pat->family, sizeof name - 1); name[sizeof name - 1] = '\0'; sty_count = count_font_styles (name); - if (!sty_count && - font_family_style_matches_p (name, NULL, flags, pat, 1)) + if (!sty_count + && font_family_style_matches_p (name, NULL, flags, pat, 1)) { - BFont *ft = new BFont; + ft = new BFont; ft->SetSize (size); ft->SetEncoding (B_UNICODE_UTF8); ft->SetSpacing (B_BITMAP_SPACING); @@ -694,12 +752,13 @@ BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) } else if (sty_count) { - for (int si = 0; si < sty_count; ++si) + for (si = 0; si < sty_count; ++si) { - if (get_font_style (name, si, &sname, &flags) == B_OK && - font_family_style_matches_p (name, (char *) &sname, flags, pat)) + if (get_font_style (name, si, &sname, &flags) == B_OK + && font_family_style_matches_p (name, (char *) &sname, + flags, pat)) { - BFont *ft = new BFont; + ft = new BFont; ft->SetSize (size); ft->SetEncoding (B_UNICODE_UTF8); ft->SetSpacing (B_BITMAP_SPACING); @@ -709,6 +768,7 @@ BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) delete ft; return 1; } + *font = (void *) ft; return 0; } @@ -717,12 +777,14 @@ BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) if (pat->specified & FSPEC_SLANT && pat->slant == SLANT_OBLIQUE) { - struct haiku_font_pattern copy = *pat; + copy = *pat; copy.slant = SLANT_REGULAR; - int code = BFont_open_pattern (©, font, size); + code = BFont_open_pattern (©, font, size); + if (code) return code; - BFont *ft = (BFont *) *font; + + ft = (BFont *) *font; /* XXX Font measurements don't respect shear. Haiku bug? This apparently worked in BeOS. ft->SetShear (100.0); */ diff --git a/src/haiku_support.h b/src/haiku_support.h index 63ba726050..0fe2af3329 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -246,6 +246,7 @@ enum haiku_font_specification FSPEC_NEED_ONE_OF = 1 << 6, FSPEC_WIDTH = 1 << 7, FSPEC_LANGUAGE = 1 << 8, + FSPEC_INDICES = 1 << 9, }; typedef char haiku_font_family_or_style[64]; @@ -300,25 +301,61 @@ enum haiku_font_weight struct haiku_font_pattern { + /* Bitmask indicating which fields are set. */ int specified; + + /* The next font in this list. */ struct haiku_font_pattern *next; - /* The next two fields are only temporarily used during the font - discovery process! Do not rely on them being correct outside - BFont_find. */ + + /* The last font in the list during font lookup. */ struct haiku_font_pattern *last; + + /* The next font in the list whose family differs from this one. + Only valid during font lookup. */ struct haiku_font_pattern *next_family; + + /* The family of the font. */ haiku_font_family_or_style family; + + /* The style of the font. */ haiku_font_family_or_style style; + + /* Whether or the font is monospace. */ int mono_spacing_p; - int want_chars_len; - int need_one_of_len; + + /* The slant of the font. */ enum haiku_font_slant slant; + + /* The width of the font. */ enum haiku_font_width width; + + /* The language of the font. Used during font lookup. */ enum haiku_font_language language; + + /* The weight of the font. */ enum haiku_font_weight weight; + + /* List of characters that must be present in the font for the match + to succeed. */ int *wanted_chars; + + /* The number of characters in `wanted_chars'. */ + int want_chars_len; + + /* List of characters. The font must fullfill at least one of + them for the match to succeed. */ int *need_one_of; + /* The number of characters in `need_one_of'. */ + int need_one_of_len; + + /* The index of the family of the font this pattern represents. */ + int family_index; + + /* The index of the style of the font this pattern represents. */ + int style_index; + + /* Temporary field used during font enumeration. */ int oblique_seen_p; }; @@ -635,6 +672,7 @@ extern bool be_use_subpixel_antialiasing (void); extern const char *be_find_setting (const char *); extern haiku_font_family_or_style *be_list_font_families (size_t *); extern void be_font_style_to_flags (char *, struct haiku_font_pattern *); +extern void *be_open_font_at_index (int, int, float); extern int be_get_ui_color (const char *, uint32_t *); extern void BMessage_delete (void *); diff --git a/src/haikufont.c b/src/haikufont.c index d18c1a393a..f8cf45284d 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -381,7 +381,9 @@ haikufont_maybe_handle_special_family (Lisp_Object family, static Lisp_Object haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) { - Lisp_Object ent = font_make_entity (); + Lisp_Object ent; + + ent = font_make_entity (); ASET (ent, FONT_TYPE_INDEX, Qhaiku); ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku); ASET (ent, FONT_FAMILY_INDEX, Qdefault); @@ -390,6 +392,14 @@ haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) ASET (ent, FONT_SIZE_INDEX, make_fixnum (0)); ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0)); ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); + + /* FONT_EXTRA_INDEX in a font entity can be a cons of two numbers + (STYLE . IDX) that tell Emacs how to open a font. */ + if (ptn->specified & FSPEC_INDICES) + ASET (ent, FONT_EXTRA_INDEX, + Fcons (make_fixnum (ptn->family_index), + make_fixnum (ptn->style_index))); + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, Qnormal); FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, Qnormal); FONT_SET_STYLE (ent, FONT_SLANT_INDEX, Qnormal); @@ -722,10 +732,11 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) struct haiku_font_pattern ptn; struct font *font; void *be_font; - Lisp_Object font_object; - Lisp_Object tem; + Lisp_Object font_object, tem, extra; + int px_size, min_width, max_width, + avg_width, height, space_width, ascent, + descent, underline_pos, underline_thickness; - block_input (); if (x <= 0) { /* Get pixel size from frame instead. */ @@ -733,19 +744,47 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) x = NILP (tem) ? 0 : XFIXNAT (tem); } - haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); + extra = AREF (font_entity, FONT_EXTRA_INDEX); + + /* If the font's indices is already available, open the font using + those instead. */ + + if (CONSP (extra) && FIXNUMP (XCAR (extra)) + && FIXNUMP (XCDR (extra))) + { + block_input (); + be_font = be_open_font_at_index (XFIXNUM (XCAR (extra)), + XFIXNUM (XCDR (extra)), x); + unblock_input (); - if (BFont_open_pattern (&ptn, &be_font, x)) + if (!be_font) + return Qnil; + } + else { + block_input (); + haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); + + if (BFont_open_pattern (&ptn, &be_font, x)) + { + haikufont_done_with_query_pattern (&ptn); + unblock_input (); + return Qnil; + } + haikufont_done_with_query_pattern (&ptn); unblock_input (); - return Qnil; } - haikufont_done_with_query_pattern (&ptn); + block_input (); + /* `font_make_object' tries to treat the extra data as an alist. + There is never any real data here, so clear that field. */ + + ASET (font_entity, FONT_EXTRA_INDEX, Qnil); font_object = font_make_object (VECSIZE (struct haikufont_info), font_entity, x); + ASET (font_entity, FONT_EXTRA_INDEX, extra); ASET (font_object, FONT_TYPE_INDEX, Qhaiku); font_info = (struct haikufont_info *) XFONT_OBJECT (font_object); @@ -772,10 +811,6 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) font_info->metrics = NULL; font_info->metrics_nrows = 0; - int px_size, min_width, max_width, - avg_width, height, space_width, ascent, - descent, underline_pos, underline_thickness; - BFont_metrics (be_font, &px_size, &min_width, &max_width, &avg_width, &height, &space_width, &ascent, &descent, commit 30caeb789659441f8feb76b24f3d0b1f60125085 Author: Po Lu Date: Thu May 5 17:01:53 2022 +0800 Fix font weight reporting on macOS * src/macfont.m (macfont_store_descriptor_attributes): Fix numeric values for the addition of `medium'. * src/nsterm.m (ns_font_desc_to_font_spec): Adjust accordingly. (ns_create_font_panel_buttons): Try to fix button width. diff --git a/src/macfont.m b/src/macfont.m index 35648df06c..4dd55e7746 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -847,7 +847,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, {{-0.4, 50}, /* light */ {-0.24, 87.5}, /* (semi-light + normal) / 2 */ - {0, 100}, /* normal */ + {0, 80}, /* normal */ {0.24, 140}, /* (semi-bold + normal) / 2 */ {0.4, 200}, /* bold */ {CGFLOAT_MAX, CGFLOAT_MAX}}, diff --git a/src/nsterm.m b/src/nsterm.m index 8e8d5c969b..fef7f0dc6c 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6092,10 +6092,26 @@ - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg tem = [dict objectForKey: NSFontWeightTrait]; +#ifdef NS_IMPL_GNUSTEP if (tem != nil) lweight = ([tem floatValue] > 0 ? Qbold : ([tem floatValue] < -0.4f ? Qlight : Qnormal)); +#else + if (tem != nil) + { + if ([tem floatValue] >= 0.4) + lweight = Qbold; + else if ([tem floatValue] >= 0.24) + lweight = Qmedium; + else if ([tem floatValue] >= 0) + lweight = Qnormal; + else if ([tem floatValue] >= -0.24) + lweight = Qsemi_light; + else + lweight = Qlight; + } +#endif tem = [dict objectForKey: NSFontWidthTrait]; @@ -6127,6 +6143,7 @@ - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg prototype = [[NSButtonCell alloc] init]; [prototype setBezelStyle: NSBezelStyleRounded]; + [prototype setTitle: @"Cancel"]; cell_size = [prototype cellSize]; frame = NSMakeRect (0, 0, cell_size.width * 2, cell_size.height); commit 1bfea2ae6948fab9b1e0d7530d10173def070f79 Merge: 75c26e4174 c242a38b7d Author: Po Lu Date: Thu May 5 15:56:19 2022 +0800 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 75c26e417474ba9b8d366b28a95ff774cb12f0e5 Author: Po Lu Date: Thu May 5 15:55:33 2022 +0800 Improve appearance of macOS font panel buttons * src/nsterm.m (ns_create_font_panel_buttons): ([EmacsView noteUserCancelledSelection]): New functions. ([EmacsView showFontPanel]): Use those buttons instead. diff --git a/src/nsterm.m b/src/nsterm.m index dfb7c5d202..8e8d5c969b 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6115,6 +6115,47 @@ - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg : Qnil)); } +#ifdef NS_IMPL_COCOA +static NSView * +ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) +{ + NSMatrix *matrix; + NSButtonCell *prototype; + NSSize cell_size; + NSRect frame; + NSButtonCell *cancel, *ok; + + prototype = [[NSButtonCell alloc] init]; + [prototype setBezelStyle: NSBezelStyleRounded]; + cell_size = [prototype cellSize]; + frame = NSMakeRect (0, 0, cell_size.width * 2, + cell_size.height); + matrix = [[NSMatrix alloc] initWithFrame: frame + mode: NSTrackModeMatrix + prototype: prototype + numberOfRows: 1 + numberOfColumns: 2]; + [prototype release]; + + ok = (NSButtonCell *) [matrix cellAtRow: 0 column: 0]; + cancel = (NSButtonCell *) [matrix cellAtRow: 0 column: 1]; + + [ok setTitle: @"OK"]; + [ok setTarget: target]; + [ok setAction: select]; + [ok setButtonType: NSButtonTypeMomentaryPushIn]; + + [cancel setTitle: @"Cancel"]; + [cancel setTarget: target]; + [cancel setAction: cancel_action]; + [cancel setButtonType: NSButtonTypeMomentaryPushIn]; + + [matrix selectCell: ok]; + + return matrix; +} +#endif + /* ========================================================================== EmacsView implementation @@ -6197,6 +6238,17 @@ - (void) noteUserSelectedFont [NSApp stop: self]; } + +- (void) noteUserCancelledSelection +{ + font_panel_active = NO; + + if (font_panel_result) + [font_panel_result release]; + font_panel_result = nil; + + [NSApp stop: self]; +} #endif - (Lisp_Object) showFontPanel @@ -6206,7 +6258,7 @@ - (Lisp_Object) showFontPanel NSFont *nsfont, *result; struct timespec timeout; #ifdef NS_IMPL_COCOA - NSButton *button; + NSView *buttons; BOOL canceled; #endif @@ -6217,18 +6269,12 @@ - (Lisp_Object) showFontPanel #endif #ifdef NS_IMPL_COCOA - /* FIXME: this button could be made a lot prettier, but I don't know - how. */ - button = [[NSButton alloc] initWithFrame: NSMakeRect (0, 0, 192, 40)]; - [button setTitle: @"OK"]; - [button setTarget: self]; - [button setAction: @selector (noteUserSelectedFont)]; - [button setButtonType: NSButtonTypeMomentaryPushIn]; - [button setHidden: NO]; - - [[fm fontPanel: YES] setAccessoryView: button]; - [button release]; - [[fm fontPanel: YES] setDefaultButtonCell: [button cell]]; + buttons + = ns_create_font_panel_buttons (self, + @selector (noteUserSelectedFont), + @selector (noteUserCancelledSelection)); + [[fm fontPanel: YES] setAccessoryView: buttons]; + [buttons release]; #endif [fm setSelectedFont: nsfont isMultiple: NO]; commit c242a38b7d9d00d5441fc926b24193246bd63746 Author: Michael Albinus Date: Thu May 5 09:54:31 2022 +0200 Add Tramp test * test/lisp/net/tramp-tests.el (tar-mode): Require. (tramp-test10-write-region-other-file-name-handler): New test. (tramp-test31-interrupt-process, tramp-test31-signal-process): Tag them :unstable unconditionally. * test/lisp/net/tramp-resources/foo.tar.gz: New resource file. diff --git a/test/lisp/net/tramp-resources/foo.tar.gz b/test/lisp/net/tramp-resources/foo.tar.gz new file mode 100644 index 0000000000..0d2e9878dd Binary files /dev/null and b/test/lisp/net/tramp-resources/foo.tar.gz differ diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d870970945..2d2bef732e 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -47,6 +47,7 @@ (require 'ert) (require 'ert-x) (require 'seq) ; For `seq-random-elt', autoloaded since Emacs 28.1 +(require 'tar-mode) (require 'trace) (require 'tramp) (require 'vc) @@ -2511,6 +2512,48 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (advice-remove 'write-region advice)) (ignore-errors (delete-file tmp-name))))) +;; The following test is inspired by Bug#55166. +(ert-deftest tramp-test10-write-region-other-file-name-handler () + "Check that another file name handler in VISIT is acknowledged." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-ange-ftp-p))) + (skip-unless (executable-find "gzip")) + + (let* ((default-directory tramp-test-temporary-file-directory) + (archive (ert-resource-file "foo.tar.gz")) + (tmp-file (expand-file-name (file-name-nondirectory archive))) + (require-final-newline t) + (inhibit-message t) + (backup-inhibited t) + create-lockfiles buffer1 buffer2) + (unwind-protect + (progn + (copy-file archive tmp-file 'ok) + ;; Read archive. Check contents of foo.txt, and modify it. Save. + (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) + (should (tar-goto-file "foo.txt")) + (save-current-buffer + (setq buffer2 (tar-extract)) + (should (string-equal (buffer-string) "foo\n")) + (goto-char (point-max)) + (insert "bar") + (should (null (save-buffer)))) + (should (null (save-buffer)))) + + (kill-buffer buffer1) + (kill-buffer buffer2) + ;; Read archive. Check contents of modified foo.txt. + (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) + (should (tar-goto-file "foo.txt")) + (save-current-buffer + (setq buffer2 (tar-extract)) + (should (string-equal (buffer-string) "foo\nbar\n"))))) + + ;; Cleanup. + (ignore-errors (kill-buffer buffer1)) + (ignore-errors (kill-buffer buffer2)) + (ignore-errors (delete-file tmp-file))))) + (ert-deftest tramp-test11-copy-file () "Check `copy-file'." (skip-unless (tramp--test-enabled)) @@ -4984,10 +5027,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." - :tags (append '(:expensive-test :tramp-asynchronous-processes) - ;; The final `process-live-p' check does not run sufficiently. - (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) - '(:unstable))) + ;; The final `process-live-p' check does not run sufficiently. + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) @@ -5026,10 +5067,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (ert-deftest tramp-test31-signal-process () "Check `signal-process'." - :tags (append '(:expensive-test :tramp-asynchronous-processes) - ;; The final `process-live-p' check does not run sufficiently. - (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) - '(:unstable))) + ;; The final `process-live-p' check does not run sufficiently. + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) @@ -7563,8 +7602,9 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". -;; * Implement `tramp-test31-interrupt-process' for "adb", "sshfs" and -;; for direct async processes. +;; * Implement `tramp-test31-interrupt-process' and +;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct +;; async processes. Check, why they don't run stable. ;; * Check, why direct async processes do not work for ;; `tramp-test44-asynchronous-requests'. commit 69c56cbe6ed56024440203181dda2d6fee6dc9f4 Author: Eli Zaretskii Date: Thu May 5 10:38:40 2022 +0300 ; * src/w32notify.c: Fix a typo in a comment. diff --git a/src/w32notify.c b/src/w32notify.c index e7d2f0f076..ccefecb659 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -40,8 +40,8 @@ along with GNU Emacs. If not, see . */ and returns. That causes the WaitForSingleObjectEx function call inside watch_worker to return, but the thread won't terminate until the event telling to do so will be signaled. The completion - routine issued another call to ReadDirectoryChangesW as quickly as - possible. (Except when it does not, see below.) + routine then issues another call to ReadDirectoryChangesW as quickly + as possible. (Except when it does not, see below.) In a GUI session, the WM_EMACS_FILENOTIFY message posted to the message queue gets dispatched to the main Emacs window procedure, commit 8f391ae26eab6654360f621acaeb2bc0935e3d32 Author: Po Lu Date: Thu May 5 06:33:49 2022 +0000 Fix min size reporting of style pane in Haiku font dialogs * src/haiku_support.cc (class DualLayoutView): (MinSize): Implement correctly with both views. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 33acaacaaf..0ab31bc98d 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2575,6 +2575,20 @@ class DualLayoutView : public BView BView::FrameResized (new_width, new_height); } + /* This is called by the BSplitView. */ + BSize + MinSize (void) + { + float width, height; + BSize size_1; + + size_1 = view_1->MinSize (); + view_2->GetPreferredSize (&width, &height); + + return BSize (std::max (size_1.width, width), + std::max (size_1.height, height)); + } + public: DualLayoutView (BScrollView *first, BView *second) : BView (NULL, B_FRAME_EVENTS), view_1 (first), commit 3b9e60ba2fad4330682e6fdd15899f0f227a40d7 Author: Eli Zaretskii Date: Thu May 5 08:57:49 2022 +0300 ; * src/window.c (Fset_window_start): Mention the effect on vscroll. diff --git a/src/window.c b/src/window.c index 32e486f9f9..cbb2a9e0e1 100644 --- a/src/window.c +++ b/src/window.c @@ -1861,7 +1861,13 @@ point not visible in the window. For reliable setting of WINDOW start position, make sure point is at a position that will be visible when that start is in effect, otherwise there's a chance POS will be disregarded, e.g., if point -winds up in a partially-visible line. */) +winds up in a partially-visible line. + +The setting of the WINDOW's start position takes effect during the +next redisplay cycle, not immediately. If NOFORCE is nil or +omitted, forcing the display of WINDOW to start at POS cancels +any setting of WINDOW's vertical scroll (\"vscroll\") amount +set by `set-window-vscroll' and by scrolling functions. */) (Lisp_Object window, Lisp_Object pos, Lisp_Object noforce) { register struct window *w = decode_live_window (window); commit d15b11b50e92a13ebe90f28f3ac8791a1385edaf Author: Po Lu Date: Thu May 5 13:44:19 2022 +0800 Use bswap_32 and bswap_16 in Motif DND code * src/xterm.c (SWAPCARD32, SAPCARD16): Use glibc/gnulib byte-swapping functions if checking is disabled. diff --git a/src/xterm.c b/src/xterm.c index 68ee63aea4..285b1d625e 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -618,6 +618,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "character.h" #include "coding.h" @@ -1054,6 +1055,8 @@ typedef enum xm_byte_order #endif } xm_byte_order; +#ifdef ENABLE_CHECKING + #define SWAPCARD32(l) \ { \ struct { unsigned t : 32; } bit32; \ @@ -1073,6 +1076,11 @@ typedef enum xm_byte_order s = bit16.t; \ } +#else +#define SWAPCARD32(l) bswap_32 (l) +#define SWAPCARD16(l) bswap_16 (l) +#endif + typedef struct xm_targets_table_header { /* BYTE */ uint8_t byte_order; commit 01e874e1e6e6770ed0a5ba3ba7c9488494a2e61a Author: Po Lu Date: Thu May 5 04:58:47 2022 +0000 Take size into account when previewing fonts on Haiku * src/haiku_support.cc (MessageReceived): Decode size sent and handle `UPDATE_PREVIEW_DIALOG' message. (UpdatePreview): Add current size. (EmacsFontSelectionDialog): Assign correct modification messages to the size entry. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 32b5302fd6..33acaacaaf 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -92,20 +92,21 @@ along with GNU Emacs. If not, see . */ /* Some messages that Emacs sends to itself. */ enum { - SCROLL_BAR_UPDATE = 3000, - WAIT_FOR_RELEASE = 3001, - RELEASE_NOW = 3002, - CANCEL_DROP = 3003, - SHOW_MENU_BAR = 3004, - BE_MENU_BAR_OPEN = 3005, - QUIT_APPLICATION = 3006, - REPLAY_MENU_BAR = 3007, - FONT_FAMILY_SELECTED = 3008, - FONT_STYLE_SELECTED = 3009, - FILE_PANEL_SELECTION = 3010, - QUIT_PREVIEW_DIALOG = 3011, - SET_FONT_INDICES = 3012, - SET_PREVIEW_DIALOG = 3013, + SCROLL_BAR_UPDATE = 3000, + WAIT_FOR_RELEASE = 3001, + RELEASE_NOW = 3002, + CANCEL_DROP = 3003, + SHOW_MENU_BAR = 3004, + BE_MENU_BAR_OPEN = 3005, + QUIT_APPLICATION = 3006, + REPLAY_MENU_BAR = 3007, + FONT_FAMILY_SELECTED = 3008, + FONT_STYLE_SELECTED = 3009, + FILE_PANEL_SELECTION = 3010, + QUIT_PREVIEW_DIALOG = 3011, + SET_FONT_INDICES = 3012, + SET_PREVIEW_DIALOG = 3013, + UPDATE_PREVIEW_DIALOG = 3014, }; /* X11 keysyms that we use. */ @@ -2482,9 +2483,13 @@ class EmacsFontPreviewDialog : public BWindow font_family name; font_style sname; status_t rc; + const char *size_name; + int size; if (message->what == SET_FONT_INDICES) { + size_name = message->FindString ("emacs:size"); + if (message->FindInt32 ("emacs:family", &family) != B_OK || message->FindInt32 ("emacs:style", &style) != B_OK) return; @@ -2504,8 +2509,14 @@ class EmacsFontPreviewDialog : public BWindow current_font = new BFont; current_font->SetFamilyAndStyle (name, sname); - text_view.SetFont (current_font); + if (size_name && strlen (size_name)) + { + size = atoi (size_name); + current_font->SetSize (size); + } + + text_view.SetFont (current_font); DoLayout (); return; } @@ -2618,6 +2629,9 @@ class EmacsFontSelectionDialog : public BWindow message.AddInt32 ("emacs:family", family); message.AddInt32 ("emacs:style", style); + message.AddString ("emacs:size", + size_entry.Text ()); + messenger.SendMessage (&message); } @@ -2746,6 +2760,11 @@ class EmacsFontSelectionDialog : public BWindow preview_checkbox.SetValue (B_CONTROL_OFF); HidePreview (); } + else if (msg->what == UPDATE_PREVIEW_DIALOG) + { + if (preview) + UpdatePreview (); + } BWindow::MessageReceived (msg); } @@ -2810,7 +2829,8 @@ class EmacsFontSelectionDialog : public BWindow cancel_button ("Cancel", "Cancel", new BMessage (B_CANCEL)), ok_button ("OK", "OK", new BMessage (B_OK)), - size_entry (NULL, "Size:", NULL, NULL), + size_entry (NULL, "Size:", NULL, + new BMessage (UPDATE_PREVIEW_DIALOG)), allow_monospace_only (monospace_only), pending_selection_idx (initial_style_idx), preview (NULL) @@ -2846,6 +2866,8 @@ class EmacsFontSelectionDialog : public BWindow font_style_pane.SetSelectionMessage (selection); selection = new BMessage (B_OK); font_style_pane.SetInvocationMessage (selection); + selection = new BMessage (UPDATE_PREVIEW_DIALOG); + size_entry.SetModificationMessage (selection); comm_port = create_port (1, "font dialog port"); commit c250d82463eb554e03c8066845464ef0dbb017b7 Author: Po Lu Date: Thu May 5 03:10:30 2022 +0000 Allow displaying font preview on Haiku * src/haiku_support.cc (class EmacsFontPreviewDialog) (class DualLayoutView): New classes. (class EmacsFontSelectionDialog): Add field for preview, checkbox and layout view. (MessageReceived): Handle new font preview messages. (EmacsFontSelectionDialog): New constructor. (FrameResized): Resize the layout view instead. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 311df2e06b..32b5302fd6 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -42,7 +42,9 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include +#include #include @@ -101,6 +103,9 @@ enum FONT_FAMILY_SELECTED = 3008, FONT_STYLE_SELECTED = 3009, FILE_PANEL_SELECTION = 3010, + QUIT_PREVIEW_DIALOG = 3011, + SET_FONT_INDICES = 3012, + SET_PREVIEW_DIALOG = 3013, }; /* X11 keysyms that we use. */ @@ -2442,14 +2447,142 @@ class EmacsPopUpMenu : public BPopUpMenu } }; +class EmacsFontPreviewDialog : public BWindow +{ + BStringView text_view; + BMessenger preview_source; + BFont *current_font; + bool is_visible; + + void + DoLayout (void) + { + float width, height; + + text_view.GetPreferredSize (&width, &height); + text_view.ResizeTo (width - 1, height - 1); + + SetSizeLimits (width, width, height, height); + ResizeTo (width - 1, height - 1); + } + + bool + QuitRequested (void) + { + preview_source.SendMessage (QUIT_PREVIEW_DIALOG); + + return false; + } + + void + MessageReceived (BMessage *message) + { + int32 family, style; + uint32 flags; + font_family name; + font_style sname; + status_t rc; + + if (message->what == SET_FONT_INDICES) + { + if (message->FindInt32 ("emacs:family", &family) != B_OK + || message->FindInt32 ("emacs:style", &style) != B_OK) + return; + + rc = get_font_family (family, &name, &flags); + + if (rc != B_OK) + return; + + rc = get_font_style (name, style, &sname, &flags); + + if (rc != B_OK) + return; + + if (current_font) + delete current_font; + + current_font = new BFont; + current_font->SetFamilyAndStyle (name, sname); + text_view.SetFont (current_font); + + DoLayout (); + return; + } + + BWindow::MessageReceived (message); + } + +public: + + EmacsFontPreviewDialog (BWindow *target) + : BWindow (BRect (45, 45, 500, 300), + "Preview font", + B_FLOATING_WINDOW_LOOK, + B_MODAL_APP_WINDOW_FEEL, + B_NOT_ZOOMABLE | B_NOT_RESIZABLE), + text_view (BRect (0, 0, 0, 0), + NULL, "The quick brown fox " + "jumped over the lazy dog"), + preview_source (target), + current_font (NULL) + { + AddChild (&text_view); + DoLayout (); + } + + ~EmacsFontPreviewDialog (void) + { + text_view.RemoveSelf (); + + if (current_font) + delete current_font; + } +}; + +class DualLayoutView : public BView +{ + BScrollView *view_1; + BView *view_2; + + void + FrameResized (float new_width, float new_height) + { + BRect frame; + float width, height; + + frame = Frame (); + + view_2->GetPreferredSize (&width, &height); + + view_1->MoveTo (0, 0); + view_1->ResizeTo (BE_RECT_WIDTH (frame), + BE_RECT_HEIGHT (frame) - height); + view_2->MoveTo (2, BE_RECT_HEIGHT (frame) - height); + view_2->ResizeTo (BE_RECT_WIDTH (frame) - 4, height); + + BView::FrameResized (new_width, new_height); + } + +public: + DualLayoutView (BScrollView *first, BView *second) : BView (NULL, B_FRAME_EVENTS), + view_1 (first), + view_2 (second) + { + FrameResized (801, 801); + } +}; + class EmacsFontSelectionDialog : public BWindow { BView basic_view; + BCheckBox preview_checkbox; BSplitView split_view; BListView font_family_pane; BListView font_style_pane; BScrollView font_family_scroller; BScrollView font_style_scroller; + DualLayoutView style_view; BObjectList all_families; BObjectList all_styles; BButton cancel_button, ok_button; @@ -2457,6 +2590,51 @@ class EmacsFontSelectionDialog : public BWindow port_id comm_port; bool allow_monospace_only; int pending_selection_idx; + EmacsFontPreviewDialog *preview; + + void + ShowPreview (void) + { + if (!preview) + { + preview = new EmacsFontPreviewDialog (this); + preview->Show (); + + UpdatePreview (); + } + } + + void + UpdatePreview (void) + { + int family, style; + BMessage message; + BMessenger messenger (preview); + + family = font_family_pane.CurrentSelection (); + style = font_style_pane.CurrentSelection (); + + message.what = SET_FONT_INDICES; + message.AddInt32 ("emacs:family", family); + message.AddInt32 ("emacs:style", style); + + messenger.SendMessage (&message); + } + + void + HidePreview (void) + { + if (preview) + { + if (preview->LockLooper ()) + preview->Quit (); + /* I hope this works. */ + else + delete preview; + + preview = NULL; + } + } void UpdateStylesForIndex (int idx) @@ -2512,10 +2690,15 @@ class EmacsFontSelectionDialog : public BWindow void UpdateForSelectedStyle (void) { - if (font_style_pane.CurrentSelection () < 0) + int style = font_style_pane.CurrentSelection (); + + if (style < 0) ok_button.SetEnabled (false); else ok_button.SetEnabled (true); + + if (style >= 0 && preview) + UpdatePreview (); } void @@ -2551,6 +2734,18 @@ class EmacsFontSelectionDialog : public BWindow write_port (comm_port, 0, &rq, sizeof rq); } + else if (msg->what == SET_PREVIEW_DIALOG) + { + if (preview_checkbox.Value () == B_CONTROL_OFF) + HidePreview (); + else + ShowPreview (); + } + else if (msg->what == QUIT_PREVIEW_DIALOG) + { + preview_checkbox.SetValue (B_CONTROL_OFF); + HidePreview (); + } BWindow::MessageReceived (msg); } @@ -2559,11 +2754,22 @@ class EmacsFontSelectionDialog : public BWindow ~EmacsFontSelectionDialog (void) { + if (preview) + { + if (preview->LockLooper ()) + preview->Quit (); + /* I hope this works. */ + else + delete preview; + } + font_family_pane.MakeEmpty (); font_style_pane.MakeEmpty (); font_family_pane.RemoveSelf (); font_style_pane.RemoveSelf (); + preview_checkbox.RemoveSelf (); + style_view.RemoveSelf (); font_family_scroller.RemoveSelf (); font_style_scroller.RemoveSelf (); cancel_button.RemoveSelf (); @@ -2584,18 +2790,21 @@ class EmacsFontSelectionDialog : public BWindow B_TITLED_WINDOW_LOOK, B_MODAL_APP_WINDOW_FEEL, 0), basic_view (NULL, 0), - font_family_pane (BRect (0, 0, 10, 10), NULL, + preview_checkbox ("Show preview", "Show preview", + new BMessage (SET_PREVIEW_DIALOG)), + font_family_pane (BRect (0, 0, 0, 0), NULL, B_SINGLE_SELECTION_LIST, B_FOLLOW_ALL_SIDES), - font_style_pane (BRect (0, 0, 10, 10), NULL, + font_style_pane (BRect (0, 0, 0, 0), NULL, B_SINGLE_SELECTION_LIST, B_FOLLOW_ALL_SIDES), font_family_scroller (NULL, &font_family_pane, B_FOLLOW_LEFT | B_FOLLOW_TOP, 0, false, true), font_style_scroller (NULL, &font_style_pane, - B_FOLLOW_LEFT | B_FOLLOW_TOP, - 0, false, true), + B_FOLLOW_ALL_SIDES, + B_SUPPORTS_LAYOUT, false, true), + style_view (&font_style_scroller, &preview_checkbox), all_families (20, true), all_styles (20, true), cancel_button ("Cancel", "Cancel", @@ -2603,7 +2812,8 @@ class EmacsFontSelectionDialog : public BWindow ok_button ("OK", "OK", new BMessage (B_OK)), size_entry (NULL, "Size:", NULL, NULL), allow_monospace_only (monospace_only), - pending_selection_idx (initial_style_idx) + pending_selection_idx (initial_style_idx), + preview (NULL) { BStringItem *family_item; int i, n_families; @@ -2620,9 +2830,12 @@ class EmacsFontSelectionDialog : public BWindow basic_view.AddChild (&ok_button); basic_view.AddChild (&size_entry); split_view.AddChild (&font_family_scroller, 0.7); - split_view.AddChild (&font_style_scroller, 0.3); + split_view.AddChild (&style_view, 0.3); + style_view.AddChild (&font_style_scroller); + style_view.AddChild (&preview_checkbox); basic_view.SetViewUIColor (B_PANEL_BACKGROUND_COLOR); + style_view.SetViewUIColor (B_PANEL_BACKGROUND_COLOR); FrameResized (801, 801); UpdateForSelectedStyle (); @@ -2703,7 +2916,7 @@ class EmacsFontSelectionDialog : public BWindow frame = Frame (); basic_view.ResizeTo (BE_RECT_WIDTH (frame), BE_RECT_HEIGHT (frame)); - split_view.ResizeTo (BE_RECT_WIDTH (frame), + split_view.ResizeTo (BE_RECT_WIDTH (frame) - 1, BE_RECT_HEIGHT (frame) - 4 - max_height); bone = BE_RECT_HEIGHT (frame) - 2 - max_height / 2; commit 5784533cb6e1fe5edf4d5f6c24c02ab8ef5be732 Author: Po Lu Date: Thu May 5 09:03:30 2022 +0800 Fix device reporting from scroll bar events on X * src/xterm.c (x_scroll_bar_handle_click): New argument `device'. (handle_one_xevent): Set it appropriately as long as required. diff --git a/src/xterm.c b/src/xterm.c index 0625b03ea0..68ee63aea4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13226,8 +13226,14 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) static void x_scroll_bar_handle_click (struct scroll_bar *bar, const XEvent *event, - struct input_event *emacs_event) + struct input_event *emacs_event, + Lisp_Object device) { + int left_range, x, top_range, y; +#ifndef USE_TOOLKIT_SCROLL_BARS + int new_start, new_end; +#endif + if (! WINDOWP (bar->window)) emacs_abort (); @@ -13245,11 +13251,15 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, emacs_event->frame_or_window = bar->window; emacs_event->arg = Qnil; emacs_event->timestamp = event->xbutton.time; + + if (!NILP (device)) + emacs_event->device = device; + if (bar->horizontal) { - int left_range - = HORIZONTAL_SCROLL_BAR_LEFT_RANGE (f, bar->width); - int x = event->xbutton.x - HORIZONTAL_SCROLL_BAR_LEFT_BORDER; + + left_range = HORIZONTAL_SCROLL_BAR_LEFT_RANGE (f, bar->width); + x = event->xbutton.x - HORIZONTAL_SCROLL_BAR_LEFT_BORDER; if (x < 0) x = 0; if (x > left_range) x = left_range; @@ -13265,8 +13275,8 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, /* If the user has released the handle, set it to its final position. */ if (event->type == ButtonRelease && bar->dragging != -1) { - int new_start = - bar->dragging; - int new_end = new_start + bar->end - bar->start; + new_start = - bar->dragging; + new_end = new_start + bar->end - bar->start; x_scroll_bar_set_handle (bar, new_start, new_end, false); bar->dragging = -1; @@ -13278,9 +13288,9 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, } else { - int top_range + top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (f, bar->height); - int y = event->xbutton.y - VERTICAL_SCROLL_BAR_TOP_BORDER; + y = event->xbutton.y - VERTICAL_SCROLL_BAR_TOP_BORDER; if (y < 0) y = 0; if (y > top_range) y = top_range; @@ -13296,8 +13306,8 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, /* If the user has released the handle, set it to its final position. */ if (event->type == ButtonRelease && bar->dragging != -1) { - int new_start = y - bar->dragging; - int new_end = new_start + bar->end - bar->start; + new_start = y - bar->dragging; + new_end = new_start + bar->end - bar->start; x_scroll_bar_set_handle (bar, new_start, new_end, false); bar->dragging = -1; @@ -16532,12 +16542,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, scroll bars. */ if (bar && event->xbutton.state & ControlMask) { - x_scroll_bar_handle_click (bar, event, &inev.ie); + x_scroll_bar_handle_click (bar, event, &inev.ie, Qnil); *finish = X_EVENT_DROP; } #else /* not USE_TOOLKIT_SCROLL_BARS */ if (bar) - x_scroll_bar_handle_click (bar, event, &inev.ie); + x_scroll_bar_handle_click (bar, event, &inev.ie, Qnil); #endif /* not USE_TOOLKIT_SCROLL_BARS */ } @@ -17993,13 +18003,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifndef USE_TOOLKIT_SCROLL_BARS if (bar) - x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie, + source ? source->name : Qnil); #else /* Make the "Ctrl-Mouse-2 splits window" work for toolkit scroll bars. */ if (bar && xev->mods.effective & ControlMask) { - x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie, + source ? source->name : Qnil); *finish = X_EVENT_DROP; } #endif commit f1ab92bc2350fb87ac9a6891d3cea2e97969a933 Author: dickmao Date: Wed May 4 19:23:53 2022 -0400 Transcription error * lisp/gnus/gnus-topic.el (gnus-topic-display-missing-topic): Indent. (gnus-topic-update-topic-line): Insert missing fourth argument. diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 36b97acec8..fa942bee8e 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -748,8 +748,8 @@ articles in the topic and its subtopics." (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) (all-groups (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode) nil t)) + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode) nil t)) entry) (while children (cl-incf unread (gnus-topic-unread (caar (pop children))))) @@ -788,8 +788,8 @@ articles in the topic and its subtopics." (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) (all-groups (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode) t)) + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode) nil t)) (parent (gnus-topic-parent-topic topic-name)) (all-entries entries) (unread 0) commit a35639015c532c1fe418420cb8cb1da9053b4162 Author: Sean Whitton Date: Wed May 4 16:31:28 2022 -0700 Revert "server-execute: Initialize the *scratch* buffer" This reverts commit f2d2fe6fc8ef0b6087c4a8a69d05a4e521b23047. To be replaced with factoring out *scratch* buffer initialization. diff --git a/lisp/server.el b/lisp/server.el index fc6991df5f..763cf27f7a 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -82,9 +82,7 @@ ;;; Code: -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) +(eval-when-compile (require 'cl-lib)) (defgroup server nil "Emacs running as a server process." @@ -1368,14 +1366,9 @@ The following commands are accepted by the client: (find-file-noselect initial-buffer-choice)) ((functionp initial-buffer-choice) (funcall initial-buffer-choice))))) - (if (buffer-live-p buf) - (switch-to-buffer buf 'norecord) - (if-let ((scratch (get-buffer "*scratch*"))) - (switch-to-buffer scratch 'norecord) - (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) - (when initial-scratch-message - (insert initial-scratch-message)) - (funcall initial-major-mode))))) + (switch-to-buffer + (if (buffer-live-p buf) buf (get-buffer-create "*scratch*")) + 'norecord))) ;; Delete the client if necessary. (cond commit 8368610ff5b384b6c4ff08414bf33be5c59ee703 Author: Glenn Morris Date: Wed May 4 15:02:40 2022 -0700 Stop esh-var-tests leaving temp files behind * test/lisp/eshell/esh-var-tests.el (esh-var-test/quoted-interp-temp-cmd): Don't leave temporary files. diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 3f3b591c5a..4e2a18861e 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -333,7 +333,12 @@ inside double-quotes" (ert-deftest esh-var-test/quoted-interp-temp-cmd () "Interpolate command result redirected to temp file inside double-quotes" - (should (equal (eshell-test-command-result "cat \"$\"") "hi"))) + (let ((temporary-file-directory + (file-name-as-directory (make-temp-file "esh-vars-tests" t)))) + (unwind-protect + (should (equal (eshell-test-command-result "cat \"$\"") + "hi")) + (delete-directory temporary-file-directory t)))) (ert-deftest esh-var-test/quoted-interp-concat-cmd () "Interpolate and concat command with literal" commit 2b50dbb1a51054f8b6b1214db9dd0a69dd342c93 Author: Eric Abrahamsen Date: Wed May 4 12:54:37 2022 -0700 Remove bogus mode check from gnus topic update functions * lisp/gnus/gnus-topic.el (gnus-topic-update-topics-containing-group): (gnus-topic-update-topic): These functions originally checked to see if we were in group mode, but later that check was changed to 'gnus-topic-mode, which never passes because 'gnus-topic-mode isn't a major mode. Revert to checking for 'gnus-group-mode, and use `derived-mode-p' while we're at it. diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 479bba3a73..36b97acec8 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -678,7 +678,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topics-containing-group (group) "Update all topics that have GROUP as a member." - (when (and (eq major-mode 'gnus-topic-mode) + (when (and (derived-mode-p 'gnus-group-mode) gnus-topic-mode) (save-excursion (let ((alist gnus-topic-alist)) @@ -694,7 +694,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topic () "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-topic-mode) + (when (and (derived-mode-p 'gnus-group-mode) gnus-topic-mode) (let ((group (gnus-group-group-name)) (m (point-marker)) commit 78df8a0e3d3cce35fbcc972a62200a9da506a0a1 Author: Juri Linkov Date: Wed May 4 22:32:30 2022 +0300 * lisp/tab-bar.el: Use pixel-based alignment (bug#55207) * lisp/tab-bar.el (tab-bar-format-align-right): Use string-pixel-width on the string with tab-bar face to get the width in pixels to align. (tab-bar-format-global): Remove string-trim-right to keep padding-right. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index a0dd20a99c..42c4b822bc 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -915,8 +915,8 @@ when the tab is current. Return the result as a keymap." (let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format))) (rest (tab-bar-format-list rest)) (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) - (hpos (length rest)) - (str (propertize " " 'display `(space :align-to (- right ,hpos))))) + (hpos (string-pixel-width (propertize rest 'face 'tab-bar))) + (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) `((align-right menu-item ,str ignore)))) (defun tab-bar-format-global () @@ -926,7 +926,7 @@ When `tab-bar-format-global' is added to `tab-bar-format' then modes that display information on the mode line using `global-mode-string' will display the same text on the tab bar instead." - `((global menu-item ,(string-trim-right (format-mode-line global-mode-string)) ignore))) + `((global menu-item ,(format-mode-line global-mode-string) ignore))) (defun tab-bar-format-list (format-list) (let ((i 0)) commit e88d91b1d2f94b21bd5560670c575069164aff05 Author: Basil L. Contovounesios Date: Wed May 4 21:54:49 2022 +0300 Remove unused lexvar in subr-x-tests.el * test/lisp/emacs-lisp/subr-x-tests.el (test-with-buffer-unmodified-if-unchanged): Pacify unused lexvar byte-compiler warning. Simplify slightly and reindent. diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index dca7df6309..7f3916c2c0 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -722,28 +722,26 @@ (with-buffer-unmodified-if-unchanged (insert "t") (delete-char -1)) - (should (not (buffer-modified-p)))) + (should-not (buffer-modified-p))) ;; Shouldn't error. (should (with-temp-buffer - (let ((inner (current-buffer))) - (with-buffer-unmodified-if-unchanged - (insert "t") - (delete-char -1) - (kill-buffer (current-buffer)) - t)))) + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (kill-buffer)))) (with-temp-buffer (let ((outer (current-buffer))) (with-temp-buffer (let ((inner (current-buffer))) - (with-buffer-unmodified-if-unchanged - (insert "t") - (delete-char -1) - (set-buffer outer)) - (with-current-buffer inner - (should (not (buffer-modified-p))))))))) + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (set-buffer outer)) + (with-current-buffer inner + (should-not (buffer-modified-p)))))))) (provide 'subr-x-tests) commit 34a45de19a17deffa9c6427ff7d8f0959a026fbb Author: Glenn Morris Date: Wed May 4 07:48:22 2022 -0700 * src/xterm.c (handle_one_xevent): Fix int/Lisp_Object mix-up. ; Flagged by --enable-check-lisp-object-type diff --git a/src/xterm.c b/src/xterm.c index 01832d60c9..0625b03ea0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -17192,7 +17192,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XSETFRAME (inev.ie.frame_or_window, f); } - if (source && source->name) + if (source && !NILP (source->name)) inev.ie.device = source->name; goto XI_OTHER; commit eaa198cd75ad9cbe4c07532747bcb08516dcc0b2 Author: Robert Pluim Date: Wed May 4 14:53:34 2022 +0200 ; Re-fix last change in doc of 'with-buffer-unmodified-if-unchanged'. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 5d604be4ae..9cd793d05c 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -433,7 +433,7 @@ as stored in the internal representation, are monitored for the purpose of detecting the lack of changes in buffer text. Any other changes that are normally perceived as \"buffer modifications\", such as changes in text properties, `buffer-file-coding-system', buffer -multibytenes, etc. -- will not be noticed, and the buffer will still +multibyteness, etc. -- will not be noticed, and the buffer will still be marked unmodified, effectively ignoring those changes." (declare (debug t) (indent 0)) (let ((hash (gensym)) commit d2119be861d4aa89b0a43720846b412dc37604f2 Author: Robert Pluim Date: Wed May 4 14:48:27 2022 +0200 * etc/NEWS: Improve some NEWS entries diff --git a/etc/NEWS b/etc/NEWS index 1fd7e0bd24..6637eda00c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -40,13 +40,13 @@ the option '--with-be-app', the resulting Emacs will only run in text-mode terminals. +++ -*** Cairo drawing support has been enabled for Haiku builds. +** Cairo drawing support has been enabled for Haiku builds. To enable Cairo support, ensure that the Cairo and FreeType development files are present on your system, and configure Emacs with '--with-be-cairo'. --- -*** Double buffering is now enabled on the Haiku operating system. +** Double buffering is now enabled on the Haiku operating system. Unlike X, there is no compile-time option to enable or disable double-buffering. If you wish to disable double-buffering, change the frame parameter 'inhibit-double-buffering' instead. @@ -65,8 +65,8 @@ headers installed, Emacs will use the X Input Extension for handling input. If this causes problems, you can configure Emacs with the option '--without-xinput2' to disable this support. -The named feature 'xinput2' can be used to test for the presence of -XInput 2 support from Lisp programs. +(featurep 'xinput2) can be used to test for the presence of XInput 2 +support from Lisp programs. +++ ** Emacs now supports being built with pure GTK. @@ -93,10 +93,10 @@ as was already the case for all the non-preloaded files. The option 'desktop-load-locked-desktop' can now be set to the value 'check-pid', which means to allow loading a locked ".emacs.desktop" file if the Emacs process which locked it is no longer running on the -local machine. This allows to avoid asking questions about locked -desktop files when the Emacs session which locked it crashes or was -otherwise interrupted and didn't exit gracefully. See the "(emacs) -Saving Emacs Sessions" node in the Emacs manual for more details. +local machine. This allows avoiding questions about locked desktop +files when the Emacs session which locked it crashes, or was otherwise +interrupted, and didn't exit gracefully. See the "(emacs) Saving +Emacs Sessions" node in the Emacs manual for more details. * Startup Changes in Emacs 29.1 @@ -151,7 +151,7 @@ newline. --- ** 'TAB' and '' are now bound in 'button-map'. -This means that if you're standing on a button, 'TAB' will take you to +This means that if your cursor is on a button, 'TAB' will take you to the next button, even if the mode has bound it to something else. This also means that 'TAB' on a button in an 'outline-minor-mode' heading will move point instead of collapsing the outline. @@ -449,6 +449,8 @@ command also works for non-Emoji characters.) --- *** New input method 'emoji'. +This allows you to enter emoji using short strings, eg :face_palm: or +:scream:. ** Help @@ -1191,8 +1193,8 @@ user options that are no longer needed are now obsolete: *** Navigation and marking commands now work in image display buffer. The following new bindings have been added: - n / SPC image-dired-display-next-thumbnail-original - p / DEL image-dired-display-previous-thumbnail-original + n or SPC image-dired-display-next-thumbnail-original + p or DEL image-dired-display-previous-thumbnail-original m image-dired-mark-thumb-original-file d image-dired-flag-thumb-original-file u image-dired-unmark-thumb-original-file @@ -1351,7 +1353,7 @@ will abbreviate the user's home directory, for example by abbreviating +++ *** New user option 'tramp-use-scp-direct-remote-copying'. When set to non-nil, Tramp does not copy files between two remote -hosts via a local copy in its temporary directory, but let the 'scp' +hosts via a local copy in its temporary directory, but lets the 'scp' command do this job. +++ @@ -1964,8 +1966,10 @@ It marks the image with the 'inhibit-isearch' text property, which inhibits 'isearch' matching the STRING parameter. --- -** New function 'replace-regexp-function'. -It can be used to implement own regexp syntax for search/replace. +** New variable 'replace-regexp-function'. +Function to call to convert the entered FROM string to an Emacs +regexp in 'query-replace' and similar commands. It can be used to +implement a different regexp syntax for search/replace. --- ** New variables to customize defaults of FROM for 'query-replace*' commands. @@ -2240,7 +2244,7 @@ translation. +++ ** 'shell-quote-argument' has a new optional parameter POSIX. This is useful when quoting shell arguments for a remote shell -invocation. Such shells are POSIX conform by default. +invocation. Such shells are POSIX conformant by default. +++ ** 'signal-process' now consults the list 'signal-process-functions'. @@ -2250,8 +2254,8 @@ asynchronous processes. The hitherto existing implementation has been moved to 'signal-default-interrupt-process'. +++ -** 'list-system-processes' returns remote process IDs now. -This happens, when the current buffer's 'default-directory' is +** 'list-system-processes' now returns remote process IDs. +This happens only when the current buffer's 'default-directory' is remote. In order to preserve the old behavior, apply (let ((default-directory temporary-file-directory)) commit 0d78aeeb7ea4aac6938978bad0439e0b4f96b8db Author: Robert Pluim Date: Wed May 4 14:46:59 2022 +0200 ; * etc/PROBLEMS: Fix typo. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 482c29f330..270de600d6 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1851,7 +1851,7 @@ your X defaults file to avoid the problem: XTerm.*.allowSendEvents: True -Note that this can in theory pose a security risk, but in pratice +Note that this can in theory pose a security risk, but in practice modern X servers have so many other ways to send input to clients without signifying that the event is synthesized that it does not matter. commit 9775c15c983740c5535bb817bdcf5fbbe67bd4b3 Author: Robert Pluim Date: Wed May 4 14:35:59 2022 +0200 * doc/emacs/killing.texi: Fix typos * doc/emacs/killing.texi (Clipboard): Fix wording in description of 'save-interprogram-paste-before-kill'. Ensure the reference to "Yanking Media" is not split over two lines. diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index cc349a6a02..2fd2d21dd3 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -540,11 +540,11 @@ clipboard. clipboard contents are normally lost. Optionally, Emacs can save the existing clipboard contents to the kill ring, preventing you from losing the old clipboard data. If -@code{save-interprogram-paste-before-kill} changed to a number, then -this data is copied over if it's smaller (in characters) than this -number. If this variable is any other non-@code{nil} value, it's -always copied over---at the risk of high memory consumption if that -data turns out to be large. +@code{save-interprogram-paste-before-kill} has been set to a number, +then the data is copied over if it's smaller (in characters) than +this number. If this variable is any other non-@code{nil} value, the +data is always copied over---at the risk of high memory consumption if +that data turns out to be large. Yank commands, such as @kbd{C-y} (@code{yank}), also use the clipboard. If another application ``owns'' the clipboard---i.e., if @@ -567,8 +567,8 @@ change the variable @code{select-enable-clipboard} to @code{nil}. instance, a web browser will usually let you choose ``Copy Image'' on images, and this image will be put on the clipboard. On capable platforms, Emacs can yank these objects with the @code{yank-media} -command---but only in modes that have support for it (@pxref{Yanking -Media,,, elisp, The Emacs Lisp Reference Manual}). +command---but only in modes that have support for it (@w{@pxref{Yanking +Media,,, elisp, The Emacs Lisp Reference Manual}}). @cindex clipboard manager @vindex x-select-enable-clipboard-manager commit 1a72248901cc0cdb2e8d09dee68483d808c57d4e Author: Eli Zaretskii Date: Wed May 4 13:08:53 2022 +0300 ; Fix last change in doc string of 'with-buffer-unmodified-if-unchanged'. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 9339acc909..5d604be4ae 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -433,7 +433,8 @@ as stored in the internal representation, are monitored for the purpose of detecting the lack of changes in buffer text. Any other changes that are normally perceived as \"buffer modifications\", such as changes in text properties, `buffer-file-coding-system', buffer -multibytenes, etc. -- will still cause the buffer to become modified." +multibytenes, etc. -- will not be noticed, and the buffer will still +be marked unmodified, effectively ignoring those changes." (declare (debug t) (indent 0)) (let ((hash (gensym)) (buffer (gensym))) commit 54e5fc19e47acee6cef472ec0bf817dad75a7acf Author: Po Lu Date: Wed May 4 17:15:24 2022 +0800 ; Fix typo in emacs-news-mode * lisp/textmodes/emacs-news-mode.el (emacs-news-count-untagged-entries): Fix typo in message when there are a pural amount of untagged entries. diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index 2ebd4aa829..fdb3cb8628 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -158,7 +158,7 @@ untagged NEWS entry." (setq i (1+ i))) (message (if (= i 1) "There's 1 untagged entry" - (format "There's %s untagged entries" i)))))) + (format "There are %s untagged entries" i)))))) (defun emacs-news--buttonize () "Make manual and symbol references into buttons." commit b8357cd50e463354fd62db8225311d0c49617623 Author: Eli Zaretskii Date: Wed May 4 12:06:10 2022 +0300 ; * lisp/frameset.el: Fix a typo in a comment. diff --git a/lisp/frameset.el b/lisp/frameset.el index 23847a74a3..a589f7b5d9 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -1312,7 +1312,7 @@ All keyword parameters default to nil." ;; Apply small offsets to each frame that came from ;; a TTY-saved desktop, so that they don't obscure ;; each other, but only if we don't have real frame - ;; position infor from a GUI session in some, + ;; position info from a GUI session in some, ;; possibly distant, past. (when (and (frameset-switch-to-gui-p frame-cfg) (null (cdr (assq 'GUI:top frame-cfg))) commit b4acb1807b7044739bfd07143aee1433e87a25d4 Author: Eli Zaretskii Date: Wed May 4 12:04:53 2022 +0300 Fix restoring desktop from TTY-saved sessions * lisp/frameset.el (frameset-restore): Don't override/fix position of the restored frames for which we have geometry information saved by a past GUI session. (Bug#55070) diff --git a/lisp/frameset.el b/lisp/frameset.el index 34572000de..23847a74a3 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -1309,9 +1309,14 @@ All keyword parameters default to nil." (setq mb-window nil))) (when mb-window (push (cons 'minibuffer mb-window) frame-cfg)))))) - (when (frameset-switch-to-gui-p frame-cfg) - ;; Apply small offsets to each frame, so that they - ;; don't obscure each other. + ;; Apply small offsets to each frame that came from + ;; a TTY-saved desktop, so that they don't obscure + ;; each other, but only if we don't have real frame + ;; position infor from a GUI session in some, + ;; possibly distant, past. + (when (and (frameset-switch-to-gui-p frame-cfg) + (null (cdr (assq 'GUI:top frame-cfg))) + (null (cdr (assq 'GUI:left frame-cfg)))) (setq dx (+ dx 20) dy (+ dy 10))) ;; OK, we're ready at last to create (or reuse) a frame and commit 0105a4ddb8a58146f3fc71c265e57291c873af0b Author: Po Lu Date: Wed May 4 16:48:24 2022 +0800 Turn on XInput 2 support by default The support doesn't interfere with compatibility, since Emacs built with XInput 2 support transparently falls back to Core Input when a suitable version of the input extension is not available. It also matured much sooner than expected, so enabling this by default will lead to new features being available to more users. * INSTALL: * configure.ac: * etc/NEWS: Enable XInput 2 support by default. diff --git a/INSTALL b/INSTALL index f2687225da..95d2dbda80 100644 --- a/INSTALL +++ b/INSTALL @@ -358,9 +358,9 @@ Use --without-toolkit-scroll-bars to disable Motif or Xaw3d scroll bars. Use --without-xim to inhibit the default use of X Input Methods. In this case, the X resource useXIM can be used to turn on use of XIM. -Use --with-xinput2 to enable the use of version 2 of the X Input -Extension. This enables support for touchscreens, pinch gestures, and -scroll wheels that report scroll deltas at pixel-level precision. +Use --without-xinput2 to disable the use of version 2 of the X Input +Extension. This disables support for touchscreens, pinch gestures, +and scroll wheels that report scroll deltas at pixel-level precision. Use --disable-largefile to omit support for files larger than 2GB, and --disable-year2038 to omit support for timestamps past the year 2038, diff --git a/configure.ac b/configure.ac index b7189593a6..484ce980a5 100644 --- a/configure.ac +++ b/configure.ac @@ -490,7 +490,7 @@ OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support]) OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support]) OPTION_DEFAULT_OFF([native-compilation],[compile with Emacs Lisp native compiler support]) OPTION_DEFAULT_OFF([cygwin32-native-compilation],[use native compilation on 32-bit Cygwin]) -OPTION_DEFAULT_OFF([xinput2],[use version 2 of the X Input Extension for input]) +OPTION_DEFAULT_ON([xinput2],[don't use version 2 of the X Input Extension for input]) AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])], diff --git a/etc/NEWS b/etc/NEWS index 73e61aab32..1fd7e0bd24 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -59,10 +59,11 @@ If a constant file name is required, the file can be renamed to "emacs.pdmp", and Emacs will find it during startup anyway. --- -** Emacs now supports use of XInput 2 for input events. -If your X server has support and you have the XInput 2 development headers -installed, you can configure Emacs with the option '--with-xinput2' to enable -this support. +** Emacs now uses of XInput 2 for input events. +If your X server has support and you have the XInput 2 development +headers installed, Emacs will use the X Input Extension for handling +input. If this causes problems, you can configure Emacs with the +option '--without-xinput2' to disable this support. The named feature 'xinput2' can be used to test for the presence of XInput 2 support from Lisp programs. commit 69521ffcb0f2a28f84e24137bfc789ffd0ec3f2f Author: Eli Zaretskii Date: Wed May 4 11:46:01 2022 +0300 Clarify the doc string of 'with-buffer-unmodified-if-unchanged' * lisp/emacs-lisp/subr-x.el (with-buffer-unmodified-if-unchanged): Describe better what is meant by "buffer changes". (Bug#4587) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 298d370cb2..9339acc909 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -417,16 +417,23 @@ this defaults to the current buffer." process))) (defmacro with-buffer-unmodified-if-unchanged (&rest body) - "Like `progn', but change buffer modification status only if buffer is changed. -That is, if the buffer is marked as unmodified before BODY, and -BODY does modifications that, in total, means that the buffer is -identical to the buffer before BODY, mark the buffer as -unmodified again. In other words, this won't change buffer -modification status: + "Like `progn', but change buffer-modified status only if buffer text changes. +If the buffer was unmodified before execution of BODY, and +buffer text after execution of BODY is identical to what it was +before, ensure that buffer is still marked unmodified afterwards. +For example, the following won't change the buffer's modification +status: (with-buffer-unmodified-if-unchanged (insert \"a\") - (delete-char -1))." + (delete-char -1)) + +Note that only changes in the raw byte sequence of the buffer text, +as stored in the internal representation, are monitored for the +purpose of detecting the lack of changes in buffer text. Any other +changes that are normally perceived as \"buffer modifications\", such +as changes in text properties, `buffer-file-coding-system', buffer +multibytenes, etc. -- will still cause the buffer to become modified." (declare (debug t) (indent 0)) (let ((hash (gensym)) (buffer (gensym))) commit 19231f7db24e4f697a0aaa95b65a51008763d580 Author: Po Lu Date: Wed May 4 08:40:41 2022 +0000 Remove unused variable in Haiku selection code * src/haiku_select.cc (selection_state_flag): * src/haikuselect.h: Remove variable. diff --git a/src/haiku_select.cc b/src/haiku_select.cc index be8026b6a1..a26a0049cb 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -35,8 +35,6 @@ static int64 count_clipboard = -1; static int64 count_primary = -1; static int64 count_secondary = -1; -int selection_state_flag; - static char * BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) { diff --git a/src/haikuselect.h b/src/haikuselect.h index a99721dd22..d4f331a9cc 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -21,6 +21,8 @@ along with GNU Emacs. If not, see . */ #ifdef __cplusplus #include +#else +#include #endif #include @@ -33,13 +35,11 @@ enum haiku_clipboard }; #ifdef __cplusplus -#include extern "C" { extern void init_haiku_select (void); #endif /* Whether or not the selection was recently changed. */ -extern int selection_state_flag; /* Find a string with the MIME type TYPE in the system clipboard. */ extern char *BClipboard_find_system_data (const char *, ssize_t *); commit da1b7b659048320850e5778e3dfbe5eff366e45d Author: Eli Zaretskii Date: Wed May 4 11:20:05 2022 +0300 ; * lisp/international/characters.el (#xfb50): Fix last change. diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 03fb181086..ca28222c81 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -303,7 +303,7 @@ with L, LRE, or LRO Unicode bidi character type.") (setq charsets (cdr charsets)))) (modify-category-entry '(#x600 . #x6ff) ?b) (modify-category-entry '(#x870 . #x8ff) ?b) -(modify-category-entry '(#xfb50 . #xfdc0) ?b) +(modify-category-entry '(#xfb50 . #xfdcf) ?b) (modify-category-entry '(#xfdf0 . #xfdff) ?b) (modify-category-entry '(#xfe70 . #xfefe) ?b) commit 8f17e4de2d7d5ab21e752b27a355d28b1e17d971 Author: Eli Zaretskii Date: Wed May 4 11:14:45 2022 +0300 Fix 'bidi-class' property of unassigned codepoints * admin/unidata/unidata-gen.el (unidata-file-alist): Update the default values of 'bidi-class' according to the latest Unicode Standard. * admin/notes/unicode: Mention possible changes in DerivedBidiClass.txt that need to be reflected in unidata-gen.el. * lisp/international/characters.el (#xfb50, #xfdf0): Fix the Arabic block characters. (Bug#55256) diff --git a/admin/notes/unicode b/admin/notes/unicode index 4166199500..f699f4fb1c 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -36,6 +36,12 @@ copyright.html in admin/unidata (some of them might need trailing whitespace removed before they can be committed to the Emacs repository). +Next, review the assignment of default values of the Bidi Class +property to blocks in the file extracted/DerivedBidiClass.txt from the +UCD (search for "unassigned" in that file). Any changes should be +reflected in the unidata-gen.el file, where it sets up the default +values around line 210. + Then Emacs should be rebuilt for them to take effect. Rebuilding Emacs updates several derived files elsewhere in the Emacs source tree, mainly in lisp/international/. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index ad72eed995..149f753558 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -209,9 +209,15 @@ Property value is one of the following symbols: ;; The assignment of default values to blocks of code points ;; follows the file DerivedBidiClass.txt from the Unicode ;; Character Database (UCD). - (L (#x0600 #x06FF AL) (#xFB50 #xFDFF AL) (#xFE70 #xFEFF AL) - (#x0590 #x05FF R) (#x07C0 #x08FF R) - (#xFB1D #xFB4F R) (#x10800 #x10FFF R) (#x1E800 #x1EFFF R)) + (L (#x0600 #x07BF AL) (#x0860 #x08FF AL) (#xFB50 #xFDCF AL) + (#xFDF0 #xFDFF AL) (#xFE70 #xFEFF AL) (#x10D00 #x10D3F AL) + (#x10F30 #x10F6F AL) (#x1EC70 #x1ECBF AL) (#x1ED00 #x1ED4F AL) + (#x1EE00 #x1EEFF AL) + (#x0590 #x05FF R) (#x07C0 #x085F R) (#xFB1D #xFB4F R) + (#x10800 #x10CFF R) (#x10D40 #x10F2F R) (#x10F70 #x10FFF R) + (#x1E800 #x1EC6F R) (#x1ECC0 #x1ECFF R) (#x1ED50 #x1EDFF R) + (#x1EF00 #x1EFFF R) + (#x20A0 #x20CF ET)) ;; The order of elements must be in sync with bidi_type_t in ;; src/dispextern.h. (L R EN AN BN B AL LRE LRO RLE RLO PDF LRI RLI FSI PDI diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 63ac455ea6..03fb181086 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -303,7 +303,8 @@ with L, LRE, or LRO Unicode bidi character type.") (setq charsets (cdr charsets)))) (modify-category-entry '(#x600 . #x6ff) ?b) (modify-category-entry '(#x870 . #x8ff) ?b) -(modify-category-entry '(#xfb50 . #xfdff) ?b) +(modify-category-entry '(#xfb50 . #xfdc0) ?b) +(modify-category-entry '(#xfdf0 . #xfdff) ?b) (modify-category-entry '(#xfe70 . #xfefe) ?b) ;; Cyrillic character set (ISO-8859-5) commit d2913901dcfaec60ce6a199a1252003e818a914d Author: Lars Ingebrigtsen Date: Wed May 4 09:34:56 2022 +0200 Flush the tool bar cache on all terminals when adding new entries * lisp/tool-bar.el (tool-bar--flush-cache): Flush the cache for the current tool bar on all terminals. diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index b3915c267c..82b458e010 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -95,7 +95,15 @@ functions.") (cons (frame-terminal) (sxhash-eq tool-bar-map))) (defun tool-bar--flush-cache () - (setf (gethash (tool-bar--cache-key) tool-bar-keymap-cache) nil)) + "Remove all cached entries that refer to the current `tool-bar-map'." + (let ((id (sxhash-eq tool-bar-map)) + (entries nil)) + (maphash (lambda (k _) + (when (equal (cdr k) id) + (push k entries))) + tool-bar-keymap-cache) + (dolist (k entries) + (remhash k tool-bar-keymap-cache)))) (defun tool-bar-make-keymap (&optional _ignore) "Generate an actual keymap from `tool-bar-map'. commit 4c9a7010bc553abb07ccc3c998faff9cf4472ed1 Author: Po Lu Date: Wed May 4 15:31:32 2022 +0800 Correctly encode and decode filenames on NS * src/nsfns.m (Fns_read_file_name): Run dir through ENCODE_FILE and fname through DECODE_FILE. diff --git a/src/nsfns.m b/src/nsfns.m index 41fea6f0fe..a67dafe095 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1677,16 +1677,18 @@ Frames are listed from topmost (first) to bottommost (last). */) BOOL isSave = NILP (mustmatch) && NILP (dir_only_p); id panel; Lisp_Object fname = Qnil; - - NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : - [NSString stringWithLispString:prompt]; - NSString *dirS = NILP (dir) || !STRINGP (dir) ? - [NSString stringWithLispString:BVAR (current_buffer, directory)] : - [NSString stringWithLispString:dir]; - NSString *initS = NILP (init) || !STRINGP (init) ? nil : - [NSString stringWithLispString:init]; + NSString *promptS, *dirS, *initS, *str; NSEvent *nxev; + promptS = (NILP (prompt) || !STRINGP (prompt) + ? nil : [NSString stringWithLispString: prompt]); + dirS = (NILP (dir) || !STRINGP (dir) + ? [NSString stringWithLispString: + ENCODE_FILE (BVAR (current_buffer, directory))] : + [NSString stringWithLispString: ENCODE_FILE (dir)]); + initS = (NILP (init) || !STRINGP (init) + ? nil : [NSString stringWithLispString: init]); + check_window_system (NULL); if (fileDelegate == nil) @@ -1758,9 +1760,15 @@ Frames are listed from topmost (first) to bottommost (last). */) if (ns_fd_data.ret == MODAL_OK_RESPONSE) { - NSString *str = ns_filename_from_panel (panel); - if (! str) str = ns_directory_from_panel (panel); - if (str) fname = [str lispString]; + str = ns_filename_from_panel (panel); + + if (!str) + str = ns_directory_from_panel (panel); + if (str) + fname = [str lispString]; + + if (!NILP (fname)) + fname = DECODE_FILE (fname); } [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; commit 273b0b95c2e21c0d2e306b497b805e07d64fc5bc Author: Po Lu Date: Wed May 4 07:26:43 2022 +0000 Fix file name encoding on Haiku file dialogs * src/haikufns.c (Fhaiku_read_file_name): Use ENCODE_FILE and DECODE_FILE correctly. diff --git a/src/haikufns.c b/src/haikufns.c index bee41e4ec0..e88ded23ff 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -2484,7 +2484,7 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie if (!NILP (dir)) { CHECK_STRING (dir); - dir = DECODE_FILE (dir); + dir = ENCODE_FILE (dir); } if (!NILP (save_text)) @@ -2516,7 +2516,7 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie value = build_string (file_name); free (file_name); - return ENCODE_FILE (value); + return DECODE_FILE (value); } DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource, commit 268713e227e8b665b1874c96ea96d1e7fccaab11 Author: Po Lu Date: Wed May 4 05:46:24 2022 +0000 Set initial size in the Haiku font dialog * src/haiku_support.cc (class EmacsFontSelectionDialog) (EmacsFontSelectionDialog): New argument `initial_size'. (be_select_font): Likewise. * src/haiku_support.h: Update prototypes. * src/haikufont.c (Fx_select_font): Set font dialog size to the pixel size of the current font. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 1280a77b22..311df2e06b 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2577,7 +2577,8 @@ class EmacsFontSelectionDialog : public BWindow EmacsFontSelectionDialog (bool monospace_only, int initial_family_idx, - int initial_style_idx) + int initial_style_idx, + int initial_size) : BWindow (BRect (0, 0, 500, 500), "Select font from list", B_TITLED_WINDOW_LOOK, @@ -2610,6 +2611,7 @@ class EmacsFontSelectionDialog : public BWindow uint32 flags, c; BMessage *selection; BTextView *size_text; + char format_buffer[4]; AddChild (&basic_view); @@ -2670,6 +2672,12 @@ class EmacsFontSelectionDialog : public BWindow for (c = 58; c <= 127; ++c) size_text->DisallowChar (c); + + if (initial_size > 0 && initial_size < 1000) + { + sprintf (format_buffer, "%d", initial_size); + size_entry.SetText (format_buffer); + } } void @@ -4719,7 +4727,8 @@ be_select_font (void (*process_pending_signals_function) (void), haiku_font_family_or_style *family, haiku_font_family_or_style *style, int *size, bool allow_monospace_only, - int initial_family, int initial_style) + int initial_family, int initial_style, + int initial_size) { EmacsFontSelectionDialog *dialog; struct font_selection_dialog_message msg; @@ -4728,7 +4737,8 @@ be_select_font (void (*process_pending_signals_function) (void), font_style style_buffer; dialog = new EmacsFontSelectionDialog (allow_monospace_only, - initial_family, initial_style); + initial_family, initial_style, + initial_size); dialog->CenterOnScreen (); if (dialog->InitCheck () < B_OK) diff --git a/src/haiku_support.h b/src/haiku_support.h index 722c05511c..63ba726050 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -648,7 +648,7 @@ extern bool be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event extern bool be_select_font (void (*) (void), bool (*) (void), haiku_font_family_or_style *, haiku_font_family_or_style *, - int *, bool, int, int); + int *, bool, int, int, int); extern int be_find_font_indices (struct haiku_font_pattern *, int *, int *); #ifdef __cplusplus diff --git a/src/haikufont.c b/src/haikufont.c index cf7cc83085..d18c1a393a 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -1151,7 +1151,7 @@ in the font selection dialog. */) struct font *font; Lisp_Object font_object; haiku_font_family_or_style family, style; - int rc, size, initial_family, initial_style; + int rc, size, initial_family, initial_style, initial_size; struct haiku_font_pattern pattern; Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle, lsize; @@ -1162,6 +1162,7 @@ in the font selection dialog. */) initial_style = -1; initial_family = -1; + initial_size = -1; font = FRAME_FONT (f); @@ -1173,6 +1174,8 @@ in the font selection dialog. */) be_find_font_indices (&pattern, &initial_family, &initial_style); haikufont_done_with_query_pattern (&pattern); + + initial_size = font->pixel_size; } popup_activated_p++; @@ -1181,7 +1184,8 @@ in the font selection dialog. */) haikufont_should_quit_popup, &family, &style, &size, !NILP (exclude_proportional), - initial_family, initial_style); + initial_family, initial_style, + initial_size); request_sigio (); popup_activated_p--; commit 10284ca3d3a01505c3f19668f7e00586cac414b5 Author: Po Lu Date: Wed May 4 03:26:28 2022 +0000 Encode and decode filenames correctly on Haiku * src/haikufns.c (Fhaiku_read_file_name): Decode file names correctly. diff --git a/src/haikufns.c b/src/haikufns.c index 3e3104193e..bee41e4ec0 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -2482,7 +2482,10 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie error ("Trying to use a menu from within a menu-entry"); if (!NILP (dir)) - CHECK_STRING (dir); + { + CHECK_STRING (dir); + dir = DECODE_FILE (dir); + } if (!NILP (save_text)) CHECK_STRING (save_text); @@ -2513,7 +2516,7 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie value = build_string (file_name); free (file_name); - return value; + return ENCODE_FILE (value); } DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource, commit b5cf6c1ab6cc5ca3d7a4b5d1e2b775d7d59a5866 Author: Po Lu Date: Wed May 4 03:23:11 2022 +0000 Clean up Haiku file panel code * lisp/term/haiku-win.el (x-file-dialog): Fix nil values of `default-filename'. * src/haiku_io.c (haiku_len): Remove `FILE_PANEL_EVENT'. (record_c_unwind_protect_from_cxx, c_specpdl_idx_from_cxx) (c_unbind_to_nil_from_cxx): Delete functions. * src/haiku_support.cc (MessageReceived): Write pointer to buffer to file panel port instead. (struct popup_file_dialog_data): Delete strict. (unwind_popup_file_dialog): Delete functions. (be_popup_file_dialog): Accept a pointer to `process_pending_signals' and run nested event loop as usual. * src/haiku_support.h (enum haiku_event_type): Remove `FILE_PANEL_EVENT'. (struct haiku_file_panel_event): Delete struct. * src/haikufns.c (unwind_popup): Delete function. (Fhaiku_read_file_name): Update and quit on invalid filename. * src/haikuterm.c (struct unhandled_event): Delete struct. (haiku_read_socket): Remove "unhandled events". diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 0921079246..5f02087732 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -273,7 +273,8 @@ or a pair of markers) and turns it into a file system reference." (or dir (and default-filename (file-name-directory default-filename))) mustmatch only-dir-p - (file-name-nondirectory default-filename)) + (and default-filename + (file-name-nondirectory default-filename))) (error "x-file-dialog on a tty frame"))) (defun haiku-drag-and-drop (event) diff --git a/src/haiku_io.c b/src/haiku_io.c index 0db5d26314..5d0031ef71 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -91,8 +91,6 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_menu_bar_state_event); case MENU_BAR_SELECT_EVENT: return sizeof (struct haiku_menu_bar_select_event); - case FILE_PANEL_EVENT: - return sizeof (struct haiku_file_panel_event); case MENU_BAR_HELP_EVENT: return sizeof (struct haiku_menu_bar_help_event); case ZOOM_EVENT: @@ -209,24 +207,3 @@ haiku_io_init_in_app_thread (void) if (pthread_sigmask (SIG_BLOCK, &set, NULL)) perror ("pthread_sigmask"); } - -/* Record an unwind protect from C++ code. */ -void -record_c_unwind_protect_from_cxx (void (*fn) (void *), void *r) -{ - record_unwind_protect_ptr (fn, r); -} - -/* SPECPDL_IDX that is safe from C++ code. */ -specpdl_ref -c_specpdl_idx_from_cxx (void) -{ - return SPECPDL_INDEX (); -} - -/* unbind_to (IDX, Qnil), but safe from C++ code. */ -void -c_unbind_to_nil_from_cxx (specpdl_ref idx) -{ - unbind_to (idx, Qnil); -} diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 80c3ba3331..1280a77b22 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -100,6 +100,7 @@ enum REPLAY_MENU_BAR = 3007, FONT_FAMILY_SELECTED = 3008, FONT_STYLE_SELECTED = 3009, + FILE_PANEL_SELECTION = 3010, }; /* X11 keysyms that we use. */ @@ -188,6 +189,10 @@ static void *grab_view = NULL; static BLocker grab_view_locker; static bool drag_and_drop_in_progress; +/* Port used to send data to the main thread while a file panel is + active. */ +static port_id volatile current_file_panel_port; + /* Many places require us to lock the child frame data, and then lock the locker of some random window. Unfortunately, locking such a window might be delayed due to an arriving message, which then @@ -875,46 +880,48 @@ class EmacsWindow : public BWindow haiku_write (MENU_BAR_SELECT_EVENT, &rq); } - else if (msg->what == 'FPSE' + else if (msg->what == FILE_PANEL_SELECTION || ((msg->FindInt32 ("old_what", &old_what) == B_OK - && old_what == 'FPSE'))) + && old_what == FILE_PANEL_SELECTION))) { - struct haiku_file_panel_event rq; + const char *str_path, *name; + char *file_name, *str_buf; BEntry entry; BPath path; entry_ref ref; - rq.ptr = NULL; + file_name = NULL; if (msg->FindRef ("refs", &ref) == B_OK && entry.SetTo (&ref, 0) == B_OK && entry.GetPath (&path) == B_OK) { - const char *str_path = path.Path (); + str_path = path.Path (); + if (str_path) - rq.ptr = strdup (str_path); + file_name = strdup (str_path); } if (msg->FindRef ("directory", &ref), entry.SetTo (&ref, 0) == B_OK && entry.GetPath (&path) == B_OK) { - const char *name = msg->GetString ("name"); - const char *str_path = path.Path (); + name = msg->GetString ("name"); + str_path = path.Path (); if (name) { - char str_buf[std::strlen (str_path) - + std::strlen (name) + 2]; - snprintf ((char *) &str_buf, - std::strlen (str_path) + str_buf = (char *) alloca (std::strlen (str_path) + + std::strlen (name) + 2); + snprintf (str_buf, std::strlen (str_path) + std::strlen (name) + 2, "%s/%s", str_path, name); - rq.ptr = strdup (str_buf); + file_name = strdup (str_buf); } } - haiku_write (FILE_PANEL_EVENT, &rq); + write_port (current_file_panel_port, 0, + &file_name, sizeof file_name); } else BWindow::MessageReceived (msg); @@ -1117,12 +1124,13 @@ class EmacsWindow : public BWindow void Minimize (bool minimized_p) { - BWindow::Minimize (minimized_p); struct haiku_iconification_event rq; + rq.window = this; rq.iconified_p = !parent && minimized_p; - haiku_write (ICONIFICATION, &rq); + + BWindow::Minimize (minimized_p); } void @@ -4121,100 +4129,92 @@ EmacsView_double_buffered_p (void *vw) return db_p; } -struct popup_file_dialog_data -{ - BMessage *msg; - BFilePanel *panel; - BEntry *entry; -}; - -static void -unwind_popup_file_dialog (void *ptr) -{ - struct popup_file_dialog_data *data - = (struct popup_file_dialog_data *) ptr; - BFilePanel *panel = data->panel; - - delete panel; - delete data->entry; - delete data->msg; -} - /* Popup a file dialog. */ char * be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int dir_only_p, void *window, const char *save_text, - const char *prompt, void (*block_input_function) (void), - void (*unblock_input_function) (void), - void (*maybe_quit_function) (void)) -{ - specpdl_ref idx = c_specpdl_idx_from_cxx (); - /* setjmp/longjmp is UB with automatic objects. */ - BWindow *w = (BWindow *) window; - uint32_t mode = (dir_only_p - ? B_DIRECTORY_NODE - : B_FILE_NODE | B_DIRECTORY_NODE); - BEntry *path = new BEntry; - BMessage *msg = new BMessage ('FPSE'); - BFilePanel *panel = new BFilePanel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, - NULL, NULL, mode); - void *buf; - enum haiku_event_type type; - char *ptr; - struct popup_file_dialog_data dat; - ssize_t b_s; - - dat.entry = path; - dat.msg = msg; - dat.panel = panel; - - record_c_unwind_protect_from_cxx (unwind_popup_file_dialog, &dat); + const char *prompt, + void (*process_pending_signals_function) (void)) +{ + BWindow *w, *panel_window; + BEntry path; + BMessage msg (FILE_PANEL_SELECTION); + BFilePanel panel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, + NULL, NULL, (dir_only_p + ? B_DIRECTORY_NODE + : B_FILE_NODE | B_DIRECTORY_NODE)); + object_wait_info infos[2]; + ssize_t status; + int32 reply_type; + char *file_name; + + current_file_panel_port = create_port (1, "file panel port"); + file_name = NULL; + + if (current_file_panel_port < B_OK) + return NULL; if (default_dir) { - if (path->SetTo (default_dir, 0) != B_OK) + if (path.SetTo (default_dir, 0) != B_OK) default_dir = NULL; } - panel->SetMessage (msg); + w = (BWindow *) window; + panel_window = panel.Window (); + + panel.SetMessage (&msg); if (default_dir) - panel->SetPanelDirectory (path); + panel.SetPanelDirectory (&path); + if (save_text) - panel->SetSaveText (save_text); + panel.SetSaveText (save_text); - panel->SetHideWhenDone (0); - panel->Window ()->SetTitle (prompt); - panel->SetTarget (BMessenger (w)); - panel->Show (); + panel_window->SetTitle (prompt); + panel_window->SetFeel (B_MODAL_APP_WINDOW_FEEL); - buf = alloca (200); - while (1) + panel.SetHideWhenDone (false); + panel.SetTarget (BMessenger (w)); + panel.Show (); + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = current_file_panel_port; + infos[1].type = B_OBJECT_TYPE_PORT; + infos[1].events = B_EVENT_READ; + + while (true) { - ptr = NULL; + status = wait_for_objects (infos, 2); - if (!haiku_read_with_timeout (&type, buf, 200, 1000000, false)) - { - block_input_function (); - if (type != FILE_PANEL_EVENT) - haiku_write (type, buf); - else if (!ptr) - ptr = (char *) ((struct haiku_file_panel_event *) buf)->ptr; - unblock_input_function (); + if (status == B_INTERRUPTED || status == B_WOULD_BLOCK) + continue; - maybe_quit_function (); - } + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); - block_input_function (); - haiku_read_size (&b_s, false); - if (!b_s || ptr || panel->Window ()->IsHidden ()) + if (infos[1].events & B_EVENT_READ) { - c_unbind_to_nil_from_cxx (idx); - unblock_input_function (); - return ptr; + status = read_port (current_file_panel_port, + &reply_type, &file_name, + sizeof file_name); + + if (status < B_OK) + file_name = NULL; + + goto out; } - unblock_input_function (); + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_READ; } + + out: + delete_port (current_file_panel_port); + return file_name; } /* Zoom WINDOW. */ diff --git a/src/haiku_support.h b/src/haiku_support.h index 056063864e..722c05511c 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -91,7 +91,6 @@ enum haiku_event_type MENU_BAR_OPEN, MENU_BAR_SELECT_EVENT, MENU_BAR_CLOSE, - FILE_PANEL_EVENT, MENU_BAR_HELP_EVENT, ZOOM_EVENT, DRAG_AND_DROP_EVENT, @@ -222,11 +221,6 @@ struct haiku_menu_bar_select_event void *ptr; }; -struct haiku_file_panel_event -{ - void *ptr; -}; - struct haiku_menu_bar_help_event { void *window; @@ -612,12 +606,7 @@ extern int EmacsView_double_buffered_p (void *); extern char *be_popup_file_dialog (int, const char *, int, int, void *, const char *, - const char *, void (*) (void), - void (*) (void), void (*) (void)); - -extern void record_c_unwind_protect_from_cxx (void (*) (void *), void *); -extern specpdl_ref c_specpdl_idx_from_cxx (void); -extern void c_unbind_to_nil_from_cxx (specpdl_ref); + const char *, void (*) (void)); #ifdef HAVE_NATIVE_IMAGE_API extern int be_can_translate_type_to_bitmap_p (const char *); diff --git a/src/haikufns.c b/src/haikufns.c index 78014c5088..3e3104193e 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -617,14 +617,6 @@ haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval } } -static void -unwind_popup (void) -{ - if (!popup_activated_p) - emacs_abort (); - --popup_activated_p; -} - static Lisp_Object haiku_create_frame (Lisp_Object parms) { @@ -2479,12 +2471,15 @@ Optional arg MUSTMATCH, if non-nil, means the returned file or directory must exist. Optional arg DIR_ONLY_P, if non-nil, means choose only directories. Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry field. */) - (Lisp_Object prompt, Lisp_Object frame, - Lisp_Object dir, Lisp_Object mustmatch, - Lisp_Object dir_only_p, Lisp_Object save_text) + (Lisp_Object prompt, Lisp_Object frame, Lisp_Object dir, + Lisp_Object mustmatch, Lisp_Object dir_only_p, Lisp_Object save_text) { - if (!x_display_list) - error ("Haiku windowing not initialized"); + struct frame *f; + char *file_name; + Lisp_Object value; + + if (popup_activated_p) + error ("Trying to use a menu from within a menu-entry"); if (!NILP (dir)) CHECK_STRING (dir); @@ -2497,37 +2492,28 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie CHECK_STRING (prompt); - CHECK_LIVE_FRAME (frame); - check_window_system (XFRAME (frame)); - - specpdl_ref idx = SPECPDL_INDEX (); - record_unwind_protect_void (unwind_popup); - - struct frame *f = XFRAME (frame); - - FRAME_DISPLAY_INFO (f)->focus_event_frame = f; + f = decode_window_system_frame (frame); ++popup_activated_p; - char *fn = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), - !NILP (dir) ? SSDATA (ENCODE_UTF_8 (dir)) : NULL, - !NILP (mustmatch), !NILP (dir_only_p), - FRAME_HAIKU_WINDOW (f), - !NILP (save_text) ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL, - SSDATA (ENCODE_UTF_8 (prompt)), - block_input, unblock_input, maybe_quit); - - unbind_to (idx, Qnil); + unrequest_sigio (); + file_name = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), + !NILP (dir) ? SSDATA (dir) : NULL, + !NILP (mustmatch), !NILP (dir_only_p), + FRAME_HAIKU_WINDOW (f), + (!NILP (save_text) + ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL), + SSDATA (ENCODE_UTF_8 (prompt)), + process_pending_signals); + request_sigio (); + --popup_activated_p; - block_input (); - BWindow_activate (FRAME_HAIKU_WINDOW (f)); - unblock_input (); + if (!file_name) + quit (); - if (!fn) - return Qnil; + value = build_string (file_name); + free (file_name); - Lisp_Object p = build_string_from_utf8 (fn); - free (fn); - return p; + return value; } DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource, diff --git a/src/haikuterm.c b/src/haikuterm.c index 80c945c772..341288133e 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -54,14 +54,6 @@ static void **fringe_bmps; static int max_fringe_bmp = 0; static Lisp_Object rdb; - -struct unhandled_event -{ - struct unhandled_event *next; - enum haiku_event_type type; - uint8_t buffer[200]; -}; - static bool any_help_event_p; char * @@ -2824,7 +2816,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) int message_count; static void *buf; ssize_t b_size; - struct unhandled_event *unhandled_events = NULL; int button_or_motion_p, do_help; enum haiku_event_type type; struct input_event inev, inev2; @@ -3583,19 +3574,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) f->menu_bar_vector, b->ptr); break; } - case FILE_PANEL_EVENT: - { - if (!popup_activated_p) - continue; - - struct unhandled_event *ev = xmalloc (sizeof *ev); - ev->next = unhandled_events; - ev->type = type; - memcpy (&ev->buffer, buf, 200); - - unhandled_events = ev; - break; - } case MENU_BAR_HELP_EVENT: { struct haiku_menu_bar_help_event *b = buf; @@ -3678,14 +3656,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) } } - for (struct unhandled_event *ev = unhandled_events; ev;) - { - haiku_write_without_signal (ev->type, &ev->buffer, false); - struct unhandled_event *old = ev; - ev = old->next; - xfree (old); - } - if (do_help && !(hold_quit && hold_quit->kind != NO_EVENT)) { Lisp_Object help_frame = Qnil; commit 7dfb068c13205df9e58d289c3fb4ddafd8625600 Author: Po Lu Date: Wed May 4 01:42:11 2022 +0000 * src/haikufns.c (haiku_create_frame): Improve default border width. diff --git a/src/haikufns.c b/src/haikufns.c index 04c58c55a7..78014c5088 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -751,7 +751,7 @@ haiku_create_frame (Lisp_Object parms) gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), "borderwidth", "BorderWidth", RES_TYPE_NUMBER); - gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2), + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (0), "internalBorderWidth", "InternalBorderWidth", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, commit f2d2fe6fc8ef0b6087c4a8a69d05a4e521b23047 Author: Sean Whitton Date: Tue May 3 18:08:14 2022 -0700 server-execute: Initialize the *scratch* buffer * lisp/server.el: Require subr-x when compiling. (server-execute): Initialize the *scratch* buffer in the same way that the scratch-buffer command does, for consistency. diff --git a/lisp/server.el b/lisp/server.el index 763cf27f7a..fc6991df5f 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -82,7 +82,9 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) (defgroup server nil "Emacs running as a server process." @@ -1366,9 +1368,14 @@ The following commands are accepted by the client: (find-file-noselect initial-buffer-choice)) ((functionp initial-buffer-choice) (funcall initial-buffer-choice))))) - (switch-to-buffer - (if (buffer-live-p buf) buf (get-buffer-create "*scratch*")) - 'norecord))) + (if (buffer-live-p buf) + (switch-to-buffer buf 'norecord) + (if-let ((scratch (get-buffer "*scratch*"))) + (switch-to-buffer scratch 'norecord) + (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) + (when initial-scratch-message + (insert initial-scratch-message)) + (funcall initial-major-mode))))) ;; Delete the client if necessary. (cond commit 185c2f1904c457ad043fe28cca915f508569c54a Author: Po Lu Date: Wed May 4 00:47:52 2022 +0000 Fix display of placeholder composite string on Haiku * src/haikuterm.c (haiku_draw_composite_glyph_string_foreground): Correct translation of XDrawRectangle. diff --git a/src/haikuterm.c b/src/haikuterm.c index 1481d95c08..80c945c772 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1351,14 +1351,14 @@ haiku_draw_composite_glyph_string_foreground (struct glyph_string *s) /* Draw a rectangle for the composition if the font for the very first character of the composition could not be loaded. */ - if (s->font_not_found_p && !s->cmp_from) { if (s->hl == DRAW_CURSOR) BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); else BView_SetHighColor (view, s->face->foreground); - BView_StrokeRectangle (view, s->x, s->y, s->width - 1, s->height - 1); + BView_StrokeRectangle (view, s->x, s->y, + s->width, s->height); } else if (!s->first_glyph->u.cmp.automatic) { commit a1dc1512b357e99e78c6f01a20e483f465de0738 Author: Po Lu Date: Wed May 4 08:40:12 2022 +0800 Fix event mask and source indication of _NET_WM_STATE messages * src/xselect.c (x_send_client_event): Make static. * src/xterm.c (set_wm_state): Send event with correct mask and source indication set. * src/xterm.h: Update prototypes. diff --git a/src/xselect.c b/src/xselect.c index 6d167c0b6f..3acfcbe94b 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -60,6 +60,8 @@ static Lisp_Object selection_data_to_lisp_data (struct x_display_info *, ptrdiff_t, Atom, int); static void lisp_data_to_selection_data (struct x_display_info *, Lisp_Object, struct selection_data *); +static void x_send_client_event (Lisp_Object, Lisp_Object, Lisp_Object, + Atom, Lisp_Object, Lisp_Object); /* Printing traces to stderr. */ @@ -2612,7 +2614,7 @@ are ignored. */) return Qnil; } -void +static void x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, Atom message_type, Lisp_Object format, Lisp_Object values) { diff --git a/src/xterm.c b/src/xterm.c index 90182a89f1..01832d60c9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -21071,19 +21071,26 @@ x_wm_supports (struct frame *f, Atom want_atom) static void set_wm_state (Lisp_Object frame, bool add, Atom atom, Atom value) { - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (XFRAME (frame)); - - x_send_client_event (frame, make_fixnum (0), frame, - dpyinfo->Xatom_net_wm_state, - make_fixnum (32), - /* 1 = add, 0 = remove */ - Fcons - (make_fixnum (add), - Fcons - (INT_TO_INTEGER (atom), - (value != 0 - ? list1 (INT_TO_INTEGER (value)) - : Qnil)))); + struct x_display_info *dpyinfo; + XEvent msg; + + dpyinfo = FRAME_DISPLAY_INFO (XFRAME (frame)); + msg.xclient.type = ClientMessage; + msg.xclient.window = FRAME_OUTER_WINDOW (XFRAME (frame)); + msg.xclient.message_type = dpyinfo->Xatom_net_wm_state; + msg.xclient.format = 32; + + msg.xclient.data.l[0] = add ? 1 : 0; + msg.xclient.data.l[1] = atom; + msg.xclient.data.l[2] = value; + msg.xclient.data.l[3] = 1; /* Source indication. */ + msg.xclient.data.l[4] = 0; + + block_input (); + XSendEvent (dpyinfo->display, dpyinfo->root_window, + False, (SubstructureRedirectMask + | SubstructureNotifyMask), &msg); + unblock_input (); } void diff --git a/src/xterm.h b/src/xterm.h index 80b5713798..74e6d1a96c 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1495,13 +1495,6 @@ extern void x_handle_selection_notify (const XSelectionEvent *); extern void x_handle_selection_event (struct selection_input_event *); extern void x_clear_frame_selections (struct frame *); -extern void x_send_client_event (Lisp_Object display, - Lisp_Object dest, - Lisp_Object from, - Atom message_type, - Lisp_Object format, - Lisp_Object values); - extern bool x_handle_dnd_message (struct frame *, const XClientMessageEvent *, struct x_display_info *, commit c761ded251f281236e835df2d23ba5669499abf6 Author: Lars Ingebrigtsen Date: Tue May 3 22:30:39 2022 +0200 Make some recently added tests actually run diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index d38a8e2352..dca7df6309 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -712,5 +712,39 @@ (loop (cdr rest) (+ sum (car rest)))))) (should (equal (mapcar #'funcall funs) '(43 1 0))))) +(ert-deftest test-with-buffer-unmodified-if-unchanged () + (with-temp-buffer + (with-buffer-unmodified-if-unchanged + (insert "t")) + (should (buffer-modified-p))) + + (with-temp-buffer + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1)) + (should (not (buffer-modified-p)))) + + ;; Shouldn't error. + (should + (with-temp-buffer + (let ((inner (current-buffer))) + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (kill-buffer (current-buffer)) + t)))) + + (with-temp-buffer + (let ((outer (current-buffer))) + (with-temp-buffer + (let ((inner (current-buffer))) + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (set-buffer outer)) + (with-current-buffer inner + (should (not (buffer-modified-p))))))))) + + (provide 'subr-x-tests) ;;; subr-x-tests.el ends here diff --git a/test/lisp/sort-tests.el b/test/lisp/sort-tests.el index 5fcae308d6..7f49cc38d1 100644 --- a/test/lisp/sort-tests.el +++ b/test/lisp/sort-tests.el @@ -106,38 +106,5 @@ reversing the sort." :generator (lambda (n) (concat (sort-tests-random-word n) " " (sort-tests-random-word n))) :less-pred (lambda (a b) (string< (field-n a 2) (field-n b 2)))))) -(defun test-with-buffer-unmodified-if-unchanged () - (with-temp-buffer - (with-buffer-unmodified-if-unchanged - (insert "t")) - (should (buffer-modified-p))) - - (with-temp-buffer - (with-buffer-unmodified-if-unchanged - (insert "t") - (delete-char -1)) - (should (not (buffer-modified-p)))) - - ;; Shouldn't error. - (should - (with-temp-buffer - (let ((inner (current-buffer))) - (with-buffer-unmodified-if-unchanged - (insert "t") - (delete-char -1) - (kill-buffer (current-buffer)) - t)))) - - (with-temp-buffer - (let ((outer (current-buffer))) - (with-temp-buffer - (let ((inner (current-buffer))) - (with-buffer-unmodified-if-unchanged - (insert "t") - (delete-char -1) - (set-buffer outer)) - (with-current-buffer inner - (should (not (buffer-modified-p))))))))) - (provide 'sort-tests) ;;; sort-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index a4f531ea4e..3725f180f3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1053,9 +1053,10 @@ final or penultimate step during initialization.")) (should (equal (string-lines "foo\n\n\nbar" t t) '("foo\n" "bar")))) -(defun test-keymap-parse-macros () +(ert-deftest test-keymap-parse-macros () (should (equal (key-parse "C-x ( C-d C-x )") [24 40 4 24 41])) - (should (equal (kbd "C-x ( C-d C-x )") ""))) + (should (equal (kbd "C-x ( C-d C-x )") "")) + (should (equal (kbd "C-x ( C-x )") ""))) (provide 'subr-tests) ;;; subr-tests.el ends here commit 0a2f0e7f8c1ba54d160322c52865feef3e67d79c Author: Lars Ingebrigtsen Date: Tue May 3 22:06:31 2022 +0200 Make with-buffer-unmodified-if-unchanged more efficient * lisp/emacs-lisp/subr-x.el (with-buffer-unmodified-if-unchanged): Make more efficient. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index a416059df6..298d370cb2 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -439,9 +439,9 @@ modification status: ;; If we didn't change anything in the buffer (and the buffer ;; was previously unmodified), then flip the modification status ;; back to "unchanged". - (when (buffer-live-p ,buffer) + (when (and ,hash (buffer-live-p ,buffer)) (with-current-buffer ,buffer - (when (and ,hash (buffer-modified-p) + (when (and (buffer-modified-p) (equal ,hash (buffer-hash))) (restore-buffer-modified-p nil)))))))) commit b7ddd0f2fd08c9dca0b75493e9e809bb5dab40d9 Author: Lars Ingebrigtsen Date: Tue May 3 22:04:39 2022 +0200 Make with-buffer-unmodified-if-unchanged more resilient * lisp/emacs-lisp/subr-x.el (with-buffer-unmodified-if-unchanged): Make more resilient. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 8e763b613e..a416059df6 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -426,22 +426,24 @@ modification status: (with-buffer-unmodified-if-unchanged (insert \"a\") - (delete-char -1)) - -BODY must preserve the current buffer." + (delete-char -1))." (declare (debug t) (indent 0)) - (let ((hash (gensym))) + (let ((hash (gensym)) + (buffer (gensym))) `(let ((,hash (and (not (buffer-modified-p)) - (buffer-hash)))) + (buffer-hash))) + (,buffer (current-buffer))) (prog1 (progn ,@body) ;; If we didn't change anything in the buffer (and the buffer ;; was previously unmodified), then flip the modification status ;; back to "unchanged". - (when (and ,hash (buffer-modified-p) - (equal ,hash (buffer-hash))) - (restore-buffer-modified-p nil)))))) + (when (buffer-live-p ,buffer) + (with-current-buffer ,buffer + (when (and ,hash (buffer-modified-p) + (equal ,hash (buffer-hash))) + (restore-buffer-modified-p nil)))))))) (provide 'subr-x) diff --git a/test/lisp/sort-tests.el b/test/lisp/sort-tests.el index 7f49cc38d1..5fcae308d6 100644 --- a/test/lisp/sort-tests.el +++ b/test/lisp/sort-tests.el @@ -106,5 +106,38 @@ reversing the sort." :generator (lambda (n) (concat (sort-tests-random-word n) " " (sort-tests-random-word n))) :less-pred (lambda (a b) (string< (field-n a 2) (field-n b 2)))))) +(defun test-with-buffer-unmodified-if-unchanged () + (with-temp-buffer + (with-buffer-unmodified-if-unchanged + (insert "t")) + (should (buffer-modified-p))) + + (with-temp-buffer + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1)) + (should (not (buffer-modified-p)))) + + ;; Shouldn't error. + (should + (with-temp-buffer + (let ((inner (current-buffer))) + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (kill-buffer (current-buffer)) + t)))) + + (with-temp-buffer + (let ((outer (current-buffer))) + (with-temp-buffer + (let ((inner (current-buffer))) + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (set-buffer outer)) + (with-current-buffer inner + (should (not (buffer-modified-p))))))))) + (provide 'sort-tests) ;;; sort-tests.el ends here commit b5db5a64435b86de6e5277d1d173c57784783e5e Author: Stefan Monnier Date: Tue May 3 15:35:47 2022 -0400 with-buffer-unmodified-if-unchanged: Tweak the implementation * lisp/emacs-lisp/subr-x.el (with-buffer-unmodified-if-unchanged): Skip the hash if the buffer was not modified at all. Use `restore-buffer-modified-p`. Also mention that it's imperative that the current buffer is preserved. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index afa0423d90..8e763b613e 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -426,7 +426,9 @@ modification status: (with-buffer-unmodified-if-unchanged (insert \"a\") - (delete-char -1))" + (delete-char -1)) + +BODY must preserve the current buffer." (declare (debug t) (indent 0)) (let ((hash (gensym))) `(let ((,hash (and (not (buffer-modified-p)) @@ -437,9 +439,9 @@ modification status: ;; If we didn't change anything in the buffer (and the buffer ;; was previously unmodified), then flip the modification status ;; back to "unchanged". - (when (and ,hash + (when (and ,hash (buffer-modified-p) (equal ,hash (buffer-hash))) - (set-buffer-modified-p nil)))))) + (restore-buffer-modified-p nil)))))) (provide 'subr-x) commit 8a7db868cc28f933bc2fb2739d122ed11c9ec872 Author: Lars Ingebrigtsen Date: Tue May 3 21:29:47 2022 +0200 Add NEWS entry about incompatible sorting command behaviors diff --git a/etc/NEWS b/etc/NEWS index b0758b60a0..73e61aab32 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -135,6 +135,14 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 +--- +** Sorting commands no longer necessarily change modification status. +In earlier Emacs versions, commands like 'M-x sort-lines' would always +change buffer modification status to "modified", whether they changed +something in the buffer or not. This has been changed: The buffer is +marked as modified only if the sorting ended up changing the contents +of the buffer. + --- ** 'string-lines' handles trailing newlines differently. It no longer returns an empty final string if the string ends with a commit 5206596ea7b26e2e9705e4c94184f6d22687c385 Author: Lars Ingebrigtsen Date: Tue May 3 21:23:40 2022 +0200 Make sorting not change buffer modification status always * lisp/sort.el (sort-subr): Don't mark buffer modified if the sorting didn't change anything (bug#4587). diff --git a/lisp/sort.el b/lisp/sort.el index 90eee01caf..d04f075abd 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) + (defgroup sort nil "Commands to sort text in an Emacs buffer." :group 'data) @@ -111,7 +113,8 @@ as start and end positions), and with `string<' otherwise." (lambda (a b) (string< (car a) (car b))))))) (if reverse (setq sort-lists (nreverse sort-lists))) (if messages (message "Reordering buffer...")) - (sort-reorder-buffer sort-lists old))) + (with-buffer-unmodified-if-unchanged + (sort-reorder-buffer sort-lists old)))) (if messages (message "Reordering buffer... Done")))) nil) commit 59353ec7b579213de3c70950d5d938b7540ce72f Author: Lars Ingebrigtsen Date: Tue May 3 21:22:53 2022 +0200 Add new macro with-buffer-unmodified-if-unchanged * lisp/emacs-lisp/subr-x.el (with-buffer-unmodified-if-unchanged): New macro. * lisp/textmodes/fill.el (fill-paragraph): Macro code copied from here. Adjust and use the macro. diff --git a/etc/NEWS b/etc/NEWS index 15c7ce8a90..b0758b60a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1625,6 +1625,12 @@ functions. * Lisp Changes in Emacs 29.1 +--- +** New macro 'with-buffer-unmodified-if-unchanged'. +If the buffer is marked as unmodified, and code does modifications +that, in total, means that the buffer is identical to the buffer +before, mark the buffer as unmodified again. + --- ** New function 'malloc-trim'. This function allows returning unused memory back to the operating diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 6c763bd04d..afa0423d90 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -416,6 +416,31 @@ this defaults to the current buffer." (error "No process selected")) process))) +(defmacro with-buffer-unmodified-if-unchanged (&rest body) + "Like `progn', but change buffer modification status only if buffer is changed. +That is, if the buffer is marked as unmodified before BODY, and +BODY does modifications that, in total, means that the buffer is +identical to the buffer before BODY, mark the buffer as +unmodified again. In other words, this won't change buffer +modification status: + + (with-buffer-unmodified-if-unchanged + (insert \"a\") + (delete-char -1))" + (declare (debug t) (indent 0)) + (let ((hash (gensym))) + `(let ((,hash (and (not (buffer-modified-p)) + (buffer-hash)))) + (prog1 + (progn + ,@body) + ;; If we didn't change anything in the buffer (and the buffer + ;; was previously unmodified), then flip the modification status + ;; back to "unchanged". + (when (and ,hash + (equal ,hash (buffer-hash))) + (set-buffer-modified-p nil)))))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index d3c832a40d..88a8395c88 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) + (defgroup fill nil "Indenting and filling text." :link '(custom-manual "(emacs)Filling") @@ -839,75 +841,67 @@ region, instead of just filling the current paragraph." (interactive (progn (barf-if-buffer-read-only) (list (if current-prefix-arg 'full) t))) - (let ((hash (and (not (buffer-modified-p)) - (buffer-hash)))) - (prog1 - (or - ;; 1. Fill the region if it is active when called interactively. - (and region transient-mark-mode mark-active - (not (eq (region-beginning) (region-end))) - (or (fill-region (region-beginning) (region-end) justify) t)) - ;; 2. Try fill-paragraph-function. - (and (not (eq fill-paragraph-function t)) - (or fill-paragraph-function - (and (minibufferp (current-buffer)) - (= 1 (point-min)))) - (let ((function (or fill-paragraph-function - ;; In the minibuffer, don't count - ;; the width of the prompt. - 'fill-minibuffer-function)) - ;; If fill-paragraph-function is set, it probably - ;; takes care of comments and stuff. If not, it - ;; will have to set fill-paragraph-handle-comment - ;; back to t explicitly or return nil. - (fill-paragraph-handle-comment nil) - (fill-paragraph-function t)) - (funcall function justify))) - ;; 3. Try our syntax-aware filling code. - (and fill-paragraph-handle-comment - ;; Our code only handles \n-terminated comments right now. - comment-start (equal comment-end "") - (let ((fill-paragraph-handle-comment nil)) - (fill-comment-paragraph justify))) - ;; 4. If it all fails, default to the good ol' text paragraph filling. - (let ((before (point)) - (paragraph-start paragraph-start) - ;; Fill prefix used for filling the paragraph. - fill-pfx) - ;; Try to prevent code sections and comment sections from being - ;; filled together. - (when (and fill-paragraph-handle-comment comment-start-skip) - (setq paragraph-start - (concat paragraph-start "\\|[ \t]*\\(?:" - comment-start-skip "\\)"))) - (save-excursion - ;; To make sure the return value of forward-paragraph is - ;; meaningful, we have to start from the beginning of - ;; line, otherwise skipping past the last few chars of a - ;; paragraph-separator would count as a paragraph (and - ;; not skipping any chars at EOB would not count as a - ;; paragraph even if it is). - (move-to-left-margin) - (if (not (zerop (fill-forward-paragraph 1))) - ;; There's no paragraph at or after point: give up. - (setq fill-pfx "") - (let ((end (point)) - (beg (progn (fill-forward-paragraph -1) (point)))) - (goto-char before) - (setq fill-pfx - (if use-hard-newlines - ;; Can't use fill-region-as-paragraph, since this - ;; paragraph may still contain hard newlines. See - ;; fill-region. - (fill-region beg end justify) - (fill-region-as-paragraph beg end justify)))))) - fill-pfx)) - ;; If we didn't change anything in the buffer (and the buffer - ;; was previously unmodified), then flip the modification status - ;; back to "unchanged". - (when (and hash - (equal hash (buffer-hash))) - (set-buffer-modified-p nil))))) + (with-buffer-unmodified-if-unchanged + (or + ;; 1. Fill the region if it is active when called interactively. + (and region transient-mark-mode mark-active + (not (eq (region-beginning) (region-end))) + (or (fill-region (region-beginning) (region-end) justify) t)) + ;; 2. Try fill-paragraph-function. + (and (not (eq fill-paragraph-function t)) + (or fill-paragraph-function + (and (minibufferp (current-buffer)) + (= 1 (point-min)))) + (let ((function (or fill-paragraph-function + ;; In the minibuffer, don't count + ;; the width of the prompt. + 'fill-minibuffer-function)) + ;; If fill-paragraph-function is set, it probably + ;; takes care of comments and stuff. If not, it + ;; will have to set fill-paragraph-handle-comment + ;; back to t explicitly or return nil. + (fill-paragraph-handle-comment nil) + (fill-paragraph-function t)) + (funcall function justify))) + ;; 3. Try our syntax-aware filling code. + (and fill-paragraph-handle-comment + ;; Our code only handles \n-terminated comments right now. + comment-start (equal comment-end "") + (let ((fill-paragraph-handle-comment nil)) + (fill-comment-paragraph justify))) + ;; 4. If it all fails, default to the good ol' text paragraph filling. + (let ((before (point)) + (paragraph-start paragraph-start) + ;; Fill prefix used for filling the paragraph. + fill-pfx) + ;; Try to prevent code sections and comment sections from being + ;; filled together. + (when (and fill-paragraph-handle-comment comment-start-skip) + (setq paragraph-start + (concat paragraph-start "\\|[ \t]*\\(?:" + comment-start-skip "\\)"))) + (save-excursion + ;; To make sure the return value of forward-paragraph is + ;; meaningful, we have to start from the beginning of + ;; line, otherwise skipping past the last few chars of a + ;; paragraph-separator would count as a paragraph (and + ;; not skipping any chars at EOB would not count as a + ;; paragraph even if it is). + (move-to-left-margin) + (if (not (zerop (fill-forward-paragraph 1))) + ;; There's no paragraph at or after point: give up. + (setq fill-pfx "") + (let ((end (point)) + (beg (progn (fill-forward-paragraph -1) (point)))) + (goto-char before) + (setq fill-pfx + (if use-hard-newlines + ;; Can't use fill-region-as-paragraph, since this + ;; paragraph may still contain hard newlines. See + ;; fill-region. + (fill-region beg end justify) + (fill-region-as-paragraph beg end justify)))))) + fill-pfx)))) (declare-function comment-search-forward "newcomment" (limit &optional noerror)) (declare-function comment-string-strip "newcomment" (str beforep afterp)) commit 8ef34a065a10330777b172a7e5608f7939e7af29 Author: Lars Ingebrigtsen Date: Tue May 3 19:20:52 2022 +0200 Fix thinko in recent tool bar caching logic * lisp/tool-bar.el (tool-bar--cache-key): New function. (tool-bar--flush-cache, tool-bar-make-keymap): Use it. diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 490fd0d332..b3915c267c 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -89,17 +89,20 @@ functions.") (declare-function image-mask-p "image.c" (spec &optional frame)) -(defconst tool-bar-keymap-cache (make-hash-table)) +(defconst tool-bar-keymap-cache (make-hash-table :test #'equal)) + +(defun tool-bar--cache-key () + (cons (frame-terminal) (sxhash-eq tool-bar-map))) (defun tool-bar--flush-cache () - (setf (gethash (frame-terminal) tool-bar-keymap-cache) nil)) + (setf (gethash (tool-bar--cache-key) tool-bar-keymap-cache) nil)) (defun tool-bar-make-keymap (&optional _ignore) "Generate an actual keymap from `tool-bar-map'. Its main job is to figure out which images to use based on the display's color capability and based on the available image libraries." - (or (gethash (frame-terminal) tool-bar-keymap-cache) - (setf (gethash (frame-terminal) tool-bar-keymap-cache) + (or (gethash (tool-bar--cache-key) tool-bar-keymap-cache) + (setf (gethash (tool-bar--cache-key) tool-bar-keymap-cache) (tool-bar-make-keymap-1)))) (defun tool-bar-make-keymap-1 () commit 99fbf39d61bf5e3d9618eafced92c2284938632d Author: Lars Ingebrigtsen Date: Tue May 3 18:46:05 2022 +0200 Make tool bar caching more sensible * lisp/tool-bar.el (tool-bar-keymap-cache): Make into a non-weak EQ hash table, which should be faster and not lose the contents after a GC (bug#43397). (tool-bar--flush-cache, tool-bar-make-keymap): Use the terminal only as the key. (tool-bar-local-item, tool-bar-local-item-from-menu): Flush the cache after altering the tool bar. diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 1271d1de23..490fd0d332 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -89,19 +89,18 @@ functions.") (declare-function image-mask-p "image.c" (spec &optional frame)) -(defconst tool-bar-keymap-cache (make-hash-table :weakness t :test 'equal)) +(defconst tool-bar-keymap-cache (make-hash-table)) (defun tool-bar--flush-cache () - (setf (gethash (cons (frame-terminal) tool-bar-map) tool-bar-keymap-cache) - nil)) + (setf (gethash (frame-terminal) tool-bar-keymap-cache) nil)) (defun tool-bar-make-keymap (&optional _ignore) "Generate an actual keymap from `tool-bar-map'. Its main job is to figure out which images to use based on the display's color capability and based on the available image libraries." - (let ((key (cons (frame-terminal) tool-bar-map))) - (or (gethash key tool-bar-keymap-cache) - (puthash key (tool-bar-make-keymap-1) tool-bar-keymap-cache)))) + (or (gethash (frame-terminal) tool-bar-keymap-cache) + (setf (gethash (frame-terminal) tool-bar-keymap-cache) + (tool-bar-make-keymap-1)))) (defun tool-bar-make-keymap-1 () "Generate an actual keymap from `tool-bar-map', without caching." @@ -182,6 +181,7 @@ ICON.xbm, using `find-image'." (let* ((image-exp (tool-bar--image-expression icon))) (define-key-after map (vector key) `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props)) + (tool-bar--flush-cache) (force-mode-line-update))) ;;;###autoload @@ -248,6 +248,7 @@ holds a keymap." (setq rest (cdr rest))) (append `(menu-item ,(car defn) ,rest) (list :image image-exp) props)))) + (tool-bar--flush-cache) (force-mode-line-update)))) ;;; Set up some global items. Additions/deletions up for grabs. commit 3346b94b73d6694333180c1407c20c2f9c97048d Author: Eli Zaretskii Date: Tue May 3 19:38:06 2022 +0300 ; * doc/misc/eshell.texi (Arguments): Fix cross-references. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index dfb22bcb51..d35a642b62 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -238,9 +238,9 @@ specify an argument of some other data type, you can use an (1 2 3) @end example -Additionally, many @ref{Built-ins, Eshell commands} will flatten the -arguments they receive, so passing a list as an argument will -``spread'' the elements into multiple arguments: +Additionally, many built-in Eshell commands (@pxref{Built-ins, Eshell +commands}) will flatten the arguments they receive, so passing a list +as an argument will ``spread'' the elements into multiple arguments: @example ~ $ printnl (list 1 2) 3 @@ -258,7 +258,7 @@ surrounding the string with apostrophes (@code{''}) or double quotes characters like pipe (@code{|}), which could be part of remote file names. -When using @ref{Expansion, expansions} in an Eshell command, the +When using expansions (@pxref{Expansion}) in an Eshell command, the result may potentially be of any data type. To ensure that the result is always a string, the expansion can be surrounded by double quotes. commit 39fb555a9520969e1225851c2666667000bb1569 Author: Eli Zaretskii Date: Tue May 3 19:29:03 2022 +0300 Allow desktop to restore frames and windows on TTY frames * lisp/frameset.el (frameset-persistent-filter-alist): Add 'top', 'left', 'bottom', and 'right' to frame parameters that are shelved and unshelved when switching from GUI to TTY frames and vice versa. (frameset--restore-frame): Accept two optional arguments DX and DY, and offset by them each frame restored from TTY desktop, to make such restored frames more prominently visible. Force such frames to be visible on GUI display, since the visibility parameter is meaningless for TTY frames. (frameset-restore): Pass DX and DY offsets to 'frameset--restore-frame', when restoring TTY frames on GUI display. * lisp/desktop.el (desktop-restore-frameset): Pass the :force-onscreen argument of 'frameset-restore' as nil when restoring frames on text-mode display. (desktop-restore-forces-onscreen): Document that this option has no real effect on restoring frames on text-mode display. (desktop-restoring-frameset-p): Allow restoring frames in non-GUI sessions, but disallow that when the selected frame is the daemon's initial frame. (Bug#55070) diff --git a/lisp/desktop.el b/lisp/desktop.el index f41a41c3c3..e438b98c0e 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -434,7 +434,9 @@ If `all', also restores frames that are partially offscreen onscreen. Note that checking of frame boundaries is only approximate. It can fail to reliably detect frames whose onscreen/offscreen state depends on a few pixels, especially near the right / bottom borders -of the screen." +of the screen. +Text-mode frames are always considered onscreen, so this option has +no effect on restoring frames in a non-GUI session." :type '(choice (const :tag "Only fully offscreen frames" t) (const :tag "Also partially offscreen frames" all) (const :tag "Do not force frames onscreen" nil)) @@ -1251,7 +1253,11 @@ This function also sets `desktop-dirname' to nil." ;; ---------------------------------------------------------------------------- (defun desktop-restoring-frameset-p () "True if calling `desktop-restore-frameset' will actually restore it." - (and desktop-restore-frames desktop-saved-frameset (display-graphic-p) t)) + (and desktop-restore-frames desktop-saved-frameset + ;; Don't restore frames when the selected frame is the daemon's + ;; initial frame. + (not (and (daemonp) (not (frame-parameter nil 'client)))) + t)) (defun desktop-restore-frameset () "Restore the state of a set of frames. @@ -1262,7 +1268,8 @@ being set (usually, by reading it from the desktop)." :reuse-frames (eq desktop-restore-reuses-frames t) :cleanup-frames (not (eq desktop-restore-reuses-frames 'keep)) :force-display desktop-restore-in-current-display - :force-onscreen desktop-restore-forces-onscreen))) + :force-onscreen (and desktop-restore-forces-onscreen + (display-graphic-p))))) ;; Just to silence the byte compiler. ;; Dynamically bound in `desktop-read'. diff --git a/lisp/frameset.el b/lisp/frameset.el index 05884eed3a..34572000de 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -448,6 +448,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) + (bottom . frameset-filter-shelve-param) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) @@ -464,13 +465,20 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) + (GUI:bottom . frameset-filter-unshelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) + (GUI:left . frameset-filter-unshelve-param) + (GUI:right . frameset-filter-unshelve-param) + (GUI:top . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) + (left . frameset-filter-shelve-param) (parent-frame . :never) (mouse-wheel-frame . :never) + (right . frameset-filter-shelve-param) + (top . frameset-filter-shelve-param) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) @@ -1010,13 +1018,15 @@ not be changed once the frame has been created. Internal use only." (cl-loop for param in '(left top width height border-width minibuffer) when (assq param parameters) collect it)) -(defun frameset--restore-frame (parameters window-state filters force-onscreen) +(defun frameset--restore-frame (parameters window-state filters force-onscreen + &optional dx dy) "Set up and return a frame according to its saved state. That means either reusing an existing frame or creating one anew. PARAMETERS is the frame's parameter alist; WINDOW-STATE is its window state. For the meaning of FILTERS and FORCE-ONSCREEN, see `frameset-restore'. Internal use only." (let* ((fullscreen (cdr (assq 'fullscreen parameters))) + (tty-to-GUI (frameset-switch-to-gui-p parameters)) (filtered-cfg (frameset-filter-params parameters filters nil)) (display (cdr (assq 'display filtered-cfg))) ;; post-filtering alt-cfg frame) @@ -1093,6 +1103,14 @@ Internal use only." (not (eq (frame-parameter frame 'visibility) 'icon))) (frameset-move-onscreen frame force-onscreen)) + ;; Frames saved on TTY shall be all considered visible when + ;; restoring on GUI display. Also, offset each new such frame + ;; relative to the previous one, to make it more visible. + (when tty-to-GUI + (push '(visibility . t) alt-cfg) + (when (and (numberp dx) (numberp dy)) + (push (cons 'left (+ (frame-parameter frame 'left) dx)) alt-cfg) + (push (cons 'top (+ (frame-parameter frame 'top) dy)) alt-cfg))) ;; Let's give the finishing touches (visibility, maximization). (when alt-cfg (modify-frame-parameters frame alt-cfg)) ;; Now restore window state. @@ -1216,7 +1234,9 @@ All keyword parameters default to nil." ((pred functionp) (cl-remove-if-not reuse-frames frames)) (_ - (error "Invalid arg :reuse-frames %s" reuse-frames))))) + (error "Invalid arg :reuse-frames %s" reuse-frames)))) + (dx 0) + (dy 0)) ;; Mark existing frames in the map; candidates to reuse are marked as :ignored; ;; they will be reassigned later, if chosen. @@ -1289,11 +1309,16 @@ All keyword parameters default to nil." (setq mb-window nil))) (when mb-window (push (cons 'minibuffer mb-window) frame-cfg)))))) + (when (frameset-switch-to-gui-p frame-cfg) + ;; Apply small offsets to each frame, so that they + ;; don't obscure each other. + (setq dx (+ dx 20) + dy (+ dy 10))) ;; OK, we're ready at last to create (or reuse) a frame and ;; restore the window config. (setq frame (frameset--restore-frame frame-cfg window-cfg (or filters frameset-filter-alist) - force-onscreen)) + force-onscreen dx dy)) ;; Now reset any duplicate frameset--id (when (and duplicate (not (eq frame duplicate))) (set-frame-parameter duplicate 'frameset--id nil)) commit a3a7279a4ab00be69519f98536ec75dc81217b50 Author: Jim Porter Date: Mon May 2 16:56:49 2022 -0700 Improve the behavior of concatenating parts of Eshell arguments Previously, concatenating a list to a string would first convert the list to a string. Now, the string is concatenated with the last element of the list. * lisp/eshell/esh-util.el (eshell-to-flat-string): Make obsolete. * lisp/eshell/esh-arg.el (eshell-concat, eshell-concat-1): New functions. (eshell-resolve-current-argument): Use 'eshell-concat'. * test/lisp/eshell/esh-var-tests.el (esh-var-test/interp-concat-cmd): Add check for concatenation of multiline output of subcommands. (esh-var-test/quoted-interp-concat-cmd): New test. * test/lisp/eshell/em-extpipe-tests.el (em-extpipe-test-13): Use 'eshell-concat'. * doc/misc/eshell.texi (Expansion): Document this behavior. * etc/NEWS: Announce the change (bug#55236). diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index be32b2aced..dfb22bcb51 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1017,11 +1017,37 @@ parsers (such as @command{cpp} and @command{m4}), but in a command shell, they are less often used for constants, and usually for using variables and string manipulation.@footnote{Eshell has no string-manipulation expansions because the Elisp library already -provides many functions for this.} For example, @code{$var} on a line -expands to the value of the variable @code{var} when the line is +provides many functions for this.} For example, @code{$@var{var}} on +a line expands to the value of the variable @var{var} when the line is executed. Expansions are usually passed as arguments, but may also be -used as commands.@footnote{E.g., entering just @samp{$var} at the prompt -is equivalent to entering the value of @code{var} at the prompt.} +used as commands.@footnote{E.g., entering just @samp{$@var{var}} at +the prompt is equivalent to entering the value of @var{var} at the +prompt.} + +You can concatenate expansions with regular string arguments or even +other expansions. In the simplest case, when the expansion returns a +string value, this is equivalent to ordinary string concatenation; for +example, @samp{$@{echo "foo"@}bar} returns @samp{foobar}. The exact +behavior depends on the types of each value being concatenated: + +@table @asis + +@item both strings +Concatenate both values together. + +@item one or both numbers +Concatenate the string representation of each value, converting back to +a number if possible. + +@item one or both (non-@code{nil}) lists +Concatenate ``adjacent'' elements of each value (possibly converting +back to a number as above). For example, @samp{$list("a" "b")c} +returns @samp{("a" "bc")}. + +@item anything else +Concatenate the string represenation of each value. + +@end table @menu * Dollars Expansion:: diff --git a/etc/NEWS b/etc/NEWS index 592b4b7888..15c7ce8a90 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1396,6 +1396,13 @@ If an Eshell expansion like '$FOO' is surrounded by double quotes, the result will always be a single string, no matter the type that would otherwise be returned. ++++ +*** Concatenating Eshell expansions now works more similarly to other shells. +When concatenating an Eshell expansion that returns a list, "adjacent" +elements of each operand are now concatenated together, +e.g. '$list("a" "b")c' returns '("a" "bc")'. See the "(eshell) +Expansion" node in the Eshell manual for more details. + +++ *** Eshell subcommands with multiline numeric output return lists of numbers. If every line of the output of an Eshell subcommand like '${COMMAND}' diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 395aa87ff0..459487f435 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -180,19 +180,63 @@ treated as a literal character." (add-text-properties 0 (length string) '(escaped t) string)) string) +(defun eshell-concat (quoted &rest rest) + "Concatenate all the arguments in REST and return the result. +If QUOTED is nil, the resulting value(s) may be converted to +numbers (see `eshell-concat-1'). + +If each argument in REST is a non-list value, the result will be +a single value, as if (mapconcat #'eshell-stringify REST) had been +called, possibly converted to a number. + +If there is at least one (non-nil) list argument, the result will +be a list, with \"adjacent\" elements of consecutive arguments +concatenated as strings (again, possibly converted to numbers). +For example, concatenating \"a\", (\"b\"), and (\"c\" \"d\") +would produce (\"abc\" \"d\")." + (let (result) + (dolist (i rest result) + (when i + (cond + ((null result) + (setq result i)) + ((listp result) + (let (curr-head curr-tail) + (if (listp i) + (setq curr-head (car i) + curr-tail (cdr i)) + (setq curr-head i + curr-tail nil)) + (setq result + (append + (butlast result 1) + (list (eshell-concat-1 quoted (car (last result)) + curr-head)) + curr-tail)))) + ((listp i) + (setq result + (cons (eshell-concat-1 quoted result (car i)) + (cdr i)))) + (t + (setq result (eshell-concat-1 quoted result i)))))))) + +(defun eshell-concat-1 (quoted first second) + "Concatenate FIRST and SECOND. +If QUOTED is nil and either FIRST or SECOND are numbers, try to +convert the result to a number as well." + (let ((result (concat (eshell-stringify first) (eshell-stringify second)))) + (if (and (not quoted) + (or (numberp first) (numberp second))) + (eshell-convert-to-number result) + result))) + (defun eshell-resolve-current-argument () "If there are pending modifications to be made, make them now." (when eshell-current-argument (when eshell-arg-listified - (let ((parts eshell-current-argument)) - (while parts - (unless (stringp (car parts)) - (setcar parts - (list 'eshell-to-flat-string (car parts)))) - (setq parts (cdr parts))) - (setq eshell-current-argument - (list 'eshell-convert - (append (list 'concat) eshell-current-argument)))) + (setq eshell-current-argument + (append (list 'eshell-concat eshell-current-quoted) + eshell-current-argument)) (setq eshell-arg-listified nil)) (while eshell-current-modifiers (setq eshell-current-argument diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 9960912bce..b5a423f023 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -293,6 +293,7 @@ Prepend remote identification of `default-directory', if any." (defun eshell-to-flat-string (value) "Make value a string. If separated by newlines change them to spaces." + (declare (obsolete nil "29.1")) (let ((text (eshell-stringify value))) (if (string-match "\n+\\'" text) (setq text (replace-match "" t t text))) diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index 91c2fba479..3b84d763ac 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -170,7 +170,7 @@ (em-extpipe-tests--deftest em-extpipe-test-13 "foo*|bar" (should-parse '(eshell-execute-pipeline - '((eshell-named-command (concat "foo" "*")) + '((eshell-named-command (eshell-concat nil "foo" "*")) (eshell-named-command "bar"))))) (em-extpipe-tests--deftest em-extpipe-test-14 "tac *\"") "hi"))) +(ert-deftest esh-var-test/quoted-interp-concat-cmd () + "Interpolate and concat command with literal" + (should (equal (eshell-test-command-result + "echo \"${echo \\\"foo\nbar\\\"} baz\"") + "foo\nbar baz"))) + ;; Interpolated variable conversion commit 06423b5d1e05d524e8e745f071cbb691b446efd2 Author: Jim Porter Date: Sun May 1 22:09:17 2022 -0700 Return a list of numbers if all lines of an Eshell subcommand are numeric * lisp/eshell/esh-util.el (eshell-convertible-to-number-p) (eshell-convert-to-number): New functions... (eshell-convert): ... use them. * test/lisp/eshell/esh-var-tests.el (esh-var-test/interp-convert-cmd-string-newline): Add checks for numeric output. * doc/misc/eshell.texi (Dollars Expansion): Document the new behavior. * etc/NEWS: Announce the change (bug#55236). diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index fff06b527c..be32b2aced 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1061,9 +1061,11 @@ when on its own, but the @code{$} allows it to be used inside double quotes or as part of a string. Normally, the output is split line-by-line, returning a list (or the -first element if there's only one line of output). However, when this -expansion is surrounded by double quotes, it returns the output as a -single string instead. +first element if there's only one line of output); if +@code{eshell-convert-numeric-arguments} is non-@code{nil} and every +line of output looks like a number, convert each line to a number. +However, when this expansion is surrounded by double quotes, it +returns the output as a single string instead. @item $<@var{command}> As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation diff --git a/etc/NEWS b/etc/NEWS index 967fe6cffe..592b4b7888 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1396,6 +1396,13 @@ If an Eshell expansion like '$FOO' is surrounded by double quotes, the result will always be a single string, no matter the type that would otherwise be returned. ++++ +*** Eshell subcommands with multiline numeric output return lists of numbers. +If every line of the output of an Eshell subcommand like '${COMMAND}' +is numeric, the result will be a list of numbers (or a single number +if only one line of output). Previously, this only converted numbers +when there was a single line of output. + --- *** Built-in Eshell commands now follow POSIX/GNU argument syntax conventions. Built-in commands in Eshell now accept command-line options with diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 6c130974e9..9960912bce 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -198,6 +198,23 @@ doubling it up." (when (= depth 0) (if reverse-p (point) (1- (point))))))) +(defun eshell-convertible-to-number-p (string) + "Return non-nil if STRING can be converted to a number. +If `eshell-convert-numeric-aguments', always return nil." + (and eshell-convert-numeric-arguments + (string-match + (concat "\\`\\s-*" eshell-number-regexp "\\s-*\\'") + string))) + +(defun eshell-convert-to-number (string) + "Try to convert STRING to a number. +If STRING doesn't look like a number (or +`eshell-convert-numeric-aguments' is nil), just return STRING +unchanged." + (if (eshell-convertible-to-number-p string) + (string-to-number string) + string)) + (defun eshell-convert (string &optional to-string) "Convert STRING into a more-native Lisp object. If TO-STRING is non-nil, always return a single string with @@ -207,8 +224,8 @@ trailing newlines removed. Otherwise, this behaves as follows: * Split multiline strings by line. -* If `eshell-convert-numeric-aguments' is non-nil, convert - numeric strings to numbers." +* If `eshell-convert-numeric-aguments' is non-nil and every line + of output looks like a number, convert them to numbers." (cond ((not (stringp string)) (if to-string @@ -220,15 +237,12 @@ trailing newlines removed. Otherwise, this behaves as follows: string (when (eq (aref string (1- len)) ?\n) (setq string (substring string 0 (1- len)))) - (cond - ((string-search "\n" string) - (split-string string "\n")) - ((and eshell-convert-numeric-arguments - (string-match - (concat "\\`\\s-*" eshell-number-regexp "\\s-*\\'") - string)) - (string-to-number string)) - (t string))))))) + (if (string-search "\n" string) + (let ((lines (split-string string "\n"))) + (if (seq-every-p #'eshell-convertible-to-number-p lines) + (mapcar #'string-to-number lines) + lines)) + (eshell-convert-to-number string))))))) (defvar-local eshell-path-env (getenv "PATH") "Content of $PATH. diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 5363a86e71..2ce6bb4f1b 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -366,7 +366,13 @@ inside double-quotes" (ert-deftest esh-var-test/interp-convert-cmd-multiline () "Interpolate multi-line command result" (should (equal (eshell-test-command-result "echo ${echo \"foo\nbar\"}") - '("foo" "bar")))) + '("foo" "bar"))) + ;; Numeric output should be converted to numbers... + (should (equal (eshell-test-command-result "echo ${echo \"01\n02\n03\"}") + '(1 2 3))) + ;; ... but only if every line is numeric. + (should (equal (eshell-test-command-result "echo ${echo \"01\n02\nhi\"}") + '("01" "02" "hi")))) (ert-deftest esh-var-test/interp-convert-cmd-number () "Interpolate numeric command result" commit f7a82699d6e854c2920f7c090fb8df7a3e012a4d Author: Jim Porter Date: Mon Feb 28 17:38:39 2022 -0800 Eshell variable expansion should always return strings inside quotes This is closer in behavior to regular shells, and gives Eshell users greater flexibility in how variables are expanded. * lisp/eshell/esh-util.el (eshell-convert): Add TO-STRING argument. * lisp/eshell/esh-var.el (eshell-parse-variable-ref): Add MODIFIER-P argument and adjust how 'eshell-convert' and 'eshell-apply-indices' are called. (eshell-get-variable, eshell-apply-indices): Add QUOTED argument. * test/lisp/eshell/esh-var-tests.el (eshell-test-value): New defvar. (esh-var-test/interp-convert-var-number) (esh-var-test/interp-convert-var-split-indices) (esh-var-test/interp-convert-quoted-var-number) (esh-var-test/interp-convert-quoted-var-split-indices) (esh-var-test/interp-convert-cmd-string-newline) (esh-var-test/interp-convert-cmd-multiline) (esh-var-test/interp-convert-cmd-number) (esh-var-test/interp-convert-cmd-split-indices) (esh-var-test/quoted-interp-convert-var-number) (esh-var-test/quoted-interp-convert-var-split-indices) (esh-var-test/quoted-interp-convert-quoted-var-number) (esh-var-test/quoted-interp-convert-quoted-var-split-indices) (esh-var-test/quoted-interp-convert-cmd-string-newline) (esh-var-test/quoted-interp-convert-cmd-multiline) (esh-var-test/quoted-interp-convert-cmd-number) (esh-var-test/quoted-interp-convert-cmd-split-indices): New tests. * doc/misc/eshell.texi (Arguments): Expand this section, and document the new behavior. (Dollars Expansion): Provide more detail about '$(lisp)' and '${command}' forms. * etc/NEWS (Eshell): Announce this change (bug#55236). diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index c9c11a3869..fff06b527c 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -228,15 +228,39 @@ other background process in Emacs. @node Arguments @section Arguments -Command arguments are passed to the functions as either strings or -numbers, depending on what the parser thinks they look like. If you -need to use a function that takes some other data type, you will need to -call it in an Elisp expression (which can also be used with -@ref{Expansion, expansions}). As with other shells, you can -escape special characters and spaces with the backslash (@code{\}) and -apostrophes (@code{''}) and double quotes (@code{""}). This is needed -especially for file names with special characters like pipe -(@code{|}), which could be part of remote file names. +Ordinarily, command arguments are parsed by Eshell as either strings +or numbers, depending on what the parser thinks they look like. To +specify an argument of some other data type, you can use an +@ref{Dollars Expansion, Elisp expression}: + +@example +~ $ echo (list 1 2 3) +(1 2 3) +@end example + +Additionally, many @ref{Built-ins, Eshell commands} will flatten the +arguments they receive, so passing a list as an argument will +``spread'' the elements into multiple arguments: + +@example +~ $ printnl (list 1 2) 3 +1 +2 +3 +@end example + +@subsection Quoting and escaping + +As with other shells, you can escape special characters and spaces +with by prefixing the character with a backslash (@code{\}), or by +surrounding the string with apostrophes (@code{''}) or double quotes +(@code{""}). This is needed especially for file names with special +characters like pipe (@code{|}), which could be part of remote file +names. + +When using @ref{Expansion, expansions} in an Eshell command, the +result may potentially be of any data type. To ensure that the result +is always a string, the expansion can be surrounded by double quotes. @node Built-ins @section Built-in commands @@ -1026,11 +1050,20 @@ value, such as @samp{$"@var{var}"-suffix}. @item $(@var{lisp}) Expands to the result of evaluating the S-expression @code{(@var{lisp})}. On its own, this is identical to just @code{(@var{lisp})}, but with the @code{$}, -it can be used in a string, such as @samp{/some/path/$(@var{lisp}).txt}. +it can be used inside double quotes or within a longer string, such as +@samp{/some/path/$(@var{lisp}).txt}. @item $@{@var{command}@} -Returns the output of @command{@var{command}}, which can be any valid Eshell -command invocation, and may even contain expansions. +Returns the output of @command{@var{command}}, which can be any valid +Eshell command invocation, and may even contain expansions. Similar +to @code{$(@var{lisp})}, this is identical to @code{@{@var{command}@}} +when on its own, but the @code{$} allows it to be used inside double +quotes or as part of a string. + +Normally, the output is split line-by-line, returning a list (or the +first element if there's only one line of output). However, when this +expansion is surrounded by double quotes, it returns the output as a +single string instead. @item $<@var{command}> As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation diff --git a/etc/NEWS b/etc/NEWS index b6a4732633..967fe6cffe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1390,6 +1390,12 @@ Lisp function. This frees you from having to keep track of whether commands are Lisp function or external when supplying absolute file name arguments. See "Electric forward slash" in the Eshell manual. ++++ +*** Double-quoting an Eshell expansion now treats the result as a single string. +If an Eshell expansion like '$FOO' is surrounded by double quotes, the +result will always be a single string, no matter the type that would +otherwise be returned. + --- *** Built-in Eshell commands now follow POSIX/GNU argument syntax conventions. Built-in commands in Eshell now accept command-line options with diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 3da712c719..6c130974e9 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -198,23 +198,37 @@ doubling it up." (when (= depth 0) (if reverse-p (point) (1- (point))))))) -(defun eshell-convert (string) - "Convert STRING into a more native looking Lisp object." - (if (not (stringp string)) - string - (let ((len (length string))) - (if (= len 0) - string - (if (eq (aref string (1- len)) ?\n) +(defun eshell-convert (string &optional to-string) + "Convert STRING into a more-native Lisp object. +If TO-STRING is non-nil, always return a single string with +trailing newlines removed. Otherwise, this behaves as follows: + +* Return non-strings as-is. + +* Split multiline strings by line. + +* If `eshell-convert-numeric-aguments' is non-nil, convert + numeric strings to numbers." + (cond + ((not (stringp string)) + (if to-string + (eshell-stringify string) + string)) + (to-string (string-trim-right string "\n+")) + (t (let ((len (length string))) + (if (= len 0) + string + (when (eq (aref string (1- len)) ?\n) (setq string (substring string 0 (1- len)))) - (if (string-search "\n" string) - (split-string string "\n") - (if (and eshell-convert-numeric-arguments - (string-match - (concat "\\`\\s-*" eshell-number-regexp - "\\s-*\\'") string)) - (string-to-number string) - string)))))) + (cond + ((string-search "\n" string) + (split-string string "\n")) + ((and eshell-convert-numeric-arguments + (string-match + (concat "\\`\\s-*" eshell-number-regexp "\\s-*\\'") + string)) + (string-to-number string)) + (t string))))))) (defvar-local eshell-path-env (getenv "PATH") "Content of $PATH. diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 3c6bcc753c..1c28d24af1 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -402,23 +402,30 @@ process any indices that come after the variable reference." (let* ((get-len (when (eq (char-after) ?#) (forward-char) t)) value indices) - (setq value (eshell-parse-variable-ref) + (setq value (eshell-parse-variable-ref get-len) indices (and (not (eobp)) (eq (char-after) ?\[) (eshell-parse-indices)) ;; This is an expression that will be evaluated by `eshell-do-eval', ;; which only support let-binding of dynamically-scoped vars value `(let ((indices (eshell-eval-indices ',indices))) ,value)) - (if get-len - `(length ,value) - value))) + (when get-len + (setq value `(length ,value))) + (when eshell-current-quoted + (setq value `(eshell-stringify ,value))) + value)) -(defun eshell-parse-variable-ref () +(defun eshell-parse-variable-ref (&optional modifier-p) "Eval a variable reference. Returns a Lisp form which, if evaluated, will return the value of the variable. -Possible options are: +If MODIFIER-P is non-nil, the value of the variable will be +modified by some function. If MODIFIER-P is nil, the value will be +used as-is; this allows optimization of some kinds of variable +references. + +Possible variable references are: NAME an environment or Lisp variable value \"LONG-NAME\" disambiguates the length of the name @@ -441,8 +448,16 @@ Possible options are: ,(let ((subcmd (or (eshell-unescape-inner-double-quote end) (cons (point) end))) (eshell-current-quoted nil)) - (eshell-parse-command subcmd))))) - indices) + (eshell-parse-command subcmd)))) + ;; If this is a simple double-quoted form like + ;; "${COMMAND}" (i.e. no indices after the subcommand + ;; and no `#' modifier before), ensure we convert to a + ;; single string. This avoids unnecessary work + ;; (e.g. splitting the output by lines) when it would + ;; just be joined back together afterwards. + ,(when (and (not modifier-p) eshell-current-quoted) + '(not indices))) + indices ,eshell-current-quoted) (goto-char (1+ end)))))) ((eq (char-after) ?\<) (let ((end (eshell-find-delimiter ?\< ?\>))) @@ -466,7 +481,7 @@ Possible options are: ;; properly. See bug#54190. (list (function (lambda () (delete-file ,temp)))))) - (eshell-apply-indices ,temp indices))) + (eshell-apply-indices ,temp indices ,eshell-current-quoted))) (goto-char (1+ end))))))) ((eq (char-after) ?\() (condition-case nil @@ -475,7 +490,7 @@ Possible options are: (eshell-lisp-command ',(read (or (eshell-unescape-inner-double-quote (point-max)) (current-buffer))))) - indices) + indices ,eshell-current-quoted) (end-of-file (throw 'eshell-incomplete ?\()))) ((looking-at (rx-to-string @@ -487,14 +502,15 @@ Possible options are: (eshell-parse-literal-quote) (eshell-parse-double-quote)))) (when name - `(eshell-get-variable ,(eval name) indices))))) + `(eshell-get-variable ,(eval name) indices ,eshell-current-quoted))))) ((assoc (char-to-string (char-after)) eshell-variable-aliases-list) (forward-char) - `(eshell-get-variable ,(char-to-string (char-before)) indices)) + `(eshell-get-variable ,(char-to-string (char-before)) indices + ,eshell-current-quoted)) ((looking-at eshell-variable-name-regexp) (prog1 - `(eshell-get-variable ,(match-string 0) indices) + `(eshell-get-variable ,(match-string 0) indices ,eshell-current-quoted) (goto-char (match-end 0)))) (t (error "Invalid variable reference")))) @@ -525,8 +541,10 @@ For example, \"[0 1][2]\" becomes: "Evaluate INDICES, a list of index-lists generated by `eshell-parse-indices'." (mapcar (lambda (i) (mapcar #'eval i)) indices)) -(defun eshell-get-variable (name &optional indices) - "Get the value for the variable NAME." +(defun eshell-get-variable (name &optional indices quoted) + "Get the value for the variable NAME. +INDICES is a list of index-lists (see `eshell-parse-indices'). +If QUOTED is non-nil, this was invoked inside double-quotes." (let* ((alias (assoc name eshell-variable-aliases-list)) (var (if alias (cadr alias) @@ -547,9 +565,9 @@ For example, \"[0 1][2]\" becomes: (symbol-value var)) (t (error "Unknown variable `%s'" (eshell-stringify var)))) - indices)))) + indices quoted)))) -(defun eshell-apply-indices (value indices) +(defun eshell-apply-indices (value indices &optional quoted) "Apply to VALUE all of the given INDICES, returning the sub-result. The format of INDICES is: @@ -558,12 +576,17 @@ The format of INDICES is: Each member of INDICES represents a level of nesting. If the first member of a sublist is not an integer or name, and the value it's -reference is a string, that will be used as the regexp with which is -to divide the string into sub-parts. The default is whitespace. +referencing is a string, that will be used as the regexp with which +is to divide the string into sub-parts. The default is whitespace. Otherwise, each INT-OR-NAME refers to an element of the list value. Integers imply a direct index, and names, an associate lookup using `assoc'. +If QUOTED is non-nil, this was invoked inside double-quotes. This +affects the behavior of splitting strings: without quoting, the +split values are converted to Lisp forms via `eshell-convert'; with +quoting, they're left as strings. + For example, to retrieve the second element of a user's record in '/etc/passwd', the variable reference would look like: @@ -577,7 +600,7 @@ For example, to retrieve the second element of a user's record in (setq separator index refs (cdr refs))) (setq value - (mapcar #'eshell-convert + (mapcar (lambda (i) (eshell-convert i quoted)) (split-string value separator))))) (cond ((< (length refs) 0) diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 1d051d681a..5363a86e71 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -210,12 +210,17 @@ (should (equal (eshell-test-command-result "echo \"$eshell-test-value[0]\"") "zero")) + ;; FIXME: These tests would use the 0th index like the other tests + ;; here, but evaluating the command just above adds an `escaped' + ;; property to the string "zero". This results in the output + ;; printing the string properties, which is probably the wrong + ;; behavior. See bug#54486. (should (equal (eshell-test-command-result - "echo \"$eshell-test-value[0 2]\"") - '("zero" "two"))) + "echo \"$eshell-test-value[1 2]\"") + "(\"one\" \"two\")")) (should (equal (eshell-test-command-result - "echo \"$eshell-test-value[0 2 4]\"") - '("zero" "two" "four"))))) + "echo \"$eshell-test-value[1 2 4]\"") + "(\"one\" \"two\" \"four\")")))) (ert-deftest esh-var-test/quoted-interp-var-split-indices () "Interpolate string variable with indices inside double-quotes" @@ -225,7 +230,7 @@ "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[0 2]\"") - '("zero" "two"))))) + "(\"zero\" \"two\")")))) (ert-deftest esh-var-test/quoted-interp-var-string-split-indices () "Interpolate string variable with string splitter and indices @@ -236,14 +241,14 @@ inside double-quotes" "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[: 0 2]\"") - '("zero" "two")))) + "(\"zero\" \"two\")"))) (let ((eshell-test-value "zeroXoneXtwoXthreeXfour")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[X 0]\"") "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[X 0 2]\"") - '("zero" "two"))))) + "(\"zero\" \"two\")")))) (ert-deftest esh-var-test/quoted-interp-var-regexp-split-indices () "Interpolate string variable with regexp splitter and indices" @@ -253,43 +258,47 @@ inside double-quotes" "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value['[:!]' 0 2]\"") - '("zero" "two"))) + "(\"zero\" \"two\")")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[\\\"[:!]\\\" 0]\"") "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[\\\"[:!]\\\" 0 2]\"") - '("zero" "two"))))) + "(\"zero\" \"two\")")))) (ert-deftest esh-var-test/quoted-interp-var-assoc () "Interpolate alist variable with index inside double-quotes" (let ((eshell-test-value '(("foo" . 1)))) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[foo]\"") - 1)))) + "1")))) (ert-deftest esh-var-test/quoted-interp-var-length-list () "Interpolate length of list variable inside double-quotes" (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") 3)) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value[1]\"") - 1)) - (should (eq (eshell-test-command-result - "echo \"$#eshell-test-value[2][1]\"") - 4)))) + (should (equal (eshell-test-command-result "echo \"$#eshell-test-value\"") + "3")) + (should (equal (eshell-test-command-result + "echo \"$#eshell-test-value[1]\"") + "1")) + (should (equal (eshell-test-command-result + "echo \"$#eshell-test-value[2][1]\"") + "4")))) (ert-deftest esh-var-test/quoted-interp-var-length-string () "Interpolate length of string variable inside double-quotes" (let ((eshell-test-value "foobar")) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") - 6)))) + (should (equal (eshell-test-command-result "echo \"$#eshell-test-value\"") + "6")))) (ert-deftest esh-var-test/quoted-interp-var-length-alist () "Interpolate length of alist variable inside double-quotes" (let ((eshell-test-value '(("foo" . (1 2 3))))) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") 1)) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value[foo]\"") - 3)))) + (should (equal (eshell-test-command-result "echo \"$#eshell-test-value\"") + "1")) + (should (equal (eshell-test-command-result + "echo \"$#eshell-test-value[foo]\"") + "3")))) (ert-deftest esh-var-test/quoted-interp-lisp () "Interpolate Lisp form evaluation inside double-quotes" @@ -299,7 +308,8 @@ inside double-quotes" (ert-deftest esh-var-test/quoted-interp-lisp-indices () "Interpolate Lisp form evaluation with index" - (should (equal (eshell-test-command-result "+ \"$(list 1 2)[1]\" 3") 5))) + (should (equal (eshell-test-command-result "concat \"$(list 1 2)[1]\" cool") + "2cool"))) (ert-deftest esh-var-test/quoted-interp-cmd () "Interpolate command result inside double-quotes" @@ -309,12 +319,127 @@ inside double-quotes" (ert-deftest esh-var-test/quoted-interp-cmd-indices () "Interpolate command result with index inside double-quotes" - (should (equal (eshell-test-command-result "+ \"${list 1 2}[1]\" 3") 5))) + (should (equal (eshell-test-command-result "concat \"${list 1 2}[1]\" cool") + "2cool"))) (ert-deftest esh-var-test/quoted-interp-temp-cmd () "Interpolate command result redirected to temp file inside double-quotes" (should (equal (eshell-test-command-result "cat \"$\"") "hi"))) + +;; Interpolated variable conversion + +(ert-deftest esh-var-test/interp-convert-var-number () + "Interpolate numeric variable" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result "type-of $eshell-test-value") + 'integer)))) + +(ert-deftest esh-var-test/interp-convert-var-split-indices () + "Interpolate and convert string variable with indices" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0]") + 0)) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0 2]") + '(0 20))))) + +(ert-deftest esh-var-test/interp-convert-quoted-var-number () + "Interpolate numeric quoted numeric variable" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result "type-of $'eshell-test-value'") + 'integer)) + (should (equal (eshell-test-command-result "type-of $\"eshell-test-value\"") + 'integer)))) + +(ert-deftest esh-var-test/interp-convert-quoted-var-split-indices () + "Interpolate and convert quoted string variable with indices" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result "echo $'eshell-test-value'[0]") + 0)) + (should (equal (eshell-test-command-result "echo $'eshell-test-value'[0 2]") + '(0 20))))) + +(ert-deftest esh-var-test/interp-convert-cmd-string-newline () + "Interpolate trailing-newline command result" + (should (equal (eshell-test-command-result "echo ${echo \"foo\n\"}") "foo"))) + +(ert-deftest esh-var-test/interp-convert-cmd-multiline () + "Interpolate multi-line command result" + (should (equal (eshell-test-command-result "echo ${echo \"foo\nbar\"}") + '("foo" "bar")))) + +(ert-deftest esh-var-test/interp-convert-cmd-number () + "Interpolate numeric command result" + (should (equal (eshell-test-command-result "echo ${echo \"1\"}") 1))) + +(ert-deftest esh-var-test/interp-convert-cmd-split-indices () + "Interpolate command result with indices" + (should (equal (eshell-test-command-result "echo ${echo \"000 010 020\"}[0]") + 0)) + (should (equal (eshell-test-command-result + "echo ${echo \"000 010 020\"}[0 2]") + '(0 20)))) + +(ert-deftest esh-var-test/quoted-interp-convert-var-number () + "Interpolate numeric variable inside double-quotes" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result "type-of \"$eshell-test-value\"") + 'string)))) + +(ert-deftest esh-var-test/quoted-interp-convert-var-split-indices () + "Interpolate string variable with indices inside double-quotes" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0]\"") + "000")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0 2]\"") + "(\"000\" \"020\")")))) + +(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-number () + "Interpolate numeric quoted variable inside double-quotes" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result + "type-of \"$'eshell-test-value'\"") + 'string)) + (should (equal (eshell-test-command-result + "type-of \"$\\\"eshell-test-value\\\"\"") + 'string)))) + +(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-split-indices () + "Interpolate quoted string variable with indices inside double-quotes" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0]\"") + "000")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0 2]\"") + "(\"000\" \"020\")")))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-string-newline () + "Interpolate trailing-newline command result inside double-quotes" + (should (equal (eshell-test-command-result "echo \"${echo \\\"foo\n\\\"}\"") + "foo")) + (should (equal (eshell-test-command-result "echo \"${echo \\\"foo\n\n\\\"}\"") + "foo"))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-multiline () + "Interpolate multi-line command result inside double-quotes" + (should (equal (eshell-test-command-result + "echo \"${echo \\\"foo\nbar\\\"}\"") + "foo\nbar"))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-number () + "Interpolate numeric command result inside double-quotes" + (should (equal (eshell-test-command-result "echo \"${echo \\\"1\\\"}\"") + "1"))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-split-indices () + "Interpolate command result with indices inside double-quotes" + (should (equal (eshell-test-command-result + "echo \"${echo \\\"000 010 020\\\"}[0]\"") + "000"))) + ;; Built-in variables commit 316c082d58601119372a0ae6745cba96f3404c86 Author: Lars Ingebrigtsen Date: Tue May 3 18:19:13 2022 +0200 Make adding things to the tool bar show up on next redisplay * lisp/tool-bar.el (tool-bar--flush-cache): New function. (tool-bar-add-item): Flush the cache (bug#43397). diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 7ec5c0becc..1271d1de23 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -91,6 +91,10 @@ functions.") (defconst tool-bar-keymap-cache (make-hash-table :weakness t :test 'equal)) +(defun tool-bar--flush-cache () + (setf (gethash (cons (frame-terminal) tool-bar-map) tool-bar-keymap-cache) + nil)) + (defun tool-bar-make-keymap (&optional _ignore) "Generate an actual keymap from `tool-bar-map'. Its main job is to figure out which images to use based on the display's @@ -139,7 +143,8 @@ ICON.xbm, using `find-image'. Use this function only to make bindings in the global value of `tool-bar-map'. To define items in any other map, use `tool-bar-local-item'." - (apply #'tool-bar-local-item icon def key tool-bar-map props)) + (apply #'tool-bar-local-item icon def key tool-bar-map props) + (tool-bar--flush-cache)) (defun tool-bar--image-expression (icon) "Return an expression that evaluates to an image spec for ICON." commit 0916fd3aaacf62e641414fb2b474c86888116487 Author: Lars Ingebrigtsen Date: Tue May 3 18:00:32 2022 +0200 Add new command 'package-update' * doc/emacs/package.texi (Package Installation): Mention it. * lisp/emacs-lisp/package.el (package-update): New command (bug#18790). diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index caa65bf33b..bd3ae2aa6a 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -320,10 +320,13 @@ version of the package, a newer version is also installed. @section Package Installation @findex package-install +@findex package-update Packages are most conveniently installed using the package menu (@pxref{Package Menu}), but you can also use the command @kbd{M-x package-install}. This prompts for the name of a package with the -@samp{available} status, then downloads and installs it. +@samp{available} status, then downloads and installs it. Similarly, +if you want to update a package, you can use the @kbd{M-x +package-update} command. @cindex package requirements A package may @dfn{require} certain other packages to be installed, diff --git a/etc/NEWS b/etc/NEWS index f897158afd..b6a4732633 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -707,6 +707,13 @@ script that was used in ancient South Asia. A new input method, * Changes in Specialized Modes and Packages in Emacs 29.1 +** Package + ++++ +*** New command 'package-update'. +This command allows you to upgrade packages without using 'M-x +list-packages'. + ** Miscellaneous +++ diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7f2c427c2e..58c1349e1c 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2136,6 +2136,31 @@ to install it but still mark it as selected." (message "Package `%s' installed." name)) (message "`%s' is already installed" name)))) +;;;###autoload +(defun package-update (name) + "Update package NAME if a newer version exists." + (interactive + (progn + ;; Initialize the package system to get the list of package + ;; symbols for completion. + (package--archives-initialize) + (list (completing-read + "Update package: " + (mapcar + #'car + (seq-filter + (lambda (elt) + (let ((available + (assq (car elt) package-archive-contents))) + (and available + (version-list-< + (package-desc-priority-version (cadr elt)) + (package-desc-priority-version (cadr available)))))) + package-alist)) + nil t)))) + (package-delete (cadr (assq (intern name) package-alist)) 'force) + (package-install (intern name) 'dont-select)) + (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. If the result looks like a dotted numeric version, return it. commit 41e946f46e23756b7c732efdf3c5152fa8241dde Author: Lars Ingebrigtsen Date: Tue May 3 16:19:50 2022 +0200 Fix key-parse problem with C-x ( ... sequences * lisp/keymap.el (key-parse): Move the read-kbd-macro compat code from here... * lisp/subr.el (kbd): ... to here. (And fix the logic, too.) This allows `key-parse' to have a less puzzling result while maintaining backwards compatibility (bug#38775). diff --git a/lisp/keymap.el b/lisp/keymap.el index db37d80b36..71454eba5e 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -281,18 +281,7 @@ See `kbd' for a descripion of KEYS." (when key (dolist (_ (number-sequence 1 times)) (setq res (vconcat res key)))))) - (if (and (>= (length res) 4) - (eq (aref res 0) ?\C-x) - (eq (aref res 1) ?\() - (eq (aref res (- (length res) 2)) ?\C-x) - (eq (aref res (- (length res) 1)) ?\))) - (apply #'vector (let ((lres (append res nil))) - ;; Remove the first and last two elements. - (setq lres (cdr (cdr lres))) - (nreverse lres) - (setq lres (cdr (cdr lres))) - (nreverse lres))) - res)))) + res))) (defun key-valid-p (keys) "Say whether KEYS is a valid key. diff --git a/lisp/subr.el b/lisp/subr.el index cb7572423a..dec3b9190e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -941,6 +941,20 @@ Here's some example key sequences: For an approximate inverse of this, see `key-description'." (declare (pure t) (side-effect-free t)) (let ((res (key-parse keys))) + ;; For historical reasons, parse "C-x ( C-d C-x )" as "C-d", since + ;; `kbd' used to be a wrapper around `read-kbd-macro'. + (when (and (>= (length res) 4) + (eq (aref res 0) ?\C-x) + (eq (aref res 1) ?\() + (eq (aref res (- (length res) 2)) ?\C-x) + (eq (aref res (- (length res) 1)) ?\))) + (setq res (apply #'vector (let ((lres (append res nil))) + ;; Remove the first and last two elements. + (setq lres (cddr lres)) + (setq lres (nreverse lres)) + (setq lres (cddr lres)) + (nreverse lres))))) + (if (not (memq nil (mapcar (lambda (ch) (and (numberp ch) (<= 0 ch 127))) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 62cf2266d6..a4f531ea4e 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1053,5 +1053,9 @@ final or penultimate step during initialization.")) (should (equal (string-lines "foo\n\n\nbar" t t) '("foo\n" "bar")))) +(defun test-keymap-parse-macros () + (should (equal (key-parse "C-x ( C-d C-x )") [24 40 4 24 41])) + (should (equal (kbd "C-x ( C-d C-x )") ""))) + (provide 'subr-tests) ;;; subr-tests.el ends here commit a4c96147d1875d359db8d7fda3489954046a5db8 Author: Lars Ingebrigtsen Date: Tue May 3 16:02:51 2022 +0200 Make TAB work in makefile mode when transient mark mode is on * lisp/progmodes/make-mode.el (makefile-mode): Insert a tab instead of removing it (bug#37087). diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 91307f6c09..1a1dc3aee9 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -889,7 +889,7 @@ Makefile mode can be configured by modifying the following variables: (setq-local comment-start-skip "#+[ \t]*") ;; Make sure TAB really inserts \t. - (setq-local indent-line-function 'indent-to-left-margin) + (setq-local indent-line-function #'insert-tab) ;; Real TABs are important in makefiles (setq indent-tabs-mode t)) commit 47fe7a5983a97c3e806e90340f3cd6ab3f0c49b2 Author: Michael Albinus Date: Tue May 3 14:14:37 2022 +0200 Handle file name handler in write-region's VISIT arg * lisp/net/tramp.el (tramp-skeleton-delete-directory): Move up. (tramp-skeleton-write-region): New defmacro. Handle also file name handler in VISIT. (Bug#55166) (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): Use it. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index d897594f8d..251d5191cb 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -548,28 +548,8 @@ Emacs dired can't find files." (defun tramp-adb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (curbuf (current-buffer)) - (tmpfile (tramp-compat-make-temp-file filename))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((tmpfile (tramp-compat-make-temp-file filename))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) @@ -582,33 +562,7 @@ Emacs dired can't find files." (unless (tramp-adb-execute-adb-command v "push" tmpfile (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Cannot write: `%s'" filename)) - (delete-file tmpfile))) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (delete-file tmpfile)))))) (defun tramp-adb-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 5e0a67dbb3..ba4cdb0ab5 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3328,251 +3328,197 @@ implementation will be used." (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (uid (or (file-attribute-user-id (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (file-attribute-group-id (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - - (if (and (tramp-local-host-p v) - ;; `file-writable-p' calls `file-expand-file-name'. We - ;; cannot use `tramp-run-real-handler' therefore. - (file-writable-p (file-name-directory localname)) - (or (file-directory-p localname) - (file-writable-p localname))) - ;; Short track: if we are on the local host, we can run directly. - (let ((create-lockfiles (not file-locked))) - (write-region start end localname append 'no-message lockname)) - - (let* ((modes (tramp-default-file-modes - filename (and (eq mustbenew 'excl) 'nofollow))) - ;; We use this to save the value of - ;; `last-coding-system-used' after writing the tmp - ;; file. At the end of the function, we set - ;; `last-coding-system-used' to this saved value. This - ;; way, any intermediary coding systems used while - ;; talking to the remote shell or suchlike won't hose - ;; this variable. This approach was snarfed from - ;; ange-ftp.el. - coding-system-used - ;; Write region into a tmp file. This isn't really - ;; needed if we use an encoding function, but currently - ;; we use it always because this makes the logic - ;; simpler. We must also set `temporary-file-directory', - ;; because it could point to a remote directory. - (temporary-file-directory tramp-compat-temporary-file-directory) - (tmpfile (or tramp-temp-buffer-file-name - (tramp-compat-make-temp-file filename)))) - - ;; If `append' is non-nil, we copy the file locally, and let - ;; the native `write-region' implementation do the job. - (when (and append (file-exists-p filename)) - (copy-file filename tmpfile 'ok)) - - ;; We say `no-message' here because we don't want the - ;; visited file modtime data to be clobbered from the temp - ;; file. We call `set-visited-file-modtime' ourselves later - ;; on. We must ensure that `file-coding-system-alist' - ;; matches `tmpfile'. - (let ((file-coding-system-alist - (tramp-find-file-name-coding-system-alist filename tmpfile)) - create-lockfiles) - (condition-case err - (write-region start end tmpfile append 'no-message) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Now, `last-coding-system-used' has the right value. Remember it. - (setq coding-system-used last-coding-system-used)) - - ;; The permissions of the temporary file should be set. If - ;; FILENAME does not exist (eq modes nil) it has been - ;; renamed to the backup file. This case `save-buffer' - ;; handles permissions. - ;; Ensure that it is still readable. - (when modes - (set-file-modes tmpfile (logior (or modes 0) #o0400))) - - ;; This is a bit lengthy due to the different methods - ;; possible for file transfer. First, we check whether the - ;; method uses an scp program. If so, we call it. - ;; Otherwise, both encoding and decoding command must be - ;; specified. However, if the method _also_ specifies an - ;; encoding function, then that is used for encoding the - ;; contents of the tmp file. - (let* ((size (file-attribute-size (file-attributes tmpfile))) - (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) - (loc-enc (tramp-get-inline-coding v "local-encoding" size))) - (cond - ;; `copy-file' handles direct copy and out-of-band methods. - ((or (tramp-local-host-p v) - (tramp-method-out-of-band-p v size)) - (if (and (not (stringp start)) - (= (or end (point-max)) (point-max)) - (= (or start (point-min)) (point-min)) - (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile)) - (progn - (setq tramp-temp-buffer-file-name tmpfile) - (condition-case err - ;; We keep the local file for performance - ;; reasons, useful for "rsync". - (copy-file tmpfile filename t) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err))))) - (setq tramp-temp-buffer-file-name nil) - ;; Don't rename, in order to keep context in SELinux. - (unwind-protect - (copy-file tmpfile filename t) - (delete-file tmpfile)))) - - ;; Use inline file transfer. - (rem-dec - ;; Encode tmpfile. + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (if (and (tramp-local-host-p v) + ;; `file-writable-p' calls `file-expand-file-name'. We + ;; cannot use `tramp-run-real-handler' therefore. + (file-writable-p (file-name-directory localname)) + (or (file-directory-p localname) + (file-writable-p localname))) + ;; Short track: if we are on the local host, we can run directly. + (let ((create-lockfiles (not file-locked))) + (write-region start end localname append 'no-message lockname)) + + (let* ((modes (tramp-default-file-modes + filename (and (eq mustbenew 'excl) 'nofollow))) + ;; We use this to save the value of + ;; `last-coding-system-used' after writing the tmp file. + ;; At the end of the function, we set + ;; `last-coding-system-used' to this saved value. This + ;; way, any intermediary coding systems used while + ;; talking to the remote shell or suchlike won't hose + ;; this variable. This approach was snarfed from + ;; ange-ftp.el. + coding-system-used + ;; Write region into a tmp file. This isn't really + ;; needed if we use an encoding function, but currently + ;; we use it always because this makes the logic simpler. + ;; We must also set `temporary-file-directory', because + ;; it could point to a remote directory. + (temporary-file-directory + tramp-compat-temporary-file-directory) + (tmpfile (or tramp-temp-buffer-file-name + (tramp-compat-make-temp-file filename)))) + + ;; If `append' is non-nil, we copy the file locally, and let + ;; the native `write-region' implementation do the job. + (when (and append (file-exists-p filename)) + (copy-file filename tmpfile 'ok)) + + ;; We say `no-message' here because we don't want the visited + ;; file modtime data to be clobbered from the temp file. We + ;; call `set-visited-file-modtime' ourselves later on. We + ;; must ensure that `file-coding-system-alist' matches + ;; `tmpfile'. + (let ((file-coding-system-alist + (tramp-find-file-name-coding-system-alist filename tmpfile)) + create-lockfiles) + (condition-case err + (write-region start end tmpfile append 'no-message) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Now, `last-coding-system-used' has the right value. + ;; Remember it. + (setq coding-system-used last-coding-system-used)) + + ;; The permissions of the temporary file should be set. If + ;; FILENAME does not exist (eq modes nil) it has been renamed + ;; to the backup file. This case `save-buffer' handles + ;; permissions. Ensure that it is still readable. + (when modes + (set-file-modes tmpfile (logior (or modes 0) #o0400))) + + ;; This is a bit lengthy due to the different methods possible + ;; for file transfer. First, we check whether the method uses + ;; an scp program. If so, we call it. Otherwise, both + ;; encoding and decoding command must be specified. However, + ;; if the method _also_ specifies an encoding function, then + ;; that is used for encoding the contents of the tmp file. + (let* ((size (file-attribute-size (file-attributes tmpfile))) + (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) + (loc-enc (tramp-get-inline-coding v "local-encoding" size))) + (cond + ;; `copy-file' handles direct copy and out-of-band methods. + ((or (tramp-local-host-p v) + (tramp-method-out-of-band-p v size)) + (if (and (not (stringp start)) + (= (or end (point-max)) (point-max)) + (= (or start (point-min)) (point-min)) + (tramp-get-method-parameter + v 'tramp-copy-keep-tmpfile)) + (progn + (setq tramp-temp-buffer-file-name tmpfile) + (condition-case err + ;; We keep the local file for performance + ;; reasons, useful for "rsync". + (copy-file tmpfile filename t) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err))))) + (setq tramp-temp-buffer-file-name nil) + ;; Don't rename, in order to keep context in SELinux. (unwind-protect - (with-temp-buffer - (set-buffer-multibyte nil) - ;; Use encoding function or command. - (with-tramp-progress-reporter - v 3 (format-message - "Encoding local file `%s' using `%s'" - tmpfile loc-enc) - (if (functionp loc-enc) - ;; The following `let' is a workaround for - ;; the base64.el that comes with pgnus-0.84. - ;; If both of the following conditions are - ;; satisfied, it tries to write to a local - ;; file in default-directory, but at this - ;; point, default-directory is remote. - ;; (`call-process-region' can't write to - ;; remote files, it seems.) The file in - ;; question is a tmp file anyway. - (let ((coding-system-for-read 'binary) - (default-directory - tramp-compat-temporary-file-directory)) - (insert-file-contents-literally tmpfile) - (funcall loc-enc (point-min) (point-max))) - - (unless (zerop (tramp-call-local-coding-command - loc-enc tmpfile t)) - (tramp-error - v 'file-error - (concat "Cannot write to `%s', " - "local encoding command `%s' failed") - filename loc-enc)))) - - ;; Send buffer into remote decoding command which - ;; writes to remote file. Because this happens on - ;; the remote host, we cannot use the function. - (with-tramp-progress-reporter - v 3 (format-message - "Decoding remote file `%s' using `%s'" - filename rem-dec) - (goto-char (point-max)) - (unless (bolp) (newline)) - (tramp-send-command - v - (format - (concat rem-dec " <<'%s'\n%s%s") - (tramp-shell-quote-argument localname) - tramp-end-of-heredoc - (buffer-string) - tramp-end-of-heredoc)) - (tramp-barf-unless-okay - v nil - "Couldn't write region to `%s', decode using `%s' failed" - filename rem-dec) - ;; When `file-precious-flag' is set, the region is - ;; written to a temporary file. Check that the - ;; checksum is equal to that from the local tmpfile. - (when file-precious-flag - (erase-buffer) - (and - ;; cksum runs locally, if possible. - (zerop (tramp-call-process v "cksum" tmpfile t)) - ;; cksum runs remotely. - (tramp-send-command-and-check - v - (format - "cksum <%s" (tramp-shell-quote-argument localname))) - ;; ... they are different. - (not - (string-equal - (buffer-string) - (tramp-get-buffer-string (tramp-get-buffer v)))) - (tramp-error - v 'file-error - (concat "Couldn't write region to `%s'," - " decode using `%s' failed") - filename rem-dec))))) - - ;; Save exit. - (delete-file tmpfile))) - - ;; That's not expected. - (t - (tramp-error - v 'file-error - (concat "Method `%s' should specify both encoding and " - "decoding command or an scp program") - method)))) - - ;; Make `last-coding-system-used' have the right value. - (when coding-system-used - (setq last-coding-system-used coding-system-used)))) - - (tramp-flush-file-properties v localname) + (copy-file tmpfile filename t) + (delete-file tmpfile)))) + + ;; Use inline file transfer. + (rem-dec + ;; Encode tmpfile. + (unwind-protect + (with-temp-buffer + (set-buffer-multibyte nil) + ;; Use encoding function or command. + (with-tramp-progress-reporter + v 3 (format-message + "Encoding local file `%s' using `%s'" + tmpfile loc-enc) + (if (functionp loc-enc) + ;; The following `let' is a workaround for the + ;; base64.el that comes with pgnus-0.84. If + ;; both of the following conditions are + ;; satisfied, it tries to write to a local + ;; file in default-directory, but at this + ;; point, default-directory is remote. + ;; (`call-process-region' can't write to + ;; remote files, it seems.) The file in + ;; question is a tmp file anyway. + (let ((coding-system-for-read 'binary) + (default-directory + tramp-compat-temporary-file-directory)) + (insert-file-contents-literally tmpfile) + (funcall loc-enc (point-min) (point-max))) + + (unless (zerop (tramp-call-local-coding-command + loc-enc tmpfile t)) + (tramp-error + v 'file-error + (concat "Cannot write to `%s', " + "local encoding command `%s' failed") + filename loc-enc)))) + + ;; Send buffer into remote decoding command which + ;; writes to remote file. Because this happens on + ;; the remote host, we cannot use the function. + (with-tramp-progress-reporter + v 3 (format-message + "Decoding remote file `%s' using `%s'" + filename rem-dec) + (goto-char (point-max)) + (unless (bolp) (newline)) + (tramp-send-command + v + (format + (concat rem-dec " <<'%s'\n%s%s") + (tramp-shell-quote-argument localname) + tramp-end-of-heredoc + (buffer-string) + tramp-end-of-heredoc)) + (tramp-barf-unless-okay + v nil + "Couldn't write region to `%s', decode using `%s' failed" + filename rem-dec) + ;; When `file-precious-flag' is set, the region is + ;; written to a temporary file. Check that the + ;; checksum is equal to that from the local tmpfile. + (when file-precious-flag + (erase-buffer) + (and + ;; cksum runs locally, if possible. + (zerop (tramp-call-process v "cksum" tmpfile t)) + ;; cksum runs remotely. + (tramp-send-command-and-check + v + (format + "cksum <%s" + (tramp-shell-quote-argument localname))) + ;; ... they are different. + (not + (string-equal + (buffer-string) + (tramp-get-buffer-string (tramp-get-buffer v)))) + (tramp-error + v 'file-error + "Couldn't write region to `%s', decode using `%s' failed" + filename rem-dec))))) + + ;; Save exit. + (delete-file tmpfile))) + + ;; That's not expected. + (t + (tramp-error + v 'file-error + (concat "Method `%s' should specify both encoding and " + "decoding command or an scp program") + method)))) - ;; We must protect `last-coding-system-used', now we have set it - ;; to its correct value. - (let (last-coding-system-used (need-chown t)) - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (let ((file-attr (file-attributes filename 'integer))) - (set-visited-file-modtime - ;; We must pass modtime explicitly, because FILENAME can - ;; be different from (buffer-file-name), f.e. if - ;; `file-precious-flag' is set. - (or (file-attribute-modification-time file-attr) - (current-time))) - (when (and (= (file-attribute-user-id file-attr) uid) - (= (file-attribute-group-id file-attr) gid)) - (setq need-chown nil)))) - - ;; Set the ownership. - (when need-chown - (tramp-set-file-uid-gid filename uid gid)) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))))) + ;; Make `last-coding-system-used' have the right value. + (when coding-system-used + (setq last-coding-system-used coding-system-used)))))) (defvar tramp-vc-registered-file-names nil "List used to collect file names, which are checked during `vc-registered'.") diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4af5a4204f..968c1daccb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1617,28 +1617,8 @@ VEC or USER, or if there is no home directory, return nil." (defun tramp-smb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (curbuf (current-buffer)) - (tmpfile (tramp-compat-make-temp-file filename))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((tmpfile (tramp-compat-make-temp-file filename))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; We say `no-message' here because we don't want the visited file @@ -1654,33 +1634,7 @@ VEC or USER, or if there is no home directory, return nil." v (format "put %s \"%s\"" tmpfile (tramp-smb-get-localname v))) (tramp-error v 'file-error "Cannot write `%s'" filename)) - (delete-file tmpfile))) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (delete-file tmpfile)))))) ;; Internal file name functions. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 02c0da3f18..61bf165f30 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -373,47 +373,10 @@ arguments to pass to the OPERATION." (defun tramp-sshfs-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - - (let (create-lockfiles) - (write-region - start end (tramp-fuse-local-file-name filename) append 'nomessage) - (tramp-flush-file-properties v localname)) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let (create-lockfiles) + (write-region + start end (tramp-fuse-local-file-name filename) append 'nomessage)))) ;; File name conversions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3d28861179..b889f1f884 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3353,6 +3353,121 @@ User is always nil." (forward-line 1) result)) +;;; Skeleton macros for file name handler functions. + +(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) + "Skeleton for `tramp-*-handle-delete-directory'. +BODY is the backend specific code." + (declare (indent 3) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) + (tramp-error + v 'file-error "Directory is not empty, not moving to trash") + (move-file-to-trash ,directory)) + ,@body) + (tramp-flush-directory-properties v localname))) + +(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) + +(defmacro tramp-skeleton-write-region + (start end filename append visit lockname mustbenew &rest body) + "Skeleton for `tramp-*-handle-write-region'. +BODY is the backend specific code." + (declare (indent 7) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,filename) nil + (setq ,filename (expand-file-name ,filename) + ,lockname (file-truename (or ,lockname ,filename))) + ;; Sometimes, there is another file name handler responsible for + ;; VISIT, for example `jka-compr-handler'. We must respect this. + ;; See Bug#55166. + (let ((handler (and (stringp ,visit) + (let ((inhibit-file-name-handlers + (cons 'tramp-file-name-handler + inhibit-file-name-handlers)) + (inhibit-file-name-operation 'write-region)) + (find-file-name-handler ,visit 'write-region))))) + (if handler + (progn + (tramp-message + v 5 "Calling handler `%s' for visiting `%s'" handler ,visit) + (funcall + handler 'write-region + ,start ,end ,filename ,append ,visit ,lockname ,mustbenew)) + + (when (and ,mustbenew (file-exists-p ,filename) + (or (eq ,mustbenew 'excl) + (not + (y-or-n-p + (format + "File %s exists; overwrite anyway?" ,filename))))) + (tramp-error v 'file-already-exists ,filename)) + + (let ((file-locked (eq (file-locked-p ,lockname) t)) + (uid (or (file-attribute-user-id + (file-attributes ,filename 'integer)) + (tramp-get-remote-uid v 'integer))) + (gid (or (file-attribute-group-id + (file-attributes ,filename 'integer)) + (tramp-get-remote-gid v 'integer))) + (curbuf (current-buffer))) + + ;; Lock file. + (when (and (not (auto-save-file-name-p + (file-name-nondirectory ,filename))) + (file-remote-p ,lockname) + (not file-locked)) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file ,lockname)) + + ;; The body. + ,@body + + ;; We must protect `last-coding-system-used', now we have + ;; set it to its correct value. + (let (last-coding-system-used (need-chown t)) + ;; Set file modification time. + (when (or (eq ,visit t) (stringp ,visit)) + (let ((file-attr (file-attributes ,filename 'integer))) + (set-visited-file-modtime + ;; We must pass modtime explicitly, because FILENAME + ;; can be different from (buffer-file-name), f.e. if + ;; `file-precious-flag' is set. + (or (file-attribute-modification-time file-attr) + (current-time))) + (when (and (= (file-attribute-user-id file-attr) uid) + (= (file-attribute-group-id file-attr) gid)) + (setq need-chown nil)))) + + ;; Set the ownership. + (when need-chown + (tramp-set-file-uid-gid ,filename uid gid))) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + ;; Unlock file. + (when file-locked + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file ,lockname)) + + ;; Sanity check. + (unless (equal curbuf (current-buffer)) + (tramp-error + v 'file-error + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) + + (when (and (null noninteractive) + (or (eq ,visit t) (string-or-null-p ,visit))) + (tramp-message v 0 "Wrote %s" ,filename)) + (run-hooks 'tramp-handle-write-region-hook)))))) + +(put #'tramp-skeleton-write-region 'tramp-suppress-trace t) + ;;; Common file name handler functions for different backends: (defvar tramp-handle-file-local-copy-hook nil @@ -4827,33 +4942,10 @@ of." (defun tramp-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (tmpfile (tramp-compat-make-temp-file filename)) + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((tmpfile (tramp-compat-make-temp-file filename)) (modes (tramp-default-file-modes - filename (and (eq mustbenew 'excl) 'nofollow))) - (uid (or (file-attribute-user-id (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (file-attribute-group-id (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + filename (and (eq mustbenew 'excl) 'nofollow)))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; The permissions of the temporary file should be set. If @@ -4872,29 +4964,7 @@ of." (error (delete-file tmpfile) (tramp-error - v 'file-error "Couldn't write region to `%s'" filename))) - - (tramp-flush-file-properties v localname) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Set the ownership. - (tramp-set-file-uid-gid filename uid gid) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + v 'file-error "Couldn't write region to `%s'" filename)))))) ;; This is used in tramp-sh.el and tramp-sudoedit.el. (defconst tramp-stat-marker "/////" @@ -6176,23 +6246,6 @@ If VEC is `tramp-null-hop', return local null device." (let ((default-directory (tramp-make-tramp-file-name vec))) (tramp-compat-null-device))))) -(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) - "Skeleton for `tramp-*-handle-delete-directory'. -BODY is the backend specific code." - (declare (indent 3) (debug t)) - `(with-parsed-tramp-file-name (expand-file-name ,directory) nil - (if (and delete-by-moving-to-trash ,trash) - ;; Move non-empty dir to trash only if recursive deletion was - ;; requested. - (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) - (tramp-error - v 'file-error "Directory is not empty, not moving to trash") - (move-file-to-trash ,directory)) - ,@body) - (tramp-flush-directory-properties v localname))) - -(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) - ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' commit 0b626ff8d6a29c452bc8bbbee79f5eff11d02548 Author: Filipp Gunbin Date: Tue May 3 12:35:34 2022 +0200 Rewrite sql-interactive-remove-continuation-prompt * lisp/progmodes/sql.el (sql-starts-with-prompt-re): Remove. (sql-ends-with-prompt-re): Remove (sql-interactive-remove-continuation-prompt): Delete prompts from anywhere in the process output, not just at the beginning of current string. Streamline logic, describe it in docstring. * test/lisp/progmodes/sql-tests.el: Add tests diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 5e5f5e13fe..979b743a65 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3648,94 +3648,69 @@ Allows the suppression of continuation prompts.") (defvar sql-preoutput-hold nil) -(defun sql-starts-with-prompt-re () - "Anchor the prompt expression at the beginning of the output line. -Remove the start of line regexp." - (concat "\\`" comint-prompt-regexp)) - -(defun sql-ends-with-prompt-re () - "Anchor the prompt expression at the end of the output line. -Match a SQL prompt or a password prompt." - (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|" - "\\(?:" comint-password-prompt-regexp "\\)\\)\\'")) - (defun sql-interactive-remove-continuation-prompt (oline) "Strip out continuation prompts out of the OLINE. Added to the `comint-preoutput-filter-functions' hook in a SQL -interactive buffer. If `sql-output-newline-count' is greater than -zero, then an output line matching the continuation prompt is filtered -out. If the count is zero, then a newline is inserted into the output -to force the output from the query to appear on a new line. - -The complication to this filter is that the continuation prompts -may arrive in multiple chunks. If they do, then the function -saves any unfiltered output in a buffer and prepends that buffer -to the next chunk to properly match the broken-up prompt. - -If the filter gets confused, it should reset and stop filtering -to avoid deleting non-prompt output." - - ;; continue gathering lines of text iff - ;; + we know what a prompt looks like, and - ;; + there is held text, or - ;; + there are continuation prompt yet to come, or - ;; + not just a prompt string +interactive buffer. The complication to this filter is that the +continuation prompts may arrive in multiple chunks. If they do, +then the function saves any unfiltered output in a buffer and +prepends that buffer to the next chunk to properly match the +broken-up prompt. + +The filter goes into play only if something is already +accumulated, or we're waiting for continuation +prompts (`sql-output-newline-count' is positive). In this case: +- Accumulate process output into `sql-preoutput-hold'. +- Remove any complete prompts / continuation prompts that we're waiting + for. +- In case we're expecting more prompts - return all currently + accumulated _complete_ lines, leaving the rest for the next + invocation. They will appear in the output immediately. This way we + don't accumulate large chunks of data for no reason. +- If we found all expected prompts - just return all current accumulated + data." (when (and comint-prompt-regexp - (or (> (length (or sql-preoutput-hold "")) 0) - (> (or sql-output-newline-count 0) 0) - (not (or (string-match sql-prompt-regexp oline) - (and sql-prompt-cont-regexp - (string-match sql-prompt-cont-regexp oline)))))) - + ;; We either already have something held, or expect + ;; prompts + (or sql-preoutput-hold + (and sql-output-newline-count + (> sql-output-newline-count 0)))) (save-match-data - (let (prompt-found last-nl) - - ;; Add this text to what's left from the last pass - (setq oline (concat sql-preoutput-hold oline) - sql-preoutput-hold "") - - ;; If we are looking for multiple prompts - (when (and (integerp sql-output-newline-count) - (>= sql-output-newline-count 1)) - ;; Loop thru each starting prompt and remove it - (let ((start-re (sql-starts-with-prompt-re))) - (while (and (not (string= oline "")) - (> sql-output-newline-count 0) - (string-match start-re oline)) - (setq oline (replace-match "" nil nil oline) - sql-output-newline-count (1- sql-output-newline-count) - prompt-found t))) - - ;; If we've found all the expected prompts, stop looking - (if (= sql-output-newline-count 0) - (setq sql-output-newline-count nil) - - ;; Still more possible prompts, leave them for the next pass - (setq sql-preoutput-hold oline - oline ""))) - - ;; If no prompts were found, stop looking - (unless prompt-found - (setq sql-output-newline-count nil - oline (concat oline sql-preoutput-hold) - sql-preoutput-hold "")) - - ;; Break up output by physical lines if we haven't hit the final prompt - (let ((end-re (sql-ends-with-prompt-re))) - (unless (and (not (string= oline "")) - (string-match end-re oline) - (>= (match-end 0) (length oline))) - ;; Find everything upto the last nl - (setq last-nl 0) - (while (string-match "\n" oline last-nl) - (setq last-nl (match-end 0))) - ;; Hold after the last nl, return upto last nl - (setq sql-preoutput-hold (concat (substring oline last-nl) - sql-preoutput-hold) - oline (substring oline 0 last-nl))))))) + ;; Add this text to what's left from the last pass + (setq oline (concat sql-preoutput-hold oline) + sql-preoutput-hold nil) + + ;; If we are looking for prompts + (when (and sql-output-newline-count + (> sql-output-newline-count 0)) + ;; Loop thru each starting prompt and remove it + (while (and (not (string-empty-p oline)) + (> sql-output-newline-count 0) + (string-match comint-prompt-regexp oline)) + (setq oline (replace-match "" nil nil oline) + sql-output-newline-count (1- sql-output-newline-count))) + + ;; If we've found all the expected prompts, stop looking + (if (= sql-output-newline-count 0) + (setq sql-output-newline-count nil) + ;; Still more possible prompts, leave them for the next pass + (setq sql-preoutput-hold oline + oline ""))) + + ;; Lines that are now complete may be passed further + (when sql-preoutput-hold + (let ((last-nl 0)) + (while (string-match "\n" sql-preoutput-hold last-nl) + (setq last-nl (match-end 0))) + ;; Return up to last nl, hold after the last nl + (setq oline (substring sql-preoutput-hold 0 last-nl) + sql-preoutput-hold (substring sql-preoutput-hold last-nl)) + (when (string-empty-p sql-preoutput-hold) + (setq sql-preoutput-hold nil)))))) oline) + ;;; Sending the region to the SQLi buffer. (defvar sql-debug-send nil "Display text sent to SQL process pragmatically.") diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 7e36d845e2..c644d115df 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -425,5 +425,85 @@ The ACTION will be tested after set-up of PRODUCT." (let ((sql-password "password")) (should (equal "password" (sql-comint-automatic-password ""))))) + + +;; Tests for sql-interactive-remove-continuation-prompt + +(defmacro sql-tests-remove-cont-prompts-harness (&rest body) + "Set-up and tear-down for tests of +`sql-interactive-remove-continuation-prompt'." + (declare (indent 0)) + `(let ((comint-prompt-regexp "^ +\\.\\{3\\} ") + (sql-output-newline-count nil) + (sql-preoutput-hold nil)) + ,@body + (should (null sql-output-newline-count)) + (should (null sql-preoutput-hold)))) + +(ert-deftest sql-tests-remove-cont-prompts-pass-through () + "Test that `sql-interactive-remove-continuation-prompt' just +passes the output line through when it doesn't expect prompts." + (sql-tests-remove-cont-prompts-harness + (should + (equal " ... " + (sql-interactive-remove-continuation-prompt + " ... "))))) + +(ert-deftest sql-tests-remove-cont-prompts-anchored-successive () + "Test that `sql-interactive-remove-continuation-prompt' is able +to delete multiple prompts (anchored to bol) even if they appear +in a single line, but not more than `sql-output-newline-count'." + (sql-tests-remove-cont-prompts-harness + (setq sql-output-newline-count 2) + (should + (equal + ;; 2 of 3 prompts are deleted + "some output ... more output...\n\ + ... \n\ +output after prompt" + (sql-interactive-remove-continuation-prompt + "some output ... more output...\n\ + ... ... ... \n\ +output after prompt"))))) + +(ert-deftest sql-tests-remove-cont-prompts-collect-chunked-output () + "Test that `sql-interactive-remove-continuation-prompt' properly +collects output when output arrives in chunks, with prompts +intermixed." + (sql-tests-remove-cont-prompts-harness + (setq sql-output-newline-count 2) + + ;; Part of first prompt gets held. Complete line is passed + ;; through. + (should (equal "line1\n" + (sql-interactive-remove-continuation-prompt + "line1\n .."))) + (should (equal " .." sql-preoutput-hold)) + (should (equal 2 sql-output-newline-count)) + + ;; First prompt is complete - remove it. Hold part of line2. + (should (equal "" + (sql-interactive-remove-continuation-prompt ". li"))) + (should (equal "li" sql-preoutput-hold)) + (should (equal 1 sql-output-newline-count)) + + ;; Remove second prompt. Flush output & don't hold / process any + ;; output further on. + (should (equal "line2\nli" + (sql-interactive-remove-continuation-prompt "ne2\n ... li"))) + (should (null sql-preoutput-hold)) + (should (null sql-output-newline-count)) + (should (equal "line3\n ... " + (sql-interactive-remove-continuation-prompt "line3\n ... "))))) + +(ert-deftest sql-tests-remove-cont-prompts-flush-held () + "Test that when we don't wait for prompts, + `sql-interactive-remove-continuation-prompt' just 'flushes' held + output, with no prompt processing." + (sql-tests-remove-cont-prompts-harness + (setq sql-preoutput-hold "line1\n ..") + (should (equal "line1\n ... line2 .." + (sql-interactive-remove-continuation-prompt ". line2 .."))))) + (provide 'sql-tests) ;;; sql-tests.el ends here commit 0e8fc556b669cbb4794b76b8197519f808083dac Author: Lars Ingebrigtsen Date: Tue May 3 12:23:25 2022 +0200 Make more buttons in *Help* respect `help-window-keep-selected' * lisp/help-mode.el (help-function-cmacro, help-variable-def) (help-face-def): Also respect `help-window-keep-selected' like the other commands. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index c725c0f1a1..94bd591131 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -296,7 +296,10 @@ The format is (FUNCTION ARGS...).") (setq file (locate-library file t)) (if (and file (file-readable-p file)) (progn - (pop-to-buffer (find-file-noselect file)) + (if help-window-keep-selected + (pop-to-buffer-same-window + (find-file-noselect file)) + (pop-to-buffer (find-file-noselect file))) (widen) (goto-char (point-min)) (if (re-search-forward @@ -315,7 +318,9 @@ The format is (FUNCTION ARGS...).") (setq file (help-C-file-name var 'var))) (let* ((location (find-variable-noselect var file)) (position (cdr location))) - (pop-to-buffer (car location)) + (if help-window-keep-selected + (pop-to-buffer-same-window (car location)) + (pop-to-buffer (car location))) (run-hooks 'find-function-after-hook) (if position (progn @@ -336,7 +341,9 @@ The format is (FUNCTION ARGS...).") (let* ((location (find-function-search-for-symbol fun 'defface file)) (position (cdr location))) - (pop-to-buffer (car location)) + (if help-window-keep-selected + (pop-to-buffer-same-window (car location)) + (pop-to-buffer (car location))) (if position (progn ;; Widen the buffer if necessary to go to this position. @@ -378,7 +385,9 @@ The format is (FUNCTION ARGS...).") :supertype 'help-xref 'help-function (lambda (file pos) - (view-buffer-other-window (find-file-noselect file)) + (if help-window-keep-selected + (view-buffer (find-file-noselect file)) + (view-buffer-other-window (find-file-noselect file))) (goto-char pos)) 'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement")) commit cf0d289e3838a6978b768b347f9fb5c1c2cad196 Author: Lars Ingebrigtsen Date: Tue May 3 11:32:03 2022 +0200 Further mm-base64-line-p bug fixes * lisp/gnus/mm-bodies.el (mm-base64-line-p): Fix parsing error introduced by d90f54d. diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 0de1399ac7..9045966df5 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -245,9 +245,9 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (save-excursion (beginning-of-line) (skip-chars-forward " \t") - (and (looking-at "[A-Za-z0-9+]\\{3\\}") + (and (looking-at "[A-Za-z0-9+/]\\{3\\}") (progn - (skip-chars-forward "A-Za-z0-9+") + (skip-chars-forward "A-Za-z0-9+/") (skip-chars-forward "=") (skip-chars-forward " \t") (eolp))))) commit d5803a0c97cc08d93d0cb93d05b037f5544a40e0 Author: Lars Ingebrigtsen Date: Tue May 3 11:28:59 2022 +0200 Fix mm-base64-line-p logic * lisp/gnus/mm-bodies.el (mm-base64-line-p): Don't claim that an empty line is base64. diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 0d4237a64c..0de1399ac7 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -245,10 +245,12 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (save-excursion (beginning-of-line) (skip-chars-forward " \t") - (skip-chars-forward "A-Za-z0-9+") - (skip-chars-forward "=") - (skip-chars-forward " \t") - (eolp))) + (and (looking-at "[A-Za-z0-9+]\\{3\\}") + (progn + (skip-chars-forward "A-Za-z0-9+") + (skip-chars-forward "=") + (skip-chars-forward " \t") + (eolp))))) (defun mm-decode-body (charset &optional encoding type) "Decode the current article that has been encoded with ENCODING to CHARSET. commit b8dfd8400af34e37148652cfd313e7aa4a4a1c40 Author: Po Lu Date: Tue May 3 08:19:41 2022 +0000 * src/haiku_support.cc (DrawContent): Use right UI color. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 12934faa1c..80c3ba3331 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2306,7 +2306,7 @@ class EmacsTitleMenuItem : public BMenuItem menu->PushState (); menu->SetFont (be_bold_font); - menu->SetHighColor (ui_color (B_CONTROL_TEXT_COLOR)); + menu->SetHighColor (ui_color (B_MENU_ITEM_TEXT_COLOR)); BMenuItem::DrawContent (); menu->PopState (); } commit 2ec7521b4133d0d24759c200902dee0919a9412e Author: Po Lu Date: Tue May 3 16:13:59 2022 +0800 ; * lisp/tooltip.el (tooltip-show-help): Fix typo in last change. diff --git a/lisp/tooltip.el b/lisp/tooltip.el index d6b6b1bc9b..e24d03b8e8 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -381,7 +381,7 @@ MSG is either a help string to display, or nil to cancel the display." ;; Tooltips can't be displayed on top of the global menu ;; bar on NS. (or (not (eq window-system 'ns)) - (menu-or-popup-active-p))) + (not (menu-or-popup-active-p)))) (let ((previous-help tooltip-help-message)) (setq tooltip-help-message msg) (cond ((null msg) commit 5adc84a27b86cdbd048ee3ebc023549c928f7425 Author: Po Lu Date: Tue May 3 16:12:24 2022 +0800 Make menu bar help text work on macOS as well * lisp/tooltip.el (tooltip-show-help): Resort to displaying messages in the echo area on NS. * src/nsmenu.m ([EmacsMenu menu:willHighlightItem:]): Call `show_help_echo' instead of storing an event into the keyboard buffer. diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 0ee3c38e26..d6b6b1bc9b 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -377,7 +377,11 @@ It is also called if Tooltip mode is on, for text-only displays." (defun tooltip-show-help (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." - (if (and (display-graphic-p)) + (if (and (display-graphic-p) + ;; Tooltips can't be displayed on top of the global menu + ;; bar on NS. + (or (not (eq window-system 'ns)) + (menu-or-popup-active-p))) (let ((previous-help tooltip-help-message)) (setq tooltip-help-message msg) (cond ((null msg) diff --git a/src/nsmenu.m b/src/nsmenu.m index 0f7d1fb98f..b0ab12bb87 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -760,12 +760,6 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f : Qnil; } -#ifdef NS_IMPL_GNUSTEP -/* The code below doesn't work on Mac OS X, because it runs a nested - Carbon-related event loop to track menu bar movement. - - But it works fine aside from that, so it will work on GNUstep if - they start to call `willHighlightItem'. */ - (void) menu: (NSMenu *) menu willHighlightItem: (NSMenuItem *) item { NSInteger idx = [item tag]; @@ -779,12 +773,11 @@ - (void) menu: (NSMenu *) menu willHighlightItem: (NSMenuItem *) item XSETFRAME (frame, f); help = AREF (vec, idx + MENU_ITEMS_ITEM_HELP); + popup_activated_flag++; if (STRINGP (help) || NILP (help)) - kbd_buffer_store_help_event (frame, help); - - raise (SIGIO); + show_help_echo (help, Qnil, Qnil, Qnil); + popup_activated_flag--; } -#endif #ifdef NS_IMPL_GNUSTEP - (void) close commit f9dea5b4c5ba8e8a24cba3dc3d66a1f8a2a2b21f Author: Po Lu Date: Tue May 3 16:05:46 2022 +0800 Fix default font in macOS font dialogs * src/nsterm.m ([EmacsView noteUserSelectedFont]): Use current font if none was selected. diff --git a/src/nsterm.m b/src/nsterm.m index 7deafc8cbb..dfb7c5d202 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6182,6 +6182,19 @@ - (void) changeFont: (id) sender - (void) noteUserSelectedFont { font_panel_active = NO; + + /* If no font was previously selected, use the currently selected + font. */ + + if (!font_panel_result && FRAME_FONT (emacsframe)) + { + font_panel_result + = macfont_get_nsctfont (FRAME_FONT (emacsframe)); + + if (font_panel_result) + [font_panel_result retain]; + } + [NSApp stop: self]; } #endif commit 64aac418c250beb8faeb23e182531abfd9cd9af8 Author: Po Lu Date: Tue May 3 16:02:02 2022 +0800 Fix some font parsing problems on NS * src/nsterm.m (ns_font_desc_to_font_spec): Fix processing of condensed width. diff --git a/src/nsterm.m b/src/nsterm.m index 21232f55ad..7deafc8cbb 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6102,7 +6102,7 @@ - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg if (tem != nil) lwidth = ([tem floatValue] > 0 ? Qexpanded : ([tem floatValue] < 0 - ? Qnormal : Qcondensed)); + ? Qcondensed : Qnormal)); } lheight = make_float ([font pointSize]); @@ -6110,7 +6110,9 @@ - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg return CALLN (Ffont_spec, QCwidth, lwidth, QCslant, lslant, QCweight, lweight, QCsize, lheight, - QCfamily, [family lispString]); + QCfamily, (family + ? [family lispString] + : Qnil)); } /* ========================================================================== commit 0b94669c14ad78c82f47adb4fb376ce48f5fe7e3 Author: Po Lu Date: Tue May 3 13:40:54 2022 +0800 Handle GraphicsExpose events on scroll bars * src/xterm.c (x_scroll_bar_expose): Handle GraphicsExpose events. (handle_one_xevent): Give graphics exposures to scroll bars. diff --git a/src/xterm.c b/src/xterm.c index 367e69fb95..90182a89f1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13143,6 +13143,22 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) #else Drawable w = bar->x_drawable; #endif + int x, y, width, height; + + if (event->type == Expose) + { + x = event->xexpose.x; + y = event->xexpose.y; + width = event->xexpose.width; + height = event->xexpose.height; + } + else + { + x = event->xgraphicsexpose.x; + y = event->xgraphicsexpose.y; + width = event->xgraphicsexpose.width; + height = event->xgraphicsexpose.height; + } struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; @@ -13161,10 +13177,7 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) XFillRectangle (FRAME_X_DISPLAY (f), bar->x_drawable, - gc, event->xexpose.x, - event->xexpose.y, - event->xexpose.width, - event->xexpose.height); + gc, x, y, width, height); XSetForeground (FRAME_X_DISPLAY (f), gc, FRAME_FOREGROUND_PIXEL (f)); @@ -14835,6 +14848,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, show_back_buffer (f); #endif } +#ifndef USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (dpyinfo->display, + /* Hopefully this is just a window, + not the back buffer. */ + event->xgraphicsexpose.drawable, 2); + + if (bar) + x_scroll_bar_expose (bar, event); +#endif #ifdef USE_X_TOOLKIT else goto OTHER; commit c77ef7d193cfba2e06846012abeb684e37d228a9 Author: Po Lu Date: Tue May 3 11:43:32 2022 +0800 Make sure rectangles are drawn correctly on X * src/xfaces.c (prepare_face_for_display): Always use line-width of 1. * src/xfns.c (x_make_gc): Likewise. * src/xterm.c (x_scroll_bar_expose): Comment out obsolete code. diff --git a/src/xfaces.c b/src/xfaces.c index 8ebb33c5ab..05e0df4b7d 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4447,17 +4447,26 @@ free_realized_face (struct frame *f, struct face *face) void prepare_face_for_display (struct frame *f, struct face *face) { + Emacs_GC egc; + unsigned long mask; + eassert (FRAME_WINDOW_P (f)); if (face->gc == 0) { - Emacs_GC egc; - unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures; + mask = GCForeground | GCBackground | GCGraphicsExposures; egc.foreground = face->foreground; egc.background = face->background; #ifdef HAVE_X_WINDOWS egc.graphics_exposures = False; + + /* While this was historically slower than a line_width of 0, + the difference no longer matters on modern X servers, so set + it to 1 in order for PolyLine requests to behave consistently + everywhere. */ + mask |= GCLineWidth; + egc.line_width = 1; #endif block_input (); diff --git a/src/xfns.c b/src/xfns.c index 14721c6ce8..dc8f02780c 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4237,7 +4237,7 @@ x_make_gc (struct frame *f) gc_values.foreground = FRAME_FOREGROUND_PIXEL (f); gc_values.background = FRAME_BACKGROUND_PIXEL (f); - gc_values.line_width = 0; /* Means 1 using fast algorithm. */ + gc_values.line_width = 1; f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), diff --git a/src/xterm.c b/src/xterm.c index adfe90522d..367e69fb95 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13183,8 +13183,11 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) /* x, y, width, height */ 0, 0, bar->width - 1, bar->height - 1); - XDrawPoint (FRAME_X_DISPLAY (f), w, gc, - bar->width - 1, bar->height - 1); + /* XDrawPoint (FRAME_X_DISPLAY (f), w, gc, + bar->width - 1, bar->height - 1); + + This code is no longer required since the normal GC now uses the + regular line width. */ /* Restore the foreground color of the GC if we changed it above. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) commit 61a5829c1ed4ec3d2e824da6048c58bf447d86b3 Author: Po Lu Date: Tue May 3 03:18:11 2022 +0000 Fix glyphless glyph display on Haiku * src/haikuterm.c (haiku_draw_glyphless_glyph_string_foreground): Fix rectangle width. diff --git a/src/haikuterm.c b/src/haikuterm.c index bdec82db7a..1481d95c08 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1180,8 +1180,8 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s) BView_SetPenSize (FRAME_HAIKU_VIEW (s->f), 1); BView_StrokeRectangle (FRAME_HAIKU_VIEW (s->f), x, s->ybase - glyph->ascent, - glyph->pixel_width - 1, - glyph->ascent + glyph->descent - 1); + glyph->pixel_width, + glyph->ascent + glyph->descent); } x += glyph->pixel_width; } commit 0d5befb88243b1b92170f7c46664d6639b653f6c Author: Po Lu Date: Tue May 3 02:44:00 2022 +0000 Fix font matching of "Fira Code Retina" and "Fira Code Regular" on Haiku * src/haiku_font_support.cc (font_family_style_matches_p): Don't allow matches on fonts with an adstyle if none was specified in the input pattern. diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index cc4eba5c29..339634f01b 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -490,8 +490,8 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, if (style) font_style_to_flags (style, &m); - if ((pattern->specified & FSPEC_FAMILY) && - strcmp ((char *) &pattern->family, family)) + if ((pattern->specified & FSPEC_FAMILY) + && strcmp ((char *) &pattern->family, family)) return false; if (!ignore_flags_p && (pattern->specified & FSPEC_SPACING) @@ -500,6 +500,10 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, if (pattern->specified & FSPEC_STYLE) return style && !strcmp (style, pattern->style); + /* Don't allow matching fonts with an adstyle if no style was + specified in the query pattern. */ + else if (m.specified & FSPEC_STYLE) + return false; if ((pattern->specified & FSPEC_WEIGHT) && (pattern->weight commit 5dfe568cad7c9bc79eccad6a4382a6631246980a Author: Glenn Morris Date: Mon May 2 18:26:22 2022 -0700 Don't leave temp files behind from undigest-tests Sadly the "temp" in with-temp-file refers to a buffer, not a file. * test/lisp/mail/undigest-tests.el (rmail-undigest-test-rfc934-digest) (rmail-undigest-test-rfc1153-digest-strict) (rmail-undigest-test-rfc1153-less-strict-digest) (rmail-undigest-test-rfc1153-sloppy-digest) (rmail-undigest-test-rfc1521-mime-digest) (rmail-undigest-test-multipart-mixed-digest): Delete temporary files at end. diff --git a/test/lisp/mail/undigest-tests.el b/test/lisp/mail/undigest-tests.el index 5ad0da0fc0..b88868be7f 100644 --- a/test/lisp/mail/undigest-tests.el +++ b/test/lisp/mail/undigest-tests.el @@ -271,59 +271,65 @@ The footer. (ert-deftest rmail-undigest-test-rfc934-digest () "Test that we can undigest a RFC 934 digest." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc934-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 4)) - (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc934-digest) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n"))) + (delete-file file)))) (ert-deftest rmail-undigest-test-rfc1153-digest-strict () "Test that we can undigest a strict RFC 1153 digest." :expected-result :failed (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1153-digest-strict) - (write-region nil nil file) - (rmail file) - (should - (condition-case nil - (progn + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1153-digest-strict) + (write-region nil nil file) + (rmail file) + (should + (ignore-errors ;; This throws an error, because the Trailer is not recognized ;; as a valid RFC 822 (or later) message. (undigestify-rmail-message) (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) (should (string= (rmail-message-content 3) "This is message one.\n\n")) (should (string= (rmail-message-content 4) "This is message two.\n")) - t) - (error nil)))))) + t))) + (delete-file file)))) (ert-deftest rmail-undigest-test-rfc1153-less-strict-digest () "Test that we can undigest a RFC 1153 with a Subject header in its footer." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1153-digest-less-strict) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 5)) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1153-digest-less-strict) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n"))) + (delete-file file)))) (ert-deftest rmail-undigest-test-rfc1153-sloppy-digest () "Test that we can undigest a sloppy RFC 1153 digest." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1153-digest-sloppy) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 5)) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1153-digest-sloppy) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n"))) + (delete-file file)))) ;; This fails because `rmail-digest-parse-mime' combines the preamble with the ;; first message of the digest. And then, it doesn't get rid of the last @@ -332,23 +338,27 @@ The footer. "Test that we can undigest a RFC 1521 MIME digest." :expected-result :failed (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1521-mime-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 3)) - (should (string= (rmail-message-content 2) "Message one.\n\n")) - (should (string= (rmail-message-content 3) "Message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1521-mime-digest) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 3)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n"))) + (delete-file file)))) (ert-deftest rmail-undigest-test-multipart-mixed-digest () "Test that we can undigest a digest inside a multipart/mixed digest." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-multipart-mixed-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 4)) - (should (string= (rmail-message-content 2) "Message one.\n\n")) - (should (string= (rmail-message-content 3) "Message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-multipart-mixed-digest) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n"))) + (delete-file file)))) commit 952cc28e58eafbdd409bf36f9ca656dae533542b Author: Po Lu Date: Tue May 3 09:22:06 2022 +0800 Clean up X11 double buffering code This fixes several latent bugs where code went down the path with double buffering enabled when it wasn't, and vice versa. * src/xfns.c (x_set_inhibit_double_buffering): Improve commentary and only define when HAVE_XDBE. (x_mark_frame_dirty): Only set buffer flip flag when HAVE_XDBE. (initial_set_up_x_back_buffer): Clean up coding style and remove unnecessary block_input pair. (Fx_double_buffered_p): Always return nil if !HAVE_XDBE. (x_frame_parm_handlers): Don't set double buffering handler if !HAVE_XDBE. * src/xftfont.c (xftfont_drop_xrender_surfaces, xftfont_driver): Only define when XDBE is available. * src/xterm.c (x_drop_xrender_surfaces): Likewise. (x_clear_window): Don't test double buffering flags when !HAVE_XDBE. (show_back_buffer): Only define when HAVE_XDBE. (x_flip_and_flush): Don't try to flip when !HAVE_XDBE. (XTframe_up_to_date): Likewise. (XTbuffer_flipping_unblocked_hook): Only define when Xdbe is available. (x_clear_area): Don't test double buffering flags when Xdbe is not available. (flush_dirty_back_buffer_on): Don't define if there's no DBE. (handle_one_xevent, x_create_terminal): Likewise. * src/xterm.h (FRAME_X_DRAWABLE): Fix coding style. diff --git a/src/xfns.c b/src/xfns.c index 7176d62609..14721c6ce8 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -823,22 +823,24 @@ x_set_tool_bar_position (struct frame *f, wrong_choice (choice, new_value); } +#ifdef HAVE_XDBE static void x_set_inhibit_double_buffering (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { - block_input (); + bool want_double_buffering, was_double_buffered; + if (FRAME_X_WINDOW (f) && !EQ (new_value, old_value)) { - bool want_double_buffering = NILP (new_value); - bool was_double_buffered = FRAME_X_DOUBLE_BUFFERED_P (f); - /* font_drop_xrender_surfaces in xftfont does something only if - we're double-buffered, so call font_drop_xrender_surfaces before - and after any potential change. One of the calls will end up - being a no-op. */ + want_double_buffering = NILP (new_value); + was_double_buffered = FRAME_X_DOUBLE_BUFFERED_P (f); + + block_input (); if (want_double_buffering != was_double_buffered) { + /* Force XftDraw etc to be recreated with the new double + buffered drawable. */ font_drop_xrender_surfaces (f); /* Scroll bars decide whether or not to use a back buffer @@ -860,9 +862,10 @@ x_set_inhibit_double_buffering (struct frame *f, SET_FRAME_GARBAGED (f); font_drop_xrender_surfaces (f); } + unblock_input (); } - unblock_input (); } +#endif /** * x_set_undecorated: @@ -3548,8 +3551,11 @@ xic_set_xfontset (struct frame *f, const char *base_fontname) void x_mark_frame_dirty (struct frame *f) { - if (FRAME_X_DOUBLE_BUFFERED_P (f) && !FRAME_X_NEED_BUFFER_FLIP (f)) +#ifdef HAVE_XDBE + if (FRAME_X_DOUBLE_BUFFERED_P (f) + && !FRAME_X_NEED_BUFFER_FLIP (f)) FRAME_X_NEED_BUFFER_FLIP (f) = true; +#endif } static void @@ -3630,12 +3636,12 @@ tear_down_x_back_buffer (struct frame *f) void initial_set_up_x_back_buffer (struct frame *f) { - block_input (); eassert (FRAME_X_WINDOW (f)); FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f); - if (NILP (CDR (Fassq (Qinhibit_double_buffering, f->param_alist)))) + + if (NILP (CDR (Fassq (Qinhibit_double_buffering, + f->param_alist)))) set_up_x_back_buffer (f); - unblock_input (); } #if defined HAVE_XINPUT2 @@ -8614,7 +8620,12 @@ DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p, (Lisp_Object frame) { struct frame *f = decode_live_frame (frame); + +#ifdef HAVE_XDBE return FRAME_X_DOUBLE_BUFFERED_P (f) ? Qt : Qnil; +#else + return Qnil; +#endif } @@ -9360,7 +9371,11 @@ frame_parm_handler x_frame_parm_handlers[] = gui_set_alpha, x_set_sticky, x_set_tool_bar_position, +#ifdef HAVE_XDBE x_set_inhibit_double_buffering, +#else + NULL, +#endif x_set_undecorated, x_set_parent_frame, x_set_skip_taskbar, diff --git a/src/xftfont.c b/src/xftfont.c index e27c6cf314..31fb877c35 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -643,18 +643,23 @@ xftfont_end_for_frame (struct frame *f) return 0; } -/* When using X double buffering, the XftDraw structure we build - seems to be useless once a frame is resized, so recreate it on +/* When using X double buffering, the XRender surfaces we create seem + to become useless once the window acting as the front buffer is + resized for an unknown reason (X server bug?), so recreate it on ConfigureNotify and in some other cases. */ +#ifdef HAVE_XDBE static void xftfont_drop_xrender_surfaces (struct frame *f) { - block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) - xftfont_end_for_frame (f); - unblock_input (); + { + block_input (); + xftfont_end_for_frame (f); + unblock_input (); + } } +#endif static bool xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, @@ -741,35 +746,37 @@ static void syms_of_xftfont_for_pdumper (void); struct font_driver const xftfont_driver = { /* We can't draw a text without device dependent functions. */ - .type = LISPSYM_INITIALLY (Qxft), - .get_cache = xfont_get_cache, - .list = xftfont_list, - .match = xftfont_match, - .list_family = ftfont_list_family, - .open_font = xftfont_open, - .close_font = xftfont_close, - .prepare_face = xftfont_prepare_face, - .done_face = xftfont_done_face, - .has_char = xftfont_has_char, - .encode_char = xftfont_encode_char, - .text_extents = xftfont_text_extents, - .draw = xftfont_draw, - .get_bitmap = ftfont_get_bitmap, - .anchor_point = ftfont_anchor_point, + .type = LISPSYM_INITIALLY (Qxft), + .get_cache = xfont_get_cache, + .list = xftfont_list, + .match = xftfont_match, + .list_family = ftfont_list_family, + .open_font = xftfont_open, + .close_font = xftfont_close, + .prepare_face = xftfont_prepare_face, + .done_face = xftfont_done_face, + .has_char = xftfont_has_char, + .encode_char = xftfont_encode_char, + .text_extents = xftfont_text_extents, + .draw = xftfont_draw, + .get_bitmap = ftfont_get_bitmap, + .anchor_point = ftfont_anchor_point, #ifdef HAVE_LIBOTF - .otf_capability = ftfont_otf_capability, + .otf_capability = ftfont_otf_capability, #endif - .end_for_frame = xftfont_end_for_frame, + .end_for_frame = xftfont_end_for_frame, #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - .shape = xftfont_shape, + .shape = xftfont_shape, #endif #if defined HAVE_OTF_GET_VARIATION_GLYPHS || defined HAVE_FT_FACE_GETCHARVARIANTINDEX - .get_variation_glyphs = ftfont_variation_glyphs, + .get_variation_glyphs = ftfont_variation_glyphs, +#endif + .filter_properties = ftfont_filter_properties, + .cached_font_ok = xftfont_cached_font_ok, + .combining_capability = ftfont_combining_capability, +#ifdef HAVE_XDBE + .drop_xrender_surfaces = xftfont_drop_xrender_surfaces, #endif - .filter_properties = ftfont_filter_properties, - .cached_font_ok = xftfont_cached_font_ok, - .combining_capability = ftfont_combining_capability, - .drop_xrender_surfaces = xftfont_drop_xrender_surfaces, }; #ifdef HAVE_HARFBUZZ struct font_driver xfthbfont_driver; diff --git a/src/xterm.c b/src/xterm.c index 517869dde3..adfe90522d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3780,6 +3780,7 @@ x_flush (struct frame *f) unblock_input (); } +#ifdef HAVE_XDBE static void x_drop_xrender_surfaces (struct frame *f) { @@ -3795,6 +3796,7 @@ x_drop_xrender_surfaces (struct frame *f) } #endif } +#endif #ifdef HAVE_XRENDER void @@ -5127,9 +5129,14 @@ x_clear_window (struct frame *f) x_end_cr_clip (f); #else #ifndef USE_GTK - if (FRAME_X_DOUBLE_BUFFERED_P (f) || (f->alpha_background != 1.0)) + if (f->alpha_background != 1.0 +#ifdef HAVE_XDBE + || FRAME_X_DOUBLE_BUFFERED_P (f) #endif - x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); + ) +#endif + x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); #ifndef USE_GTK else XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); @@ -5456,13 +5463,15 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) /* Show the frame back buffer. If frame is double-buffered, atomically publish to the user's screen graphics updates made since the last call to show_back_buffer. */ + +#ifdef HAVE_XDBE static void show_back_buffer (struct frame *f) { block_input (); + if (FRAME_X_DOUBLE_BUFFERED_P (f)) { -#ifdef HAVE_XDBE #ifdef USE_CAIRO cairo_t *cr = FRAME_CR_CONTEXT (f); if (cr) @@ -5473,13 +5482,12 @@ show_back_buffer (struct frame *f) swap_info.swap_window = FRAME_X_WINDOW (f); swap_info.swap_action = XdbeCopied; XdbeSwapBuffers (FRAME_X_DISPLAY (f), &swap_info, 1); -#else - eassert (!"should have back-buffer only with XDBE"); -#endif } FRAME_X_NEED_BUFFER_FLIP (f) = false; + unblock_input (); } +#endif /* Updates back buffer and flushes changes to display. Called from minibuf read code. Note that we display the back buffer even if @@ -5488,8 +5496,10 @@ static void x_flip_and_flush (struct frame *f) { block_input (); +#ifdef HAVE_XDBE if (FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); +#endif x_flush (f); unblock_input (); } @@ -5538,8 +5548,12 @@ XTframe_up_to_date (struct frame *f) eassert (FRAME_X_P (f)); block_input (); FRAME_MOUSE_UPDATE (f); - if (!buffer_flipping_blocked_p () && FRAME_X_NEED_BUFFER_FLIP (f)) + +#ifdef HAVE_XDBE + if (!buffer_flipping_blocked_p () + && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); +#endif #ifdef HAVE_XSYNC #ifndef HAVE_GTK3 @@ -5592,12 +5606,14 @@ XTframe_up_to_date (struct frame *f) unblock_input (); } +#ifdef HAVE_XDBE static void XTbuffer_flipping_unblocked_hook (struct frame *f) { if (FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); } +#endif /** * x_clear_under_internal_border: @@ -8716,8 +8732,11 @@ x_clear_area (struct frame *f, int x, int y, int width, int height) x_end_cr_clip (f); #else #ifndef USE_GTK - if (FRAME_X_DOUBLE_BUFFERED_P (f) - || f->alpha_background != 1.0) + if (f->alpha_background != 1.0 +#ifdef HAVE_XDBE + || FRAME_X_DOUBLE_BUFFERED_P (f) +#endif + ) #endif { #if defined HAVE_XRENDER && \ @@ -13738,7 +13757,9 @@ x_net_wm_state (struct frame *f, Window window) store_frame_param (f, Qshaded, shaded ? Qt : Qnil); } -/* Flip back buffers on FRAME if it has undrawn content. */ +/* Flip back buffers on F if it has undrawn content. */ + +#ifdef HAVE_XDBE static void flush_dirty_back_buffer_on (struct frame *f) { @@ -13749,6 +13770,7 @@ flush_dirty_back_buffer_on (struct frame *f) show_back_buffer (f); unblock_input (); } +#endif #ifdef HAVE_GTK3 void @@ -14707,8 +14729,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, SET_FRAME_ICONIFIED (f, false); } +#ifdef HAVE_XDBE if (FRAME_X_DOUBLE_BUFFERED_P (f)) x_drop_xrender_surfaces (f); +#endif f->output_data.x->has_been_visible = true; SET_FRAME_GARBAGED (f); unblock_input (); @@ -14753,8 +14777,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif } +#ifdef HAVE_XDBE if (!FRAME_GARBAGED_P (f)) show_back_buffer (f); +#endif } else { @@ -14802,7 +14828,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK x_clear_under_internal_border (f); #endif +#ifdef HAVE_XDBE show_back_buffer (f); +#endif } #ifdef USE_X_TOOLKIT else @@ -16016,8 +16044,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, for size changes: that's not sufficient. We miss some surface invalidations and flicker. */ block_input (); +#ifdef HAVE_XDBE if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) x_drop_xrender_surfaces (f); +#endif unblock_input (); #if defined USE_CAIRO && !defined USE_GTK if (f) @@ -19447,11 +19477,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, redisplay. To ensure that these changes become visible, draw them here. */ +#ifdef HAVE_XDBE if (f) flush_dirty_back_buffer_on (f); if (any && any != f) flush_dirty_back_buffer_on (any); +#endif return count; } @@ -24309,7 +24341,9 @@ x_create_terminal (struct x_display_info *dpyinfo) terminal->update_end_hook = x_update_end; terminal->read_socket_hook = XTread_socket; terminal->frame_up_to_date_hook = XTframe_up_to_date; +#ifdef HAVE_XDBE terminal->buffer_flipping_unblocked_hook = XTbuffer_flipping_unblocked_hook; +#endif terminal->defined_color_hook = x_defined_color; terminal->query_frame_background_color = x_query_frame_background_color; terminal->query_colors = x_query_colors; diff --git a/src/xterm.h b/src/xterm.h index 65349834c9..80b5713798 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1025,13 +1025,15 @@ extern void x_mark_frame_dirty (struct frame *f); code after any drawing command, but we can run code whenever someone asks for the handle necessary to draw. */ #define FRAME_X_DRAWABLE(f) \ - (x_mark_frame_dirty((f)), FRAME_X_RAW_DRAWABLE ((f))) + (x_mark_frame_dirty ((f)), FRAME_X_RAW_DRAWABLE ((f))) +#ifdef HAVE_XDBE #define FRAME_X_DOUBLE_BUFFERED_P(f) \ (FRAME_X_WINDOW (f) != FRAME_X_RAW_DRAWABLE (f)) /* Return the need-buffer-flip flag for frame F. */ #define FRAME_X_NEED_BUFFER_FLIP(f) ((f)->output_data.x->need_buffer_flip) +#endif /* Return the outermost X window associated with the frame F. */ #ifdef USE_X_TOOLKIT commit 64bcfcbd322d4fdb78c7d7dd0748dabc0e0b2cbc Author: Po Lu Date: Tue May 3 08:41:38 2022 +0800 ; * src/nsterm.m (syms_of_nsterm): Fix typo in defsym. diff --git a/src/nsterm.m b/src/nsterm.m index f2bf1c1c4a..21232f55ad 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -10301,7 +10301,7 @@ Nil means use fullscreen the old (< 10.7) way. The old way works better with DEFSYM (QCmouse, ":mouse"); DEFSYM (Qcondensed, "condensed"); DEFSYM (Qreverse_italic, "reverse-italic"); - DEFSYM (Qexpanded, "reverse-italic"); + DEFSYM (Qexpanded, "expanded"); #ifdef NS_IMPL_COCOA Fprovide (Qcocoa, Qnil); commit 8ea485e157ec228b76a6ce3ad26ef99fd1e6345a Author: Eli Zaretskii Date: Mon May 2 19:16:59 2022 +0300 Fix punctuation in the Eshell manual * doc/misc/eshell.texi (Argument Predication and Modification): Fix whitespace. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index a3ed922cf2..c9c11a3869 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1194,9 +1194,9 @@ non-symlinks not owned by @code{root}, upper-cased. Some predicates and modifiers accept string parameters, such as @samp{*(u'@var{user}')}, which matches all files owned by @var{user}. These parameters must be surrounded by delimiters; you can use any of -the following pairs of delimiters: @code{" @dots{} "}, @code{' @dots{} -'}, @code{/ @dots{} /}, @code{| @dots{} |}, @code{( @dots{} )}, -@code{[ @dots{} ]}, @code{< @dots{} >}, or @code{@{ @dots{} @}}. +the following pairs of delimiters: @code{"@dots{}"}, @code{'@dots{}'}, +@code{/@dots{}/}, @code{|@dots{}|}, @code{(@dots{})}, +@code{[@dots{}]}, @code{<@dots{}>}, or @code{@{@dots{}@}}. You can customize the syntax and behavior of predicates and modifiers in Eshell via the Customize group ``eshell-pred'' (@pxref{Easy commit 61d6607174fc34ca5698da0af0acae235ef109de Author: Eli Zaretskii Date: Mon May 2 19:06:45 2022 +0300 ; * etc/NEWS: Improve wording of "M-x scratch-buffer" entry. diff --git a/etc/NEWS b/etc/NEWS index 25a976db58..f897158afd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -711,8 +711,9 @@ script that was used in ancient South Asia. A new input method, +++ *** New command 'scratch-buffer'. -This switches to the *scratch* buffer. If it doesn't exist, create it -first. +This command switches to the *scratch* buffer. If *scratch* doesn't +exist, the command creates it first. You can use this command if you +inadvertently delete the *scratch* buffer. ** Debugging commit 1477d12882ddf9bfec2beebae722b5680f5e6032 Author: Eli Zaretskii Date: Mon May 2 18:57:15 2022 +0300 ; Fix typo and wording of a doc string * lisp/textmodes/reftex-parse.el (reftex-using-biblatex-p): Fix typo and wording of the doc string. diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index bae455dd4d..49cef29788 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -371,9 +371,9 @@ of master file." (defun reftex-using-biblatex-p () "Return non-nil if we are using biblatex or other specific cite package. -biblatex and other packages like multibib allow multiple macro -calls to load a bibliography file. This packages should be -detected by this function." +biblatex and other similar packages like multibib allow multiple macro +calls to load a bibliography file. This function should be able to +detect those packages." (if (boundp 'TeX-active-styles) ;; the sophisticated AUCTeX way (or (member "biblatex" TeX-active-styles) commit 7f81470250589dd0ca4b024a315c0103fce9bf84 Author: Arash Esbati Date: Mon May 2 14:31:19 2022 +0200 Load multiple bibliographies with multibib package * lisp/textmodes/reftex-parse.el (reftex-using-biblatex-p): Recognize 'multibib' which allows multiple bibliography loading macro calls. (reftex-locate-bibliography-files): Prevent possible duplications in bibliography database files. diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 016c9cf399..bae455dd4d 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -370,13 +370,18 @@ of master file." docstruct)) (defun reftex-using-biblatex-p () - "Return non-nil if we are using biblatex rather than bibtex." + "Return non-nil if we are using biblatex or other specific cite package. +biblatex and other packages like multibib allow multiple macro +calls to load a bibliography file. This packages should be +detected by this function." (if (boundp 'TeX-active-styles) ;; the sophisticated AUCTeX way - (member "biblatex" TeX-active-styles) + (or (member "biblatex" TeX-active-styles) + (member "multibib" TeX-active-styles)) ;; poor-man's check... (save-excursion - (re-search-forward "^[^%\n]*?\\\\usepackage.*{biblatex}" nil t)))) + (re-search-forward + "^[^%\n]*?\\\\usepackage\\(\\[[^]]*\\]\\)?{biblatex\\|multibib}" nil t)))) ;;;###autoload (defun reftex-locate-bibliography-files (master-dir &optional files) @@ -384,7 +389,7 @@ of master file." (unless files (save-excursion (goto-char (point-min)) - ;; when biblatex is used, multiple \bibliography or + ;; when biblatex or multibib are used, multiple \bibliography or ;; \addbibresource macros are allowed. With plain bibtex, only ;; the first is used. (let ((using-biblatex (reftex-using-biblatex-p)) @@ -392,7 +397,7 @@ of master file." (while (and again (re-search-forward (concat - ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\(" + ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\(" "\\(^\\)[^%\n\r]*\\\\\\(" (mapconcat #'identity reftex-bibliography-commands "\\|") "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)") @@ -415,7 +420,7 @@ of master file." ;; find the file (reftex-locate-file x "bib" master-dir))) files)) - (delq nil files))) + (delq nil (delete-dups files)))) (defun reftex-replace-label-list-segment (old insert &optional entirely) "Replace the segment in OLD which corresponds to INSERT. commit 7bf17ceee8c2d347917541e143ce25609e90ebbb Author: Po Lu Date: Mon May 2 20:16:53 2022 +0800 Wait for events from all displays in Xm dialogs even on XI2 * src/xfns.c (Fx_file_dialog): Always process events from all displays. diff --git a/src/xfns.c b/src/xfns.c index 27bca5523c..7176d62609 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -8787,25 +8787,11 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, while (result == 0) { XEvent event, copy; -#ifdef HAVE_XINPUT2 - x_menu_wait_for_event (FRAME_X_DISPLAY (f)); -#else x_menu_wait_for_event (0); -#endif - if ( -#ifndef HAVE_XINPUT2 - XtAppPending (Xt_app_con) -#else - XPending (FRAME_X_DISPLAY (f)) -#endif - ) + if (XtAppPending (Xt_app_con)) { -#ifndef HAVE_XINPUT2 XtAppNextEvent (Xt_app_con, &event); -#else - XNextEvent (FRAME_X_DISPLAY (f), &event); -#endif copy = event; if (event.type == KeyPress commit bcdcaf0219906862d02f1e6ab83972c8f4d3c0ba Author: Lars Ingebrigtsen Date: Mon May 2 13:59:11 2022 +0200 Make the eval-in-debug error message prettier in non-recursive errors * lisp/emacs-lisp/debug.el (debugger-eval-expression): Make the error message (when recursive debugging is off) prettier. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 91e9b0716d..6c172d6c31 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -539,17 +539,23 @@ The environment used is the one when entering the activation frame at point." (error 0)))) ;; If on first line. (base (debugger--backtrace-base))) (debugger-env-macro - (let ((val (if debug-allow-recursive-debug - (backtrace-eval exp nframe base) - (condition-case err - (backtrace-eval exp nframe base) - (error (format "%s: %s" - (get (car err) 'error-message) - (car (cdr err)))))))) - (prog1 - (debugger--print val t) - (let ((str (eval-expression-print-format val))) - (if str (princ str t)))))))) + (let* ((errored nil) + (val (if debug-allow-recursive-debug + (backtrace-eval exp nframe base) + (condition-case err + (backtrace-eval exp nframe base) + (error (setq errored + (format "%s: %s" + (get (car err) 'error-message) + (car (cdr err))))))))) + (if errored + (progn + (message "Error: %s" errored) + nil) + (prog1 + (debugger--print val t) + (let ((str (eval-expression-print-format val))) + (if str (princ str t))))))))) (define-obsolete-function-alias 'debugger-toggle-locals 'backtrace-toggle-locals "28.1") commit f639fa9f9e2acfe9d02e2afc57f7a2cc96390f5f Author: Lars Ingebrigtsen Date: Mon May 2 13:55:56 2022 +0200 Make non-recursive error messages in edebug prettier * lisp/emacs-lisp/edebug.el (edebug-eval-expression): Make the error message (when recursive debugging is off) prettier. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 85545f9f35..d8b0a13c30 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3712,14 +3712,25 @@ Return the result of the last expression." If interactive, prompt for the expression. Print result in minibuffer." (interactive (list (read--expression "Eval: "))) - (princ - (edebug-outside-excursion - (let ((result (if debug-allow-recursive-debug - (edebug-eval expr) - (edebug-safe-eval expr)))) - (values--store-value result) - (concat (edebug-safe-prin1-to-string result) - (eval-expression-print-format result)))))) + (let* ((errored nil) + (result + (edebug-outside-excursion + (let ((result (if debug-allow-recursive-debug + (edebug-eval expr) + (condition-case err + (edebug-eval expr) + (error + (setq errored + (format "%s: %s" + (get (car err) 'error-message) + (car (cdr err))))))))) + (unless errored + (values--store-value result) + (concat (edebug-safe-prin1-to-string result) + (eval-expression-print-format result))))))) + (if errored + (message "Error: %s" errored) + (princ result)))) (defun edebug-eval-last-sexp (&optional no-truncate) "Evaluate sexp before point in the outside environment. commit ee913faf9a5d266be41b33556c90b26f55d18013 Author: Lars Ingebrigtsen Date: Mon May 2 12:30:19 2022 +0200 Fix eldoc interaction with `when' and `unless' * lisp/subr.el (when, unless): Remove the (fn...) bits from the doc string, because the advertised calling convention is correct the way it is (bug#27229). This also makes eldoc highlight the arguments correctly. diff --git a/lisp/subr.el b/lisp/subr.el index ad3494a2fa..cb7572423a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -243,18 +243,14 @@ change the list." (defmacro when (cond &rest body) "If COND yields non-nil, do BODY, else return nil. When COND yields non-nil, eval BODY forms sequentially and return -value of last one, or nil if there are none. - -\(fn COND BODY...)" +value of last one, or nil if there are none." (declare (indent 1) (debug t)) (list 'if cond (cons 'progn body))) (defmacro unless (cond &rest body) "If COND yields nil, do BODY, else return nil. When COND yields nil, eval BODY forms sequentially and return -value of last one, or nil if there are none. - -\(fn COND BODY...)" +value of last one, or nil if there are none." (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) commit 10f347a06286272c7dcfdeb47b3511b6f53adcbd Author: Lars Ingebrigtsen Date: Mon May 2 12:26:31 2022 +0200 Add a command to recreate the *scratch* buffer * doc/emacs/building.texi (Lisp Interaction): Mention it. * lisp/simple.el (scratch-buffer): New command. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 5bf4c8c739..994ad46033 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1742,6 +1742,10 @@ which is provided for evaluating Emacs Lisp expressions interactively. Its major mode is Lisp Interaction mode. You can also enable Lisp Interaction mode by typing @kbd{M-x lisp-interaction-mode}. +@findex scratch-buffer + If you kill the @file{*scratch*} buffer, you can recreate it with +the @kbd{M-x scratch-buffer} command. + @findex eval-print-last-sexp @kindex C-j @r{(Lisp Interaction mode)} In the @file{*scratch*} buffer, and other Lisp Interaction mode diff --git a/etc/NEWS b/etc/NEWS index 5e7baab109..25a976db58 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -707,6 +707,13 @@ script that was used in ancient South Asia. A new input method, * Changes in Specialized Modes and Packages in Emacs 29.1 +** Miscellaneous + ++++ +*** New command 'scratch-buffer'. +This switches to the *scratch* buffer. If it doesn't exist, create it +first. + ** Debugging *** New user option 'debug-allow-recursive-debug'. diff --git a/lisp/simple.el b/lisp/simple.el index d638e641c3..861d9eefde 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10213,6 +10213,17 @@ This is an integer indicating the UTC offset in seconds, i.e., the number of seconds east of Greenwich.") ) +(defun scratch-buffer () + "Switch to the \*scratch\* buffer. +If the buffer doesn't exist, create it first." + (interactive) + (if (get-buffer "*scratch*") + (pop-to-buffer-same-window "*scratch*") + (pop-to-buffer-same-window (get-buffer-create "*scratch*")) + (when initial-scratch-message + (insert initial-scratch-message)) + (funcall initial-major-mode))) + (provide 'simple) commit 2fba71cf1fadc9d681e6be250d152cc156bf6a00 Author: Stefan Kangas Date: Mon May 2 12:03:08 2022 +0200 Fix handling double-click-time nil or t * lisp/mouse.el (mouse-double-click-time): New function to always return a number for `double-click-time'. * lisp/emulation/viper-mous.el (viper-multiclick-timeout): * lisp/foldout.el (foldout-mouse-swallow-events): * lisp/help.el (help--read-key-sequence): * lisp/org/org-mouse.el (org-mouse-show-context-menu): Use 'mouse-double-click-time' instead of 'double-click-time'. * src/keyboard.c (syms_of_keyboard): Mention 'mouse-double-click-time' in doc string of 'double-click-time'. * test/lisp/mouse-tests.el (mouse-test-mouse-double-click-time): New test. diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 7581ece214..1a90cab767 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -62,8 +62,8 @@ or a triple-click." ;; time interval in millisecond within which successive clicks are ;; considered related (defcustom viper-multiclick-timeout (if (viper-window-display-p) - double-click-time - 500) + (mouse-double-click-time) + 500) "Time interval in milliseconds for mouse clicks to be considered related." :type 'integer) diff --git a/lisp/foldout.el b/lisp/foldout.el index 4b192a7b6a..e00fb40e3c 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -473,7 +473,7 @@ What happens depends on the number of mouse clicks:- "Swallow intervening mouse events so we only get the final click-count. Signal an error if the final event isn't the same type as the first one." (let ((initial-event-type (event-basic-type event))) - (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) + (while (null (sit-for (/ (mouse-double-click-time) 1000.0) 'nodisplay)) (setq event (read--potential-mouse-event))) (or (eq initial-event-type (event-basic-type event)) (error ""))) diff --git a/lisp/help.el b/lisp/help.el index fe999de638..3c0370fee1 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -867,7 +867,7 @@ with `mouse-movement' events." (memq 'down last-modifiers) ;; After a click, see if a double click is on the way. (and (memq 'click last-modifiers) - (not (sit-for (/ double-click-time 1000.0) t)))) + (not (sit-for (/ (mouse-double-click-time) 1000.0) t)))) (let* ((seq (read-key-sequence "\ Describe the following key, mouse click, or menu item: " nil nil 'can-return-switch-frame)) diff --git a/lisp/mouse.el b/lisp/mouse.el index c08ecaf334..0446bc6dd8 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -167,6 +167,17 @@ Expects to be bound to `(double-)mouse-1' in `key-translation-map'." (define-key key-translation-map [double-mouse-1] #'mouse--click-1-maybe-follows-link) +(defun mouse-double-click-time () + "Return a number for `double-click-time'. +In contrast to using the `double-click-time' variable directly, +which could be set to nil or t, this function is guaranteed to +always return a positive integer or zero." + (let ((ct double-click-time)) + (cond ((eq ct t) 10000) ; arbitrary number useful for sit-for + ((eq ct nil) 0) + ((and (numberp ct) (> ct 0)) ct) + (t 0)))) + ;; Provide a mode-specific menu on a mouse button. diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 20c20acc32..a590ff87f2 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -208,7 +208,7 @@ this function is called. Otherwise, the current major mode menu is used." (interactive "@e \nP") (if (and (= (event-click-count event) 1) (or (not mark-active) - (sit-for (/ double-click-time 1000.0)))) + (sit-for (/ (mouse-double-click-time) 1000.0)))) (progn (select-window (posn-window (event-start event))) (when (not (org-mouse-mark-active)) diff --git a/src/keyboard.c b/src/keyboard.c index 69e741070c..70908120cb 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12434,7 +12434,10 @@ Polling is automatically disabled in all other cases. */); doc: /* Maximum time between mouse clicks to make a double-click. Measured in milliseconds. The value nil means disable double-click recognition; t means double-clicks have no time limit and are detected -by position only. */); +by position only. + +In Lisp, you might want to use `mouse-double-click-time' instead of +reading the value of this variable directly. */); Vdouble_click_time = make_fixnum (500); DEFVAR_INT ("double-click-fuzz", double_click_fuzz, diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el index 1be32006a1..03ecbc1985 100644 --- a/test/lisp/mouse-tests.el +++ b/test/lisp/mouse-tests.el @@ -25,6 +25,20 @@ ;;; Code: +(ert-deftest mouse-test-mouse-double-click-time () + (let ((double-click-time 500)) + (should (= (mouse-double-click-time) 500))) + (let ((double-click-time 0)) + (should (= (mouse-double-click-time) 0))) + (let ((double-click-time -500)) + (should (= (mouse-double-click-time) 0))) + (let ((double-click-time nil)) + (should (= (mouse-double-click-time) 0))) + (let ((double-click-time t)) + (should (numberp (mouse-double-click-time)))) + (let ((double-click-time '(invalid))) + (should (= (mouse-double-click-time) 0)))) + (ert-deftest bug23288-use-return-value () "If `mouse-on-link-p' returns a string, its first character is used." (cl-letf ((unread-command-events '((down-mouse-1 nil 1) (mouse-1 nil 1))) commit f7a6dd4fcc54230630fcba73ca6bda2a413eff24 Author: Lars Ingebrigtsen Date: Mon May 2 11:37:35 2022 +0200 Re-fix Gcc header tokenization in Gnus * lisp/gnus/gnus-msg.el (gnus-inews-do-gcc): Split the Gcc header on commas, but allow group names to contain spaces (bug#55217). diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index f6ae028a10..17a87134be 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1571,8 +1571,9 @@ this is a reply." (when gcc (message-remove-header "gcc") (widen) - (setq groups (message-unquote-tokens - (message-tokenize-header gcc ",\n\t"))) + (setq groups (mapcar #'string-trim + (message-unquote-tokens + (message-tokenize-header gcc)))) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (setq method (gnus-inews-group-method group)) commit 97badaab7969ed5a306d6bcd320eb3d592a7f4ae Author: Lars Ingebrigtsen Date: Mon May 2 11:30:43 2022 +0200 Allow reusing the *Help* window with `i'/`s/ commands * doc/emacs/help.texi (Help): Document it. * lisp/help-mode.el (help-function-def--button-function): Use it. * lisp/help-mode.el (help-goto-info): Use it. * lisp/help.el (help-window-select): Mention it. (help-window-keep-selected): New user option (bug#9054). * lisp/info-look.el (info-lookup-symbol): (info-lookup): Allow keeping the same window. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 3c8f90da10..11ee9dc2b2 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -34,6 +34,14 @@ is unconditionally selected by help commands, and if its value is @code{other}, the help window is selected only if there are more than two windows on the selected frame. +@vindex help-window-keep-selected + Conversely, many commands in the @samp{*Help*} buffer will pop up a +new window to display the results. For instance, clicking on the link +to show the source code, or using the @key{i} command to display the +manual entry, will (by default) pop up a new window. If +@code{help-window-keep-selected} is changed to non-@code{nil}, the +window displaying the @samp{*Help*} buffer will be reused instead. + @cindex searching documentation efficiently @cindex looking for a subject in documentation If you are looking for a certain feature, but don't know what it is diff --git a/etc/NEWS b/etc/NEWS index 882748d8c7..5e7baab109 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -443,6 +443,11 @@ command also works for non-Emoji characters.) ** Help ++++ +*** New user option 'help-window-keep-selected'. +If non-nil, commands to show the info manual and the source will reuse +the same window the *Help* buffer is shown in. + --- *** Commands like 'C-h f' have changed how they describe menu bindings. For instance, previously a command might be described as having the diff --git a/lisp/help-mode.el b/lisp/help-mode.el index cb87035281..c725c0f1a1 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -268,7 +268,9 @@ The format is (FUNCTION ARGS...).") (let* ((location (find-function-search-for-symbol fun type file)) (position (cdr location))) - (pop-to-buffer (car location)) + (if help-window-keep-selected + (pop-to-buffer-same-window (car location)) + (pop-to-buffer (car location))) (run-hooks 'find-function-after-hook) (if position (progn @@ -819,7 +821,8 @@ The help buffers are divided into \"pages\" by the ^L character." (unless help-mode--current-data (error "No symbol to look up in the current buffer")) (info-lookup-symbol (plist-get help-mode--current-data :symbol) - 'emacs-lisp-mode)) + 'emacs-lisp-mode + help-window-keep-selected)) (defun help-goto-lispref-info () "View the Emacs Lisp manual *info* node of the current help item." diff --git a/lisp/help.el b/lisp/help.el index 2d08ceb86c..fe999de638 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1802,13 +1802,25 @@ the help window appears on another frame, it may get selected and its frame get input focus even if this option is nil. This option has effect if and only if the help window was created -by `with-help-window'." +by `with-help-window'. + +Also see `help-window-keep-selected'." :type '(choice (const :tag "never (nil)" nil) (const :tag "other" other) (const :tag "always (t)" t)) :group 'help :version "23.1") +(defcustom help-window-keep-selected nil + "If non-nil, navigation commands in the *Help* buffer will reuse the window. +If nil, many commands in the *Help* buffer, like \\\\[help-view-source] and \\[help-goto-info], will +pop to a different window to display the results. + +Also see `help-window-select'." + :type 'boolean + :group 'help + :version "29.1") + (define-obsolete-variable-alias 'help-enable-auto-load 'help-enable-autoload "27.1") diff --git a/lisp/info-look.el b/lisp/info-look.el index aa07c3f5e7..6c8ef091a0 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -280,7 +280,7 @@ system." ;;;###autoload (put 'info-lookup-symbol 'info-file "emacs") ;;;###autoload -(defun info-lookup-symbol (symbol &optional mode) +(defun info-lookup-symbol (symbol &optional mode same-window) "Look up and display documentation of SYMBOL in the relevant Info manual. SYMBOL should be an identifier: a function or method, a macro, a variable, a data type, a class, etc. @@ -293,10 +293,13 @@ MODE is the major mode whose Info manuals to search for the documentation of SYMBOL. It defaults to the current buffer's `major-mode'; if that mode doesn't have any Info manuals known to Emacs, the command will prompt for MODE to use, with completion. With prefix arg, the command -always prompts for MODE." +always prompts for MODE. + +Is SAME-WINDOW, try to reuse the current window instead of +popping up a new one." (interactive (info-lookup-interactive-arguments 'symbol current-prefix-arg)) - (info-lookup 'symbol symbol mode)) + (info-lookup 'symbol symbol mode same-window)) ;;;###autoload (put 'info-lookup-file 'info-file "emacs") ;;;###autoload @@ -388,7 +391,7 @@ If optional argument QUERY is non-nil, query for the help mode." spec mode))) -(defun info-lookup (topic item mode) +(defun info-lookup (topic item mode &optional same-window) "Display the documentation of TOPIC whose name is ITEM, using MODE's manuals. TOPIC should be any known symbol of a help topic type, such as `file' or `symbol'. See the documentation of HELP-TOPIC in the doc @@ -397,7 +400,10 @@ ITEM is the item whose documentation to search: file name if TOPIC is `file', a symbol if TOPIC is `symbol', etc. MODE is the `major-mode' whose Info manuals to search for documentation of ITEM; if it's nil, the function uses `info-lookup-file-name-alist' -and the current buffer's file name to guess the mode.." +and the current buffer's file name to guess the mode. + +If SAME-WINDOW, reuse the current window. If nil, pop to a +different window." (or mode (setq mode (info-lookup-select-mode))) (setq mode (info-lookup--item-to-mode item mode)) (if-let ((info (info-lookup->mode-value topic mode))) @@ -423,19 +429,21 @@ and the current buffer's file name to guess the mode.." (if (not info-lookup-other-window-flag) (info) (save-window-excursion (info)) - (let* ((info-window (get-buffer-window "*info*" t)) - (info-frame (and info-window (window-frame info-window)))) - (if (and info-frame - (not (eq info-frame (selected-frame))) - (display-multi-frame-p) - (memq info-frame (frames-on-display-list))) - ;; *info* is visible in another frame on same display. - ;; Raise that frame and select the window. - (progn - (select-window info-window) - (raise-frame info-frame)) - ;; In any other case, switch to *info* in another window. - (switch-to-buffer-other-window "*info*"))))) + (if same-window + (pop-to-buffer-same-window "*info*") + (let* ((info-window (get-buffer-window "*info*" t)) + (info-frame (and info-window (window-frame info-window)))) + (if (and info-frame + (not (eq info-frame (selected-frame))) + (display-multi-frame-p) + (memq info-frame (frames-on-display-list))) + ;; *info* is visible in another frame on same display. + ;; Raise that frame and select the window. + (progn + (select-window info-window) + (raise-frame info-frame)) + ;; In any other case, switch to *info* another window. + (switch-to-buffer-other-window "*info*")))))) (while (and (not found) modes) (setq doc-spec (info-lookup->doc-spec topic (car modes))) (while (and (not found) doc-spec) commit 38945225596708a60d332d1f95dc9618e3d974b1 Author: Po Lu Date: Mon May 2 09:05:12 2022 +0000 Fix inconsistencies in Haiku font selection dialog * src/haiku_font_support.cc (font_family_style_matches_p): Fix coding style. * src/haikufont.c (haikufont_pattern_from_object): Set slant and width using correct object. diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index 1156f0bced..cc4eba5c29 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -494,8 +494,8 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, strcmp ((char *) &pattern->family, family)) return false; - if (!ignore_flags_p && (pattern->specified & FSPEC_SPACING) && - !(pattern->mono_spacing_p) != !(flags & B_IS_FIXED)) + if (!ignore_flags_p && (pattern->specified & FSPEC_SPACING) + && !(pattern->mono_spacing_p) != !(flags & B_IS_FIXED)) return false; if (pattern->specified & FSPEC_STYLE) @@ -508,7 +508,8 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, if ((pattern->specified & FSPEC_SLANT) && (pattern->slant - != ((m.specified & FSPEC_SLANT) ? m.slant : SLANT_REGULAR))) + != (m.specified & FSPEC_SLANT + ? m.slant : SLANT_REGULAR))) return false; if ((pattern->specified & FSPEC_WANTED) @@ -516,8 +517,9 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, return false; if ((pattern->specified & FSPEC_WIDTH) - && (pattern->width != - ((m.specified & FSPEC_WIDTH) ? m.width : NORMAL_WIDTH))) + && (pattern->width + != (m.specified & FSPEC_WIDTH + ? m.width : NORMAL_WIDTH))) return false; if ((pattern->specified & FSPEC_NEED_ONE_OF) diff --git a/src/haikufont.c b/src/haikufont.c index db2ba326e0..cf7cc83085 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -460,14 +460,14 @@ haikufont_pattern_from_object (struct haiku_font_pattern *pattern, if (!NILP (val) && !EQ (val, Qunspecified)) { pattern->specified |= FSPEC_SLANT; - pattern->slant = haikufont_lisp_to_slant (font_object); + pattern->slant = haikufont_lisp_to_slant (val); } val = FONT_WIDTH_FOR_FACE (font_object); if (!NILP (val) && !EQ (val, Qunspecified)) { pattern->specified |= FSPEC_WIDTH; - pattern->width = haikufont_lisp_to_width (font_object); + pattern->width = haikufont_lisp_to_width (val); } } commit 95507dd4038ea9c704c155c81759f3fc0c568717 Author: Lars Ingebrigtsen Date: Mon May 2 11:02:01 2022 +0200 Allow show-paren to show matching parentheses inside comments * lisp/paren.el (show-paren--default): Improve blinking when inside a comment (bug#5410). diff --git a/lisp/paren.el b/lisp/paren.el index 4e67a4ea4f..4c268dbf77 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -225,6 +225,13 @@ It is the default value of `show-paren-data-function'." (let* ((temp (show-paren--locate-near-paren)) (dir (car temp)) (outside (cdr temp)) + ;; If we're inside a comment, then we probably want to blink + ;; a matching parentheses in the comment. So don't ignore + ;; comments in that case. + (parse-sexp-ignore-comments + (if (ppss-comment-depth (syntax-ppss)) + nil + parse-sexp-ignore-comments)) pos mismatch here-beg here-end) ;; ;; Find the other end of the sexp. commit f70dfb74ccab4adaf98f6436444b94162104076f Author: Po Lu Date: Mon May 2 08:46:04 2022 +0000 Fix handling of some weights in the Haiku font driver * src/haiku_font_support.cc (font_style_to_flags): * src/haiku_support.h (enum haiku_font_weight): * src/haikufont.c (haikufont_weight_to_lisp) (haikufont_lisp_to_weight): Make `ultralight' and `extralight' mean the same thing. diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index de55ad2001..1156f0bced 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -305,9 +305,8 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) { if (token && !strcmp (token, "Thin")) pattern->weight = HAIKU_THIN; - else if (token && !strcmp (token, "UltraLight")) - pattern->weight = HAIKU_ULTRALIGHT; - else if (token && !strcmp (token, "ExtraLight")) + else if (token && (!strcmp (token, "UltraLight") + || !strcmp (token, "ExtraLight"))) pattern->weight = HAIKU_EXTRALIGHT; else if (token && !strcmp (token, "Light")) pattern->weight = HAIKU_LIGHT; @@ -330,12 +329,11 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) pattern->weight = HAIKU_SEMI_BOLD; else if (token && !strcmp (token, "Bold")) pattern->weight = HAIKU_BOLD; - else if (token && (!strcmp (token, "ExtraBold") || + else if (token && (!strcmp (token, "ExtraBold") /* This has actually been seen in the wild. */ - !strcmp (token, "Extrabold"))) + || !strcmp (token, "Extrabold") + || !strcmp (token, "UltraBold"))) pattern->weight = HAIKU_EXTRA_BOLD; - else if (token && !strcmp (token, "UltraBold")) - pattern->weight = HAIKU_ULTRA_BOLD; else if (token && !strcmp (token, "Book")) pattern->weight = HAIKU_BOOK; else if (token && !strcmp (token, "Heavy")) diff --git a/src/haiku_support.h b/src/haiku_support.h index efce63b478..056063864e 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -290,7 +290,6 @@ enum haiku_font_weight { NO_WEIGHT = -1, HAIKU_THIN = 0, - HAIKU_ULTRALIGHT = 20, HAIKU_EXTRALIGHT = 40, HAIKU_LIGHT = 50, HAIKU_SEMI_LIGHT = 75, @@ -298,7 +297,6 @@ enum haiku_font_weight HAIKU_SEMI_BOLD = 180, HAIKU_BOLD = 200, HAIKU_EXTRA_BOLD = 205, - HAIKU_ULTRA_BOLD = 210, HAIKU_BOOK = 400, HAIKU_HEAVY = 800, HAIKU_ULTRA_HEAVY = 900, diff --git a/src/haikufont.c b/src/haikufont.c index 3607012f6c..db2ba326e0 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -208,8 +208,6 @@ haikufont_weight_to_lisp (int weight) { case HAIKU_THIN: return Qthin; - case HAIKU_ULTRALIGHT: - return Qultra_light; case HAIKU_EXTRALIGHT: return Qextra_light; case HAIKU_LIGHT: @@ -224,8 +222,6 @@ haikufont_weight_to_lisp (int weight) return Qbold; case HAIKU_EXTRA_BOLD: return Qextra_bold; - case HAIKU_ULTRA_BOLD: - return Qultra_bold; case HAIKU_BOOK: return Qbook; case HAIKU_HEAVY: @@ -246,7 +242,7 @@ haikufont_lisp_to_weight (Lisp_Object weight) if (EQ (weight, Qthin)) return HAIKU_THIN; if (EQ (weight, Qultra_light)) - return HAIKU_ULTRALIGHT; + return HAIKU_EXTRALIGHT; if (EQ (weight, Qextra_light)) return HAIKU_EXTRALIGHT; if (EQ (weight, Qlight)) @@ -262,7 +258,7 @@ haikufont_lisp_to_weight (Lisp_Object weight) if (EQ (weight, Qextra_bold)) return HAIKU_EXTRA_BOLD; if (EQ (weight, Qultra_bold)) - return HAIKU_ULTRA_BOLD; + return HAIKU_EXTRA_BOLD; if (EQ (weight, Qbook)) return HAIKU_BOOK; if (EQ (weight, Qheavy)) commit 44243af8f26f25867c85641d2f101a347a18df1b Author: Lars Ingebrigtsen Date: Mon May 2 10:01:55 2022 +0200 Use xref-goto-xref as the xref mouse binding * lisp/progmodes/xref.el (xref--button-map): Keep the xref-goto-xref binding instead of select-and-show to be more similar to grep buffers. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b379448cdb..6e763eef01 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -966,7 +966,7 @@ beginning of the line." (defvar xref--button-map (let ((map (make-sparse-keymap))) (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] #'xref-select-and-show-xref) + (define-key map [mouse-2] #'xref-goto-xref) map)) (defun xref-select-and-show-xref (event) commit e280df0e3412904cfb2e582487da089928470136 Author: Lars Ingebrigtsen Date: Mon May 2 09:56:49 2022 +0200 Fix the OMIT-NULLS + "" case in string-lines * lisp/subr.el (string-lines): Respect OMIT-NULLS when given an empty string. diff --git a/lisp/subr.el b/lisp/subr.el index aded02c4f7..ad3494a2fa 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6748,7 +6748,9 @@ If OMIT-NULLS, empty lines will be removed from the results. If KEEP-NEWLINES, don't strip trailing newlines from the result lines." (if (equal string "") - (list "") + (if omit-nulls + nil + (list "")) (let ((lines nil) (start 0)) (while (< start (length string)) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index f4676793ff..62cf2266d6 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1030,6 +1030,7 @@ final or penultimate step during initialization.")) (ert-deftest test-string-lines () (should (equal (string-lines "") '(""))) + (should (equal (string-lines "" t) '())) (should (equal (string-lines "foo") '("foo"))) (should (equal (string-lines "foo\n") '("foo"))) commit a6a4f1d6d16bfc4d33c09d6d5a8038786d8e1325 Author: Po Lu Date: Mon May 2 15:06:58 2022 +0800 Improve font dialog on macOS * src/nsterm.m ([EmacsView changeFont:]): Don't exit loop here on macOS. ([EmacsView noteUserSelectedFont]): New function. ([EmacsView showFontPanel]): Add explicit "OK" button on macOS. diff --git a/src/nsterm.m b/src/nsterm.m index f9d46c73d7..f2bf1c1c4a 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6170,9 +6170,19 @@ - (void) changeFont: (id) sender if (font_panel_result) [font_panel_result retain]; +#ifndef NS_IMPL_COCOA + font_panel_active = NO; + [NSApp stop: self]; +#endif +} + +#ifdef NS_IMPL_COCOA +- (void) noteUserSelectedFont +{ font_panel_active = NO; [NSApp stop: self]; } +#endif - (Lisp_Object) showFontPanel { @@ -6180,6 +6190,10 @@ - (Lisp_Object) showFontPanel struct font *font = FRAME_OUTPUT_DATA (emacsframe)->font; NSFont *nsfont, *result; struct timespec timeout; +#ifdef NS_IMPL_COCOA + NSButton *button; + BOOL canceled; +#endif #ifdef NS_IMPL_GNUSTEP nsfont = ((struct nsfont_info *) font)->nsfont; @@ -6187,6 +6201,21 @@ - (Lisp_Object) showFontPanel nsfont = (NSFont *) macfont_get_nsctfont (font); #endif +#ifdef NS_IMPL_COCOA + /* FIXME: this button could be made a lot prettier, but I don't know + how. */ + button = [[NSButton alloc] initWithFrame: NSMakeRect (0, 0, 192, 40)]; + [button setTitle: @"OK"]; + [button setTarget: self]; + [button setAction: @selector (noteUserSelectedFont)]; + [button setButtonType: NSButtonTypeMomentaryPushIn]; + [button setHidden: NO]; + + [[fm fontPanel: YES] setAccessoryView: button]; + [button release]; + [[fm fontPanel: YES] setDefaultButtonCell: [button cell]]; +#endif + [fm setSelectedFont: nsfont isMultiple: NO]; [fm orderFrontFontPanel: NSApp]; @@ -6195,13 +6224,23 @@ - (Lisp_Object) showFontPanel block_input (); while (font_panel_active - && [[fm fontPanel: YES] isVisible]) +#ifdef NS_IMPL_COCOA + && (canceled = [[fm fontPanel: YES] isVisible]) +#else + && [[fm fontPanel: YES] isVisible] +#endif + ) ns_select_1 (0, NULL, NULL, NULL, &timeout, NULL, YES); unblock_input (); if (font_panel_result) [font_panel_result autorelease]; +#ifdef NS_IMPL_COCOA + if (!canceled) + font_panel_result = nil; +#endif + result = font_panel_result; font_panel_result = nil; commit 3ea1a6672b1cc8c7ea505585e8687500014e524b Author: Po Lu Date: Mon May 2 05:48:48 2022 +0000 Default to currently selected font in Haiku font dialogs * src/haiku_font_support.cc (be_find_font_indices): New function. * src/haiku_support.cc (class EmacsFontSelectionDialog) (UpdateStylesForIndex, EmacsFontSelectionDialog): Allow specifying an initial font family and style. (be_select_font): New parameters `initial_family' and `initial_style'. * src/haiku_support.h: Update prototypes. * src/haikufont.c (haikufont_lisp_to_weight) (haikufont_lisp_to_slant, haikufont_lisp_to_width): Handle `regular'. (haikufont_pattern_from_object): New function. (haikufont_spec_or_entity_to_pattern): Fix coding style. (Fx_select_font): Compute indices based on currently selected font. (syms_of_haikufont): New defsyms. diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index 95a0db8ae6..de55ad2001 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -815,3 +815,38 @@ be_font_style_to_flags (char *style, struct haiku_font_pattern *pattern) font_style_to_flags (style, pattern); } + +int +be_find_font_indices (struct haiku_font_pattern *pattern, + int *family_index, int *style_index) +{ + int32 i, j, n_families, n_styles; + font_family family; + font_style style; + uint32 flags; + + n_families = count_font_families (); + + for (i = 0; i < n_families; ++i) + { + if (get_font_family (i, &family, &flags) == B_OK) + { + n_styles = count_font_styles (family); + + for (j = 0; j < n_styles; ++j) + { + if (get_font_style (family, j, &style, &flags) == B_OK + && font_family_style_matches_p (family, style, + flags, pattern)) + { + *family_index = i; + *style_index = j; + + return 0; + } + } + } + } + + return 1; +} diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 9e31e1b870..12934faa1c 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2448,6 +2448,7 @@ class EmacsFontSelectionDialog : public BWindow BTextControl size_entry; port_id comm_port; bool allow_monospace_only; + int pending_selection_idx; void UpdateStylesForIndex (int idx) @@ -2479,6 +2480,13 @@ class EmacsFontSelectionDialog : public BWindow } } + if (pending_selection_idx >= 0) + { + font_style_pane.Select (pending_selection_idx); + font_style_pane.ScrollToSelection (); + } + + pending_selection_idx = -1; UpdateForSelectedStyle (); } @@ -2559,7 +2567,9 @@ class EmacsFontSelectionDialog : public BWindow delete_port (comm_port); } - EmacsFontSelectionDialog (bool monospace_only) + EmacsFontSelectionDialog (bool monospace_only, + int initial_family_idx, + int initial_style_idx) : BWindow (BRect (0, 0, 500, 500), "Select font from list", B_TITLED_WINDOW_LOOK, @@ -2583,7 +2593,8 @@ class EmacsFontSelectionDialog : public BWindow new BMessage (B_CANCEL)), ok_button ("OK", "OK", new BMessage (B_OK)), size_entry (NULL, "Size:", NULL, NULL), - allow_monospace_only (monospace_only) + allow_monospace_only (monospace_only), + pending_selection_idx (initial_style_idx) { BStringItem *family_item; int i, n_families; @@ -2638,6 +2649,12 @@ class EmacsFontSelectionDialog : public BWindow } } + if (initial_family_idx >= 0) + { + font_family_pane.Select (initial_family_idx); + font_family_pane.ScrollToSelection (); + } + size_text = size_entry.TextView (); for (c = 0; c <= 47; ++c) @@ -4701,7 +4718,8 @@ be_select_font (void (*process_pending_signals_function) (void), bool (*should_quit_function) (void), haiku_font_family_or_style *family, haiku_font_family_or_style *style, - int *size, bool allow_monospace_only) + int *size, bool allow_monospace_only, + int initial_family, int initial_style) { EmacsFontSelectionDialog *dialog; struct font_selection_dialog_message msg; @@ -4709,7 +4727,8 @@ be_select_font (void (*process_pending_signals_function) (void), font_family family_buffer; font_style style_buffer; - dialog = new EmacsFontSelectionDialog (allow_monospace_only); + dialog = new EmacsFontSelectionDialog (allow_monospace_only, + initial_family, initial_style); dialog->CenterOnScreen (); if (dialog->InitCheck () < B_OK) diff --git a/src/haiku_support.h b/src/haiku_support.h index 5522468fb3..efce63b478 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -661,7 +661,9 @@ extern bool be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event extern bool be_select_font (void (*) (void), bool (*) (void), haiku_font_family_or_style *, haiku_font_family_or_style *, - int *, bool); + int *, bool, int, int); + +extern int be_find_font_indices (struct haiku_font_pattern *, int *, int *); #ifdef __cplusplus } diff --git a/src/haikufont.c b/src/haikufont.c index 7f676b8727..3607012f6c 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -253,7 +253,7 @@ haikufont_lisp_to_weight (Lisp_Object weight) return HAIKU_LIGHT; if (EQ (weight, Qsemi_light)) return HAIKU_SEMI_LIGHT; - if (EQ (weight, Qnormal)) + if (EQ (weight, Qnormal) || EQ (weight, Qregular)) return HAIKU_REGULAR; if (EQ (weight, Qsemi_bold)) return HAIKU_SEMI_BOLD; @@ -274,7 +274,7 @@ haikufont_lisp_to_weight (Lisp_Object weight) if (EQ (weight, Qmedium)) return HAIKU_MEDIUM; - emacs_abort (); + return HAIKU_REGULAR; } static Lisp_Object @@ -297,15 +297,16 @@ haikufont_slant_to_lisp (enum haiku_font_slant slant) static enum haiku_font_slant haikufont_lisp_to_slant (Lisp_Object slant) { - if (EQ (slant, Qitalic) || - EQ (slant, Qreverse_italic)) + if (EQ (slant, Qitalic) + || EQ (slant, Qreverse_italic)) return SLANT_ITALIC; - if (EQ (slant, Qoblique) || - EQ (slant, Qreverse_oblique)) + if (EQ (slant, Qoblique) + || EQ (slant, Qreverse_oblique)) return SLANT_OBLIQUE; - if (EQ (slant, Qnormal)) + if (EQ (slant, Qnormal) || EQ (slant, Qregular)) return SLANT_REGULAR; - emacs_abort (); + + return SLANT_REGULAR; } static Lisp_Object @@ -349,7 +350,7 @@ haikufont_lisp_to_width (Lisp_Object lisp) return CONDENSED; if (EQ (lisp, Qsemi_condensed)) return SEMI_CONDENSED; - if (EQ (lisp, Qnormal)) + if (EQ (lisp, Qnormal) || EQ (lisp, Qregular)) return NORMAL_WIDTH; if (EQ (lisp, Qexpanded)) return EXPANDED; @@ -357,7 +358,8 @@ haikufont_lisp_to_width (Lisp_Object lisp) return EXTRA_EXPANDED; if (EQ (lisp, Qultra_expanded)) return ULTRA_EXPANDED; - emacs_abort (); + + return NORMAL_WIDTH; } static int @@ -423,6 +425,56 @@ haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) return ent; } +static void +haikufont_pattern_from_object (struct haiku_font_pattern *pattern, + Lisp_Object font_object) +{ + Lisp_Object val; + + pattern->specified = 0; + + val = AREF (font_object, FONT_FAMILY_INDEX); + if (!NILP (val)) + { + pattern->specified |= FSPEC_FAMILY; + strncpy ((char *) &pattern->family, + SSDATA (SYMBOL_NAME (val)), + sizeof pattern->family - 1); + pattern->family[sizeof pattern->family - 1] = '\0'; + } + + val = AREF (font_object, FONT_ADSTYLE_INDEX); + if (!NILP (val)) + { + pattern->specified |= FSPEC_STYLE; + strncpy ((char *) &pattern->style, + SSDATA (SYMBOL_NAME (val)), + sizeof pattern->style - 1); + pattern->style[sizeof pattern->style - 1] = '\0'; + } + + val = FONT_WEIGHT_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_WEIGHT; + pattern->weight = haikufont_lisp_to_weight (val); + } + + val = FONT_SLANT_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_SLANT; + pattern->slant = haikufont_lisp_to_slant (font_object); + } + + val = FONT_WIDTH_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_WIDTH; + pattern->width = haikufont_lisp_to_width (font_object); + } +} + static void haikufont_spec_or_entity_to_pattern (Lisp_Object ent, int list_p, struct haiku_font_pattern *ptn) @@ -469,8 +521,9 @@ haikufont_spec_or_entity_to_pattern (Lisp_Object ent, int list_p, } tem = AREF (ent, FONT_FAMILY_INDEX); - if (!NILP (tem) && !EQ (tem, Qunspecified) && - (list_p && !haikufont_maybe_handle_special_family (tem, ptn))) + if (!NILP (tem) && !EQ (tem, Qunspecified) + && (list_p + && !haikufont_maybe_handle_special_family (tem, ptn))) { ptn->specified |= FSPEC_FAMILY; strncpy ((char *) &ptn->family, @@ -1098,22 +1151,41 @@ If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts in the font selection dialog. */) (Lisp_Object frame, Lisp_Object exclude_proportional) { + struct frame *f; + struct font *font; + Lisp_Object font_object; haiku_font_family_or_style family, style; - int rc, size; + int rc, size, initial_family, initial_style; struct haiku_font_pattern pattern; Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle, lsize; - decode_window_system_frame (frame); + f = decode_window_system_frame (frame); if (popup_activated_p) error ("Trying to use a menu from within a menu-entry"); + initial_style = -1; + initial_family = -1; + + font = FRAME_FONT (f); + + if (font) + { + XSETFONT (font_object, font); + + haikufont_pattern_from_object (&pattern, font_object); + be_find_font_indices (&pattern, &initial_family, + &initial_style); + haikufont_done_with_query_pattern (&pattern); + } + popup_activated_p++; unrequest_sigio (); rc = be_select_font (process_pending_signals, haikufont_should_quit_popup, &family, &style, &size, - !NILP (exclude_proportional)); + !NILP (exclude_proportional), + initial_family, initial_style); request_sigio (); popup_activated_p--; @@ -1161,6 +1233,7 @@ syms_of_haikufont (void) DEFSYM (Qexpanded, "expanded"); DEFSYM (Qextra_expanded, "extra-expanded"); DEFSYM (Qultra_expanded, "ultra-expanded"); + DEFSYM (Qregular, "regular"); DEFSYM (Qzh, "zh"); DEFSYM (Qko, "ko"); DEFSYM (Qjp, "jp"); commit 2fa11123e5e3ebe3703da1968f66d14265358ac5 Author: Stefan Monnier Date: Mon May 2 01:14:17 2022 -0400 * lisp/gnus/gnus-util.el (gnus-byte-compile): Use `lexical-binding` diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 6150781fec..218a4d242b 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -562,7 +562,7 @@ If N, return the Nth ancestor instead." buffer)) (define-obsolete-function-alias 'gnus-buffer-exists-p - 'gnus-buffer-live-p "27.1") + #'gnus-buffer-live-p "27.1") (defun gnus-horizontal-recenter () "Recenter the current buffer horizontally." @@ -680,7 +680,7 @@ yield \"nnimap:yxa\"." (defun gnus-turn-off-edit-menu (type) "Turn off edit menu in `gnus-TYPE-mode-map'." (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) - [menu-bar edit] 'undefined)) + [menu-bar edit] #'undefined)) (defvar print-string-length) @@ -954,9 +954,9 @@ ARG is passed to the first function." (with-current-buffer gnus-group-buffer (eq major-mode 'gnus-group-mode)))) -(define-obsolete-function-alias 'gnus-remove-if 'seq-remove "27.1") +(define-obsolete-function-alias 'gnus-remove-if #'seq-remove "27.1") -(define-obsolete-function-alias 'gnus-remove-if-not 'seq-filter "27.1") +(define-obsolete-function-alias 'gnus-remove-if-not #'seq-filter "27.1") (defun gnus-grep-in-list (word list) "Find if a WORD matches any regular expression in the given LIST." @@ -1091,9 +1091,10 @@ ARG is passed to the first function." (defun gnus-byte-compile (form) "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." (if gnus-use-byte-compile - (let ((byte-compile-warnings '(unresolved callargs redefine))) + (let ((byte-compile-warnings '(unresolved callargs redefine)) + (lexical-binding t)) (byte-compile form)) - form)) + (eval form t))) (defun gnus-remassoc (key alist) "Delete by side effect any elements of LIST whose car is `equal' to KEY. commit be3267eb346745d73cfb627c6e962e261a51d6d2 Author: Po Lu Date: Mon May 2 01:59:52 2022 +0000 Fix race conditions with async input in some Haiku dialogs * src/haikufns.c (Fhaiku_save_session_reply): * src/haikufont.c (Fx_select_font): Block sigio around system calls. diff --git a/src/haikufns.c b/src/haikufns.c index f7c17567b1..04c58c55a7 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -2672,8 +2672,10 @@ call this function yourself. */) reply.quit_reply = !NILP (quit_reply); block_input (); + unrequest_sigio (); write_port (port_emacs_to_session_manager, 0, &reply, sizeof reply); + request_sigio (); unblock_input (); return Qnil; diff --git a/src/haikufont.c b/src/haikufont.c index eb00c8ff38..7f676b8727 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -1109,10 +1109,12 @@ in the font selection dialog. */) error ("Trying to use a menu from within a menu-entry"); popup_activated_p++; + unrequest_sigio (); rc = be_select_font (process_pending_signals, haikufont_should_quit_popup, &family, &style, &size, !NILP (exclude_proportional)); + request_sigio (); popup_activated_p--; if (!rc) commit 48ea81af97b04d507674e06d78c247f868135d48 Author: Po Lu Date: Mon May 2 09:38:36 2022 +0800 Fix the macOS build * src/nsterm.m (ns_font_desc_to_font_spec, syms_of_nsterm): Define missing symbols that are only on GNUstep. diff --git a/src/nsterm.m b/src/nsterm.m index 730472d261..f9d46c73d7 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6087,7 +6087,7 @@ - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg if (tem != nil) lslant = ([tem floatValue] > 0 ? Qitalic : ([tem floatValue] < 0 - ? intern ("reverse-italic") + ? Qreverse_italic : Qnormal)); tem = [dict objectForKey: NSFontWeightTrait]; @@ -10260,6 +10260,9 @@ Nil means use fullscreen the old (< 10.7) way. The old way works better with DEFSYM (QCordinary, ":ordinary"); DEFSYM (QCfunction, ":function"); DEFSYM (QCmouse, ":mouse"); + DEFSYM (Qcondensed, "condensed"); + DEFSYM (Qreverse_italic, "reverse-italic"); + DEFSYM (Qexpanded, "reverse-italic"); #ifdef NS_IMPL_COCOA Fprovide (Qcocoa, Qnil); commit 7b05f351f26849ab31d9425e585f7a418496a574 Author: Po Lu Date: Mon May 2 09:32:54 2022 +0800 Make the NS font dialog return more correct values * src/nsfns.m (Fx_select_font): Update doc string. * src/nsterm.m (ns_font_desc_to_font_spec): New function. ([EmacsView showFontPanel]): Return selected font as a font spec instead. diff --git a/src/nsfns.m b/src/nsfns.m index b71a3d7376..41fea6f0fe 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1595,7 +1595,7 @@ Frames are listed from topmost (first) to bottommost (last). */) DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, doc: /* Read a font using a Nextstep dialog. -Return a string describing the selected font. +Return a font specification describing the selected font. FRAME is the frame on which to pop up the font chooser. If omitted or nil, it defaults to the selected frame. */) diff --git a/src/nsterm.m b/src/nsterm.m index 5e70e0d566..730472d261 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6055,6 +6055,63 @@ - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg @end /* EmacsApp */ +static Lisp_Object +ns_font_desc_to_font_spec (NSFontDescriptor *desc, NSFont *font) +{ + NSFontSymbolicTraits traits = [desc symbolicTraits]; + NSDictionary *dict = [desc objectForKey: NSFontTraitsAttribute]; + NSString *family = [font familyName]; + Lisp_Object lwidth, lslant, lweight, lheight; + NSNumber *tem; + + lwidth = Qnil; + lslant = Qnil; + lweight = Qnil; + lheight = Qnil; + + if (traits & NSFontBoldTrait) + lweight = Qbold; + + if (traits & NSFontItalicTrait) + lslant = Qitalic; + + if (traits & NSFontCondensedTrait) + lwidth = Qcondensed; + else if (traits & NSFontExpandedTrait) + lwidth = Qexpanded; + + if (dict != nil) + { + tem = [dict objectForKey: NSFontSlantTrait]; + + if (tem != nil) + lslant = ([tem floatValue] > 0 + ? Qitalic : ([tem floatValue] < 0 + ? intern ("reverse-italic") + : Qnormal)); + + tem = [dict objectForKey: NSFontWeightTrait]; + + if (tem != nil) + lweight = ([tem floatValue] > 0 + ? Qbold : ([tem floatValue] < -0.4f + ? Qlight : Qnormal)); + + tem = [dict objectForKey: NSFontWidthTrait]; + + if (tem != nil) + lwidth = ([tem floatValue] > 0 + ? Qexpanded : ([tem floatValue] < 0 + ? Qnormal : Qcondensed)); + } + + lheight = make_float ([font pointSize]); + + return CALLN (Ffont_spec, + QCwidth, lwidth, QCslant, lslant, + QCweight, lweight, QCsize, lheight, + QCfamily, [family lispString]); +} /* ========================================================================== @@ -6151,9 +6208,9 @@ - (Lisp_Object) showFontPanel [[fm fontPanel: YES] setIsVisible: NO]; font_panel_active = NO; - /* TODO: return a font spec instead of a string. */ if (result) - return [[result familyName] lispString]; + return ns_font_desc_to_font_spec ([result fontDescriptor], + result); return Qnil; } commit 4fac694669fc138296f4d42706cdee269dca8a1c Author: Po Lu Date: Mon May 2 08:49:40 2022 +0800 Fix devices staying disabled in some cases * src/xterm.c (handle_one_xevent): Process queued disables before handling an XIDeviceEnabled situation. diff --git a/src/xterm.c b/src/xterm.c index 3dd8f320ba..517869dde3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -18591,6 +18591,48 @@ handle_one_xevent (struct x_display_info *dpyinfo, { if (hev->info[i].flags & XIDeviceEnabled) { + /* Handle all disabled devices now, to prevent + things happening out-of-order later. */ + if (n_disabled) + { + ndevices = 0; + devices = xmalloc (sizeof *devices * dpyinfo->num_devices); + + for (i = 0; i < dpyinfo->num_devices; ++i) + { + for (j = 0; j < n_disabled; ++j) + { + if (disabled[j] == dpyinfo->devices[i].device_id) + { +#ifdef HAVE_XINPUT2_1 + xfree (dpyinfo->devices[i].valuators); +#endif +#ifdef HAVE_XINPUT2_2 + tem = dpyinfo->devices[i].touchpoints; + while (tem) + { + last = tem; + tem = tem->next; + xfree (last); + } +#endif + goto continue_detachment; + } + } + + devices[ndevices++] = dpyinfo->devices[i]; + + continue_detachment: + continue; + } + + xfree (dpyinfo->devices); + dpyinfo->devices = devices; + dpyinfo->num_devices = ndevices; + + n_disabled = 0; + } + x_catch_errors (dpyinfo->display); info = XIQueryDevice (dpyinfo->display, hev->info[i].deviceid, &ndevices); @@ -18654,13 +18696,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, xfree (last); } #endif - goto continue_detachment; + goto break_detachment; } } devices[ndevices++] = dpyinfo->devices[i]; - continue_detachment: + break_detachment: continue; } commit 51186ed69c361abd73d20a96e929b127cd7f15f9 Author: Lars Ingebrigtsen Date: Sun May 1 23:05:06 2022 +0200 Fix string-lines return for "" * lisp/subr.el (string-lines): Return the correct result on "" (bug#55213). diff --git a/lisp/subr.el b/lisp/subr.el index d6ea309207..aded02c4f7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6747,29 +6747,31 @@ is inserted before adjusting the number of empty lines." If OMIT-NULLS, empty lines will be removed from the results. If KEEP-NEWLINES, don't strip trailing newlines from the result lines." - (let ((lines nil) - (start 0)) - (while (< start (length string)) - (let ((newline (string-search "\n" string start))) - (if newline - (progn - (when (or (not omit-nulls) - (not (= start newline))) - (let ((line (substring string start - (if keep-newlines - (1+ newline) - newline)))) - (when (not (and keep-newlines omit-nulls - (equal line "\n"))) - (push line lines)))) - (setq start (1+ newline))) - ;; No newline in the remaining part. - (if (zerop start) - ;; Avoid a string copy if there are no newlines at all. - (push string lines) - (push (substring string start) lines)) - (setq start (length string))))) - (nreverse lines))) + (if (equal string "") + (list "") + (let ((lines nil) + (start 0)) + (while (< start (length string)) + (let ((newline (string-search "\n" string start))) + (if newline + (progn + (when (or (not omit-nulls) + (not (= start newline))) + (let ((line (substring string start + (if keep-newlines + (1+ newline) + newline)))) + (when (not (and keep-newlines omit-nulls + (equal line "\n"))) + (push line lines)))) + (setq start (1+ newline))) + ;; No newline in the remaining part. + (if (zerop start) + ;; Avoid a string copy if there are no newlines at all. + (push string lines) + (push (substring string start) lines)) + (setq start (length string))))) + (nreverse lines)))) (defun buffer-match-p (condition buffer-or-name &optional arg) "Return non-nil if BUFFER-OR-NAME matches CONDITION. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 93e4475d6b..f4676793ff 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1029,6 +1029,8 @@ final or penultimate step during initialization.")) (should-not (readablep (list (make-marker))))) (ert-deftest test-string-lines () + (should (equal (string-lines "") '(""))) + (should (equal (string-lines "foo") '("foo"))) (should (equal (string-lines "foo\n") '("foo"))) (should (equal (string-lines "foo\nbar") '("foo" "bar"))) commit 4f395efa06d88832c376c2b1d4607677436228c0 Author: Lars Ingebrigtsen Date: Sun May 1 20:54:11 2022 +0200 Change string-lines semantics slightly * lisp/subr.el (string-lines): Change the semantics slightly -- don't return an empty string for a trailing newline. diff --git a/etc/NEWS b/etc/NEWS index 3380c266da..882748d8c7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -135,6 +135,11 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 +--- +** 'string-lines' handles trailing newlines differently. +It no longer returns an empty final string if the string ends with a +newline. + --- ** 'TAB' and '' are now bound in 'button-map'. This means that if you're standing on a button, 'TAB' will take you to diff --git a/lisp/subr.el b/lisp/subr.el index d4f5d0d23b..d6ea309207 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6762,12 +6762,7 @@ lines." (when (not (and keep-newlines omit-nulls (equal line "\n"))) (push line lines)))) - (setq start (1+ newline)) - ;; Include the final newline. - (when (and (= start (length string)) - (not omit-nulls) - (not keep-newlines)) - (push "" lines))) + (setq start (1+ newline))) ;; No newline in the remaining part. (if (zerop start) ;; Avoid a string copy if there are no newlines at all. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index c431930c27..93e4475d6b 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1030,7 +1030,7 @@ final or penultimate step during initialization.")) (ert-deftest test-string-lines () (should (equal (string-lines "foo") '("foo"))) - (should (equal (string-lines "foo\n") '("foo" ""))) + (should (equal (string-lines "foo\n") '("foo"))) (should (equal (string-lines "foo\nbar") '("foo" "bar"))) (should (equal (string-lines "foo" t) '("foo"))) commit 32ab756d82b39a9706ff8990dcf6eb074818c66e Author: Jim Porter Date: Tue Apr 26 21:53:00 2022 -0700 Handle escaped characters in Eshell special references (e.g. buffers) * lisp/eshell/esh-arg.el (eshell-parse-special-reference): Unescape escaped characters. * test/lisp/eshell/eshell-tests-helpers.el (with-temp-eshell): Restore current buffer after evaluating BODY. * test/lisp/eshell/eshell-tests.el (eshell-test/redirect-buffer) (eshell-test/redirect-buffer-escaped): New tests (bug#55204). diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index ee3f907f85..395aa87ff0 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -401,7 +401,9 @@ If the form has no `type', the syntax is parsed as if `type' were (if (eshell-arg-delimiter (1+ end)) (prog1 (list (if buffer-p 'get-buffer-create 'get-process) - (buffer-substring-no-properties (point) end)) + (replace-regexp-in-string + (rx "\\" (group (or "\\" "<" ">"))) "\\1" + (buffer-substring-no-properties (point) end))) (goto-char (1+ end))) (ignore (goto-char here))))))) diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index f944194a2b..4ad76ca697 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -38,17 +38,18 @@ See `eshell-wait-for-subprocess'.") (defmacro with-temp-eshell (&rest body) "Evaluate BODY in a temporary Eshell buffer." - `(ert-with-temp-directory eshell-directory-name - (let* (;; We want no history file, so prevent Eshell from falling - ;; back on $HISTFILE. - (process-environment (cons "HISTFILE" process-environment)) - (eshell-history-file-name nil) - (eshell-buffer (eshell t))) - (unwind-protect - (with-current-buffer eshell-buffer - ,@body) - (let (kill-buffer-query-functions) - (kill-buffer eshell-buffer)))))) + `(save-current-buffer + (ert-with-temp-directory eshell-directory-name + (let* (;; We want no history file, so prevent Eshell from falling + ;; back on $HISTFILE. + (process-environment (cons "HISTFILE" process-environment)) + (eshell-history-file-name nil) + (eshell-buffer (eshell t))) + (unwind-protect + (with-current-buffer eshell-buffer + ,@body) + (let (kill-buffer-query-functions) + (kill-buffer eshell-buffer))))))) (defun eshell-wait-for-subprocess (&optional all) "Wait until there is no interactive subprocess running in Eshell. diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index bcc2dc320b..7cdeb017e4 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -114,6 +114,25 @@ e.g. \"{(+ 1 2)} 3\" => 3" (eshell-wait-for-subprocess) (eshell-match-result "OLLEH\n"))) +(ert-deftest eshell-test/redirect-buffer () + "Check that piping to a buffer works" + (with-temp-buffer + (rename-buffer "eshell-temp-buffer" t) + (let ((bufname (buffer-name))) + (with-temp-eshell + (eshell-insert-command (format "echo hi > #<%s>" bufname))) + (should (equal (buffer-string) "hi"))))) + +(ert-deftest eshell-test/redirect-buffer-escaped () + "Check that piping to a buffer with escaped characters works" + (with-temp-buffer + (rename-buffer "eshell\\temp\\buffer" t) + (let ((bufname (buffer-name))) + (with-temp-eshell + (eshell-insert-command (format "echo hi > #<%s>" + (string-replace "\\" "\\\\" bufname)))) + (should (equal (buffer-string) "hi"))))) + (ert-deftest eshell-test/inside-emacs-var () "Test presence of \"INSIDE_EMACS\" in subprocesses" (with-temp-eshell commit bb40507fed7b211bb0ef5b5e3dcc609876f6ad8d Author: Jim Porter Date: Tue Apr 26 21:51:23 2022 -0700 Handle escaped characters in Eshell argument predicates/modifiers * lisp/eshell/em-pred.el (eshell-get-delimited-modifier-argument): Unescape escaped characters. * test/lisp/eshell/em-pred-tests.el (em-pred-test/predicate-escaping): New test (bug#55204). diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 594563554d..d73976d346 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -416,7 +416,9 @@ before the closing delimiter. This allows modifiers like (close (cdr (assoc open eshell-pred-delimiter-pairs))) (end (eshell-find-delimiter open close nil nil t))) (prog1 - (buffer-substring-no-properties (1+ (point)) end) + (replace-regexp-in-string + (rx-to-string `(seq "\\" (group (or "\\" ,open ,close)))) "\\1" + (buffer-substring-no-properties (1+ (point)) end)) (goto-char (if (and chained-p (eq open close)) end (1+ end)))))) diff --git a/test/lisp/eshell/em-pred-tests.el b/test/lisp/eshell/em-pred-tests.el index 4d2af39292..3b50543d69 100644 --- a/test/lisp/eshell/em-pred-tests.el +++ b/test/lisp/eshell/em-pred-tests.el @@ -533,4 +533,16 @@ PREDICATE is the predicate used to query that attribute." (format ":j%c-%c" (car delims) (cdr delims))) "foo-bar-baz")))) +(ert-deftest em-pred-test/predicate-escaping () + "Test string escaping in predicate and modifier parameters." + ;; Escaping the delimiter should remove the backslash. + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j'\\''") + "foo'bar'baz")) + ;; Escaping a backlash should remove the first backslash. + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j'\\\\'") + "foo\\bar\\baz")) + ;; Escaping a different character should keep the backslash. + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j'\\\"'") + "foo\\\"bar\\\"baz"))) + ;; em-pred-tests.el ends here commit ade1424a975aabaa208010c6fdd3c8b7c51242ff Author: Jim Porter Date: Sun Mar 27 22:28:40 2022 -0700 Use a common set of string delimiters for all Eshell predicates/modifiers * lisp/eshell/em-pred.el (eshell-pred-delimiter-pairs): New variable. (eshell-get-comparison-modifier-argument) (eshell-get-numeric-modifier-argument) (eshell-get-delimited-modifier-argument): New functions... (eshell-pred-user-or-group, eshell-pred-file-time) (eshell-pred-file-links, eshell-pred-file-size) (eshell-pred-substitute, eshell-join-memebers, eshell-split-members): ... and use them here. (eshell-include-members): Pass 'mod-char' and use 'eshell-get-delimited-modifier-argument'. (eshell-pred-file-type, eshell-pred-file-mode): Use 'when-let'. (eshell-modifier-alist): Pass modifier char to 'eshell-include-members'. * test/lisp/eshell/em-pred-tests.el (em-pred-test/predicate-delimiters): New test. (em-pred-test/predicate-uid, em-pred-test/predicate-gid, em-pred-test/modifier-include, em-pred-test/modifier-exclude): Remove cases covered by 'em-pred-test/predicate-delimiters'. (em-pred-test/modifier-substitute): Add test cases for new delimiter styles. * doc/misc/eshell.texi (Argument Predication and Modification): Explain how string parameters are delimited. (Argument Modifiers): Document some special delimiter behavior with the 's/PATTERN/REPLACE/' modifier (bug#55204). * etc/NEWS: Announce this change, and move the 'eshell-eval-using-options' entry to the Eshell section. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index e539206166..a3ed922cf2 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1191,6 +1191,13 @@ or modifiers. For example, @samp{*(.)} expands to all regular files in the current directory and @samp{*(^@@:U^u0)} expands to all non-symlinks not owned by @code{root}, upper-cased. +Some predicates and modifiers accept string parameters, such as +@samp{*(u'@var{user}')}, which matches all files owned by @var{user}. +These parameters must be surrounded by delimiters; you can use any of +the following pairs of delimiters: @code{" @dots{} "}, @code{' @dots{} +'}, @code{/ @dots{} /}, @code{| @dots{} |}, @code{( @dots{} )}, +@code{[ @dots{} ]}, @code{< @dots{} >}, or @code{@{ @dots{} @}}. + You can customize the syntax and behavior of predicates and modifiers in Eshell via the Customize group ``eshell-pred'' (@pxref{Easy Customization, , , emacs, The GNU Emacs Manual}). @@ -1379,6 +1386,11 @@ meaning. Replaces the first instance of the regular expression @var{pattern} with @var{replace}. Signals an error if no match is found. +As with other modifiers taking string parameters, you can use +different delimiters to separate @var{pattern} and @var{replace}, such +as @samp{s'@dots{}'@dots{}'}, @samp{s[@dots{}][@dots{}]}, or even +@samp{s[@dots{}]/@dots{}/}. + @item gs/@var{pattern}/@var{replace}/ Replaces all instances of the regular expression @var{pattern} with @var{replace}. diff --git a/etc/NEWS b/etc/NEWS index 090d0b6ddd..3380c266da 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -174,11 +174,22 @@ files that were compiled with an old EIEIO (Emacs<25). ** 'C-x 8 .' has been moved to 'C-x 8 . .'. This is to open up the 'C-x 8 .' map to bind further characters there. +** Eshell + --- -** 'source' and '.' in Eshell no longer accept the '--help' option. +*** 'source' and '.' no longer accept the '--help' option. This is for compatibility with the shell versions of these commands, which don't handle options like '--help' in any special way. ++++ +*** String delimiters in argument predicates/modifiers are more restricted. +Previously, some argument predicates/modifiers allowed arbitrary +characters as string delimiters. To provide more unified behavior +across all predicates/modifiers, the list of allowed delimiters has +been restricted to "...", '...', /.../, |...|, (...), [...], <...>, +and {...}. See the "(eshell) Argument Predication and Modification" +node in the Eshell manual for more details. + --- ** The 'delete-forward-char' command now deletes by grapheme clusters. This command is by default bound to the function key @@ -1354,6 +1365,14 @@ Lisp function. This frees you from having to keep track of whether commands are Lisp function or external when supplying absolute file name arguments. See "Electric forward slash" in the Eshell manual. +--- +*** Built-in Eshell commands now follow POSIX/GNU argument syntax conventions. +Built-in commands in Eshell now accept command-line options with +values passed as a single token, such as '-oVALUE' or +'--option=VALUE'. New commands can take advantage of this with the +'eshell-eval-using-options' macro. See "Defining new built-in +commands" in the "(eshell) Built-ins" node of the Eshell manual. + ** Calc +++ @@ -1937,11 +1956,6 @@ dimensions. Specifying a cons as the FROM argument allows to start measuring text from a specified amount of pixels above or below a position. ---- -** 'eshell-eval-using-options' now follows argument syntax conventions. -Built-in commands in Eshell now accept command-line options with -values passed as a single token, such as '-oVALUE' or '--option=VALUE'. - ** XDG support --- diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index eb5109b82d..594563554d 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -116,8 +116,8 @@ The format of each entry is (?U . (lambda (lst) (mapcar #'upcase lst))) (?C . (lambda (lst) (mapcar #'capitalize lst))) (?h . (lambda (lst) (mapcar #'file-name-directory lst))) - (?i . (eshell-include-members)) - (?x . (eshell-include-members t)) + (?i . (eshell-include-members ?i)) + (?x . (eshell-include-members ?x t)) (?r . (lambda (lst) (mapcar #'file-name-sans-extension lst))) (?e . (lambda (lst) (mapcar #'file-name-extension lst))) (?t . (lambda (lst) (mapcar #'file-name-nondirectory lst))) @@ -219,6 +219,20 @@ FOR LISTS OF ARGUMENTS: EXAMPLES: *.c(:o) sorted list of .c files") +(defvar eshell-pred-delimiter-pairs + '((?\( . ?\)) + (?\[ . ?\]) + (?\< . ?\>) + (?\{ . ?\}) + (?\' . ?\') + (?\" . ?\") + (?/ . ?/) + (?| . ?|)) + "A list of delimiter pairs that can be used in argument predicates/modifiers. +Each element is of the form (OPEN . CLOSE), where OPEN and CLOSE +are characters representing the opening and closing delimiter, +respectively.") + (defvar-keymap eshell-pred-mode-map "C-c M-q" #'eshell-display-predicate-help "C-c M-m" #'eshell-display-modifier-help) @@ -364,38 +378,68 @@ resultant list of strings." (lambda (file) (funcall pred (file-truename file)))))) (cons pred funcs)) +(defun eshell-get-comparison-modifier-argument (&optional functions) + "Starting at point, get the comparison modifier argument, if any. +These are the -/+ characters, corresponding to `<' and `>', +respectively. If no comparison modifier is at point, return `='. + +FUNCTIONS, if non-nil, is a list of comparison functions, +specified as (LESS-THAN GREATER-THAN EQUAL-TO)." + (let ((functions (or functions (list #'< #'> #'=)))) + (if (memq (char-after) '(?- ?+)) + (prog1 + (if (eq (char-after) ?-) (nth 0 functions) (nth 1 functions)) + (forward-char)) + (nth 2 functions)))) + +(defun eshell-get-numeric-modifier-argument () + "Starting at point, get the numeric modifier argument, if any. +If a number is found, update point to just after the number." + (when (looking-at "[0-9]+") + (prog1 + (string-to-number (match-string 0)) + (goto-char (match-end 0))))) + +(defun eshell-get-delimited-modifier-argument (&optional chained-p) + "Starting at point, get the delimited modifier argument, if any. +If the character after point is a predicate/modifier +delimiter (see `eshell-pred-delimiter-pairs', read the value of +the argument and update point to be just after the closing +delimiter. + +If CHAINED-P is true, then another delimited modifier argument +will immediately follow this one. In this case, when the opening +and closing delimiters are the same, update point to be just +before the closing delimiter. This allows modifiers like +`:s/match/repl' to work as expected." + (when-let* ((open (char-after)) + (close (cdr (assoc open eshell-pred-delimiter-pairs))) + (end (eshell-find-delimiter open close nil nil t))) + (prog1 + (buffer-substring-no-properties (1+ (point)) end) + (goto-char (if (and chained-p (eq open close)) + end + (1+ end)))))) + (defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func) "Return a predicate to test whether a file match a given user/group id." - (let (ugid open close end) - (if (looking-at "[0-9]+") - (progn - (setq ugid (string-to-number (match-string 0))) - (goto-char (match-end 0))) - (setq open (char-after)) - (if (setq close (memq open '(?\( ?\[ ?\< ?\{))) - (setq close (car (last '(?\) ?\] ?\> ?\}) - (length close)))) - (setq close open)) - (forward-char) - (setq end (eshell-find-delimiter open close)) - (unless end - (error "Malformed %s name string for modifier `%c'" - mod-type mod-char)) - (setq ugid - (funcall get-id-func (buffer-substring (point) end))) - (goto-char (1+ end))) + (let ((ugid (eshell-get-numeric-modifier-argument))) + (unless ugid + (let ((ugname (or (eshell-get-delimited-modifier-argument) + (error "Malformed %s name string for modifier `%c'" + mod-type mod-char)))) + (setq ugid (funcall get-id-func ugname)))) (unless ugid (error "Unknown %s name specified for modifier `%c'" mod-type mod-char)) (lambda (file) - (let ((attrs (file-attributes file))) - (if attrs - (= (nth attr-index attrs) ugid)))))) + (when-let ((attrs (file-attributes file))) + (= (nth attr-index attrs) ugid))))) (defun eshell-pred-file-time (mod-char mod-type attr-index) "Return a predicate to test whether a file matches a certain time." (let* ((quantum 86400) - qual when open close end) + qual when) (when (memq (char-after) '(?M ?w ?h ?m ?s)) (setq quantum (char-after)) (cond @@ -410,36 +454,21 @@ resultant list of strings." ((eq quantum ?s) (setq quantum 1))) (forward-char)) - (when (memq (char-after) '(?+ ?-)) - (setq qual (char-after)) - (forward-char)) - (if (looking-at "[0-9]+") - (progn - (setq when (time-since (* (string-to-number (match-string 0)) - quantum))) - (goto-char (match-end 0))) - (setq open (char-after)) - (if (setq close (memq open '(?\( ?\[ ?\< ?\{))) - (setq close (car (last '(?\) ?\] ?\> ?\}) - (length close)))) - (setq close open)) - (forward-char) - (setq end (eshell-find-delimiter open close)) - (unless end - (error "Malformed %s time modifier `%c'" mod-type mod-char)) - (let* ((file (buffer-substring (point) end)) - (attrs (file-attributes file))) - (unless attrs - (error "Cannot stat file `%s'" file)) - (setq when (nth attr-index attrs))) - (goto-char (1+ end))) - (let ((f (cond ((eq qual ?-) #'time-less-p) - ((eq qual ?+) (lambda (a b) (time-less-p b a))) - (#'time-equal-p)))) - (lambda (file) - (let ((attrs (file-attributes file))) - (if attrs - (funcall f when (nth attr-index attrs)))))))) + (setq qual (eshell-get-comparison-modifier-argument + (list #'time-less-p + (lambda (a b) (time-less-p b a)) + #'time-equal-p))) + (if-let ((number (eshell-get-numeric-modifier-argument))) + (setq when (time-since (* number quantum))) + (let* ((file (or (eshell-get-delimited-modifier-argument) + (error "Malformed %s time modifier `%c'" + mod-type mod-char))) + (attrs (or (file-attributes file) + (error "Cannot stat file `%s'" file)))) + (setq when (nth attr-index attrs)))) + (lambda (file) + (when-let ((attrs (file-attributes file))) + (funcall qual when (nth attr-index attrs)))))) (defun eshell-pred-file-type (type) "Return a test which tests that the file is of a certain TYPE. @@ -454,36 +483,23 @@ that `ls -l' will show in the first column of its display." '(?b ?c) (list type)))) (lambda (file) - (let ((attrs (eshell-file-attributes (directory-file-name file)))) - (if attrs - (memq (aref (file-attribute-modes attrs) 0) set)))))) + (when-let ((attrs (eshell-file-attributes (directory-file-name file)))) + (memq (aref (file-attribute-modes attrs) 0) set))))) (defsubst eshell-pred-file-mode (mode) "Return a test which tests that MODE pertains to the file." (lambda (file) - (let ((modes (file-modes file 'nofollow))) - (if modes - (not (zerop (logand mode modes))))))) + (when-let ((modes (file-modes file 'nofollow))) + (not (zerop (logand mode modes)))))) (defun eshell-pred-file-links () "Return a predicate to test whether a file has a given number of links." - (let (qual amount) - (when (memq (char-after) '(?- ?+)) - (setq qual (char-after)) - (forward-char)) - (unless (looking-at "[0-9]+") - (error "Invalid file link count modifier `l'")) - (setq amount (string-to-number (match-string 0))) - (goto-char (match-end 0)) - (let ((f (if (eq qual ?-) - #'< - (if (eq qual ?+) - #'> - #'=)))) - (lambda (file) - (let ((attrs (eshell-file-attributes file))) - (if attrs - (funcall f (file-attribute-link-number attrs) amount))))))) + (let ((qual (eshell-get-comparison-modifier-argument)) + (amount (or (eshell-get-numeric-modifier-argument) + (error "Invalid file link count modifier `l'")))) + (lambda (file) + (when-let ((attrs (eshell-file-attributes file))) + (funcall qual (file-attribute-link-number attrs) amount))))) (defun eshell-pred-file-size () "Return a predicate to test whether a file is of a given size." @@ -498,85 +514,52 @@ that `ls -l' will show in the first column of its display." ((eq qual ?p) (setq quantum 512))) (forward-char)) - (when (memq (char-after) '(?- ?+)) - (setq qual (char-after)) - (forward-char)) - (unless (looking-at "[0-9]+") - (error "Invalid file size modifier `L'")) - (setq amount (* (string-to-number (match-string 0)) quantum)) - (goto-char (match-end 0)) - (let ((f (if (eq qual ?-) - #'< - (if (eq qual ?+) - #'> - #'=)))) - (lambda (file) - (let ((attrs (eshell-file-attributes file))) - (if attrs - (funcall f (file-attribute-size attrs) amount))))))) + (setq qual (eshell-get-comparison-modifier-argument)) + (setq amount (* (or (eshell-get-numeric-modifier-argument) + (error "Invalid file size modifier `L'")) + quantum)) + (lambda (file) + (when-let ((attrs (eshell-file-attributes file))) + (funcall qual (file-attribute-size attrs) amount))))) (defun eshell-pred-substitute (&optional repeat) "Return a modifier function that will substitute matches." - (let ((delim (char-after)) - match replace end) - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - match (buffer-substring-no-properties (point) end)) - (goto-char (1+ end)) - (setq end (eshell-find-delimiter delim delim nil nil t) - replace (buffer-substring-no-properties (point) end)) - (goto-char (1+ end)) - (if repeat - (lambda (lst) - (mapcar - (lambda (str) - (replace-regexp-in-string match replace str t)) - lst)) - (lambda (lst) - (mapcar - (lambda (str) - (if (string-match match str) - (replace-match replace t nil str) - (error (concat str ": substitution failed")))) - lst))))) - -(defun eshell-include-members (&optional invert-p) - "Include only Lisp members matching a regexp." - (let ((delim (char-after)) - regexp end) - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - regexp (buffer-substring-no-properties (point) end)) - (goto-char (1+ end)) - (let ((predicates - (list (if invert-p - (lambda (elem) (not (string-match regexp elem))) - (lambda (elem) (string-match regexp elem)))))) - (lambda (lst) - (eshell-winnow-list lst nil predicates))))) + (let* ((match (or (eshell-get-delimited-modifier-argument t) + (error "Malformed pattern string for modifier `s'"))) + (replace (or (eshell-get-delimited-modifier-argument) + (error "Malformed replace string for modifier `s'"))) + (function (if repeat + (lambda (str) + (replace-regexp-in-string match replace str t)) + (lambda (str) + (if (string-match match str) + (replace-match replace t nil str) + (error (concat str ": substitution failed"))))))) + (lambda (lst) (mapcar function lst)))) + +(defun eshell-include-members (mod-char &optional invert-p) + "Include only Lisp members matching a regexp. +If INVERT-P is non-nil, include only members not matching a regexp." + (let* ((regexp (or (eshell-get-delimited-modifier-argument) + (error "Malformed pattern string for modifier `%c'" + mod-char))) + (predicates + (list (if invert-p + (lambda (elem) (not (string-match regexp elem))) + (lambda (elem) (string-match regexp elem)))))) + (lambda (lst) + (eshell-winnow-list lst nil predicates)))) (defun eshell-join-members () "Return a modifier function that join matches." - (let ((delim (char-after)) - str end) - (if (not (memq delim '(?' ?/))) - (setq str " ") - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - str (buffer-substring-no-properties (point) end)) - (goto-char (1+ end))) + (let ((str (or (eshell-get-delimited-modifier-argument) + " "))) (lambda (lst) (mapconcat #'identity lst str)))) (defun eshell-split-members () "Return a modifier function that splits members." - (let ((delim (char-after)) - sep end) - (when (memq delim '(?' ?/)) - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - sep (buffer-substring-no-properties (point) end)) - (goto-char (1+ end))) + (let ((sep (eshell-get-delimited-modifier-argument))) (lambda (lst) (mapcar (lambda (str) diff --git a/test/lisp/eshell/em-pred-tests.el b/test/lisp/eshell/em-pred-tests.el index 7f88ac4475..4d2af39292 100644 --- a/test/lisp/eshell/em-pred-tests.el +++ b/test/lisp/eshell/em-pred-tests.el @@ -26,6 +26,7 @@ (require 'ert) (require 'esh-mode) (require 'eshell) +(require 'em-pred) (require 'eshell-tests-helpers (expand-file-name "eshell-tests-helpers" @@ -254,8 +255,6 @@ read, write, and execute predicates to query the file's modes." (cl-letf (((symbol-function 'eshell-user-id) (lambda (name) (seq-position user-names name)))) (should (equal (eshell-eval-predicate files "u'one'") - '("/fake/uid=1"))) - (should (equal (eshell-eval-predicate files "u{one}") '("/fake/uid=1"))))))) (ert-deftest em-pred-test/predicate-gid () @@ -268,8 +267,6 @@ read, write, and execute predicates to query the file's modes." (cl-letf (((symbol-function 'eshell-group-id) (lambda (name) (seq-position group-names name)))) (should (equal (eshell-eval-predicate files "g'one'") - '("/fake/gid=1"))) - (should (equal (eshell-eval-predicate files "g{one}") '("/fake/gid=1"))))))) (defmacro em-pred-test--time-deftest (name file-attribute predicate @@ -430,6 +427,8 @@ PREDICATE is the predicate used to query that attribute." "Test that \":s/PAT/REP/\" replaces PAT with REP once." (should (equal (eshell-eval-predicate "bar" ":s/a/*/") "b*r")) (should (equal (eshell-eval-predicate "bar" ":s|a|*|") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":s{a}{*}") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":s{a}'*'") "b*r")) (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":s/[ao]/*/") '("f*o" "b*r" "b*z"))) (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":s|[ao]|*|") @@ -450,23 +449,15 @@ PREDICATE is the predicate used to query that attribute." (ert-deftest em-pred-test/modifier-include () "Test that \":i/PAT/\" filters elements to include only ones matching PAT." (should (equal (eshell-eval-predicate "foo" ":i/a/") nil)) - (should (equal (eshell-eval-predicate "foo" ":i|a|") nil)) (should (equal (eshell-eval-predicate "bar" ":i/a/") "bar")) - (should (equal (eshell-eval-predicate "bar" ":i|a|") "bar")) (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":i/a/") - '("bar" "baz"))) - (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":i|a|") '("bar" "baz")))) (ert-deftest em-pred-test/modifier-exclude () "Test that \":x/PAT/\" filters elements to exclude any matching PAT." (should (equal (eshell-eval-predicate "foo" ":x/a/") "foo")) - (should (equal (eshell-eval-predicate "foo" ":x|a|") "foo")) (should (equal (eshell-eval-predicate "bar" ":x/a/") nil)) - (should (equal (eshell-eval-predicate "bar" ":x|a|") nil)) (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":x/a/") - '("foo"))) - (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":x|a|") '("foo")))) (ert-deftest em-pred-test/modifier-split () @@ -516,7 +507,7 @@ PREDICATE is the predicate used to query that attribute." '("baz" "bar" "foo")))) -;; Combinations +;; Miscellaneous (ert-deftest em-pred-test/combine-predicate-and-modifier () "Test combination of predicates and modifiers." @@ -526,4 +517,20 @@ PREDICATE is the predicate used to query that attribute." (should (equal (eshell-eval-predicate files ".:e:u") '("el" "txt")))))) +(ert-deftest em-pred-test/predicate-delimiters () + "Test various delimiter pairs with predicates and modifiers." + (dolist (delims eshell-pred-delimiter-pairs) + (eshell-with-file-attributes-from-name + (let ((files '("/fake/uid=1" "/fake/uid=2")) + (user-names '("root" "one" "two"))) + (cl-letf (((symbol-function 'eshell-user-id) + (lambda (name) (seq-position user-names name)))) + (should (equal (eshell-eval-predicate + files (format "u%cone%c" (car delims) (cdr delims))) + '("/fake/uid=1")))))) + (should (equal (eshell-eval-predicate + '("foo" "bar" "baz") + (format ":j%c-%c" (car delims) (cdr delims))) + "foo-bar-baz")))) + ;; em-pred-tests.el ends here commit 788694d026b401715330576633a98542623978ff Author: Stefan Monnier Date: Sun May 1 13:04:44 2022 -0400 * lisp/minibuffer.el (completion--replace): Fix bug#55205 diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ef71b4e6be..fb473cf71b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1140,6 +1140,7 @@ Moves point to the end of the new text." ;; The properties on `newtext' include things like the ;; `completions-first-difference' face, which we don't want to ;; include upon insertion. + (setq newtext (copy-sequence newtext)) ;Don't modify the arg by side-effect. (if minibuffer-allow-text-properties ;; If we're preserving properties, then just remove the faces ;; and other properties added by the completion machinery. commit 9370a4763aacbb9278b5be9c92a2484e3652bc29 Author: Po Lu Date: Sun May 1 21:39:33 2022 +0800 Replace NS code that implemented font panels in a different way * doc/emacs/macos.texi (Mac / GNUstep Events): Document removal of `ns-change-font' event. The font panels are now implemented normally, via `x-select-font'. * lisp/term/common-win.el (x-setup-function-keys): Likewise. * lisp/term/ns-win.el (global-map, ns-popup-font-panel): Remove. (x-select-font, mouse-set-font, ns-input-font): (ns-input-fontsize): Remove. (ns-respond-to-change-font): Delete function. * src/nsfns.m (Fns_popup_font_panel): Delete function. (Fx_select_font): New function. (syms_of_nsfns): Update subrs. * src/nsterm.h (@interface EmacsView): * src/nsterm.m (ns_select_1): New function. (ns_select): Wrap around that instead. ([EmacsView changeFont:]): Exit nested event loop ([EmacsView showFontPanel:]): New function. diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index ab143707fd..37f48619d1 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -273,14 +273,6 @@ application is overriding the default behavior. The modifier keys listed above are defined by macOS and are unaffected by user changes to the modifiers in Emacs. -@item ns-change-font -This event occurs when the user selects a font in a Nextstep font -panel (which can be opened with @kbd{Cmd-t}). The default behavior is -to adjust the font of the selected frame -(@code{ns-respond-to-changefont}). The name and size of the selected -font are stored in the variables @code{ns-input-font} and -@code{ns-input-fontsize}, respectively. - @item ns-power-off This event occurs when the user logs out and Emacs is still running, or when ``Quit Emacs'' is chosen from the application menu. diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index b219014a73..6f1e322aba 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -65,7 +65,6 @@ (cons 4 'ns-drag-file) (cons 5 'ns-drag-color) (cons 6 'ns-drag-text) - (cons 7 'ns-change-font) (cons 8 'ns-open-file-line) ;;; (cons 9 'ns-insert-working-text) ;;; (cons 10 'ns-delete-working-text) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 065ca235b4..6a414d83f1 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -176,7 +176,6 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) (define-key global-map [ns-open-file] 'ns-find-file) (define-key global-map [ns-open-temp-file] [ns-open-file]) -(define-key global-map [ns-change-font] 'ns-respond-to-change-font) (define-key global-map [ns-open-file-line] 'ns-open-file-select-line) (define-key global-map [ns-spi-service-call] 'ns-spi-service-call) (define-key global-map [ns-new-frame] 'make-frame) @@ -623,34 +622,6 @@ If FRAME is nil, the change applies to the selected frame." ;; Needed for font listing functions under both backend and normal (setq scalable-fonts-allowed t) -;; Set to use font panel instead -(declare-function ns-popup-font-panel "nsfns.m" (&optional frame)) -(defalias 'x-select-font 'ns-popup-font-panel "Pop up the font panel. -This function has been overloaded in Nextstep.") -(defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel. -This function has been overloaded in Nextstep.") - -;; nsterm.m -(defvar ns-input-font) -(defvar ns-input-fontsize) - -(defun ns-respond-to-change-font () - "Set the font chosen in the font-picker panel. -Respond to changeFont: event, expecting ns-input-font and -ns-input-fontsize of new font." - (interactive) - (let ((face 'default)) - (set-face-attribute face t - :family ns-input-font - :height (* 10 ns-input-fontsize)) - (set-face-attribute face (selected-frame) - :family ns-input-font - :height (* 10 ns-input-fontsize)) - (let ((spec (list (list t (face-attr-construct 'default))))) - (put face 'customized-face spec) - (custom-push-theme 'theme-face face 'user 'set spec) - (put face 'face-modified nil)))) - ;; Default fontset for macOS. This is mainly here to show how a fontset ;; can be set up manually. Ordinarily, fontsets are auto-created whenever ;; a font is chosen by diff --git a/src/nsfns.m b/src/nsfns.m index 00d4a7d2bd..b71a3d7376 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1593,26 +1593,22 @@ Frames are listed from topmost (first) to bottommost (last). */) } } -DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel, - 0, 1, "", - doc: /* Pop up the font panel. */) - (Lisp_Object frame) +DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, + doc: /* Read a font using a Nextstep dialog. +Return a string describing the selected font. + +FRAME is the frame on which to pop up the font chooser. If omitted or +nil, it defaults to the selected frame. */) + (Lisp_Object frame, Lisp_Object ignored) { struct frame *f = decode_window_system_frame (frame); - id fm = [NSFontManager sharedFontManager]; - struct font *font = f->output_data.ns->font; - NSFont *nsfont; -#ifdef NS_IMPL_GNUSTEP - nsfont = ((struct nsfont_info *)font)->nsfont; -#endif -#ifdef NS_IMPL_COCOA - nsfont = (NSFont *) macfont_get_nsctfont (font); -#endif - [fm setSelectedFont: nsfont isMultiple: NO]; - [fm orderFrontFontPanel: NSApp]; - return Qnil; -} + Lisp_Object font = [FRAME_NS_VIEW (f) showFontPanel]; + if (NILP (font)) + quit (); + + return font; +} DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel, 0, 1, "", @@ -3299,7 +3295,7 @@ - (Lisp_Object)lispString defsubr (&Sns_emacs_info_panel); defsubr (&Sns_list_services); defsubr (&Sns_perform_service); - defsubr (&Sns_popup_font_panel); + defsubr (&Sx_select_font); defsubr (&Sns_popup_color_panel); defsubr (&Sx_show_tip); diff --git a/src/nsterm.h b/src/nsterm.h index 5b121ede98..9d8a6f486f 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -442,23 +442,25 @@ typedef id instancetype; #else @interface EmacsView : NSView #endif - { +{ #ifdef NS_IMPL_COCOA - char *old_title; - BOOL maximizing_resize; + char *old_title; + BOOL maximizing_resize; #endif - BOOL windowClosing; - NSString *workingText; - BOOL processingCompose; - int fs_state, fs_before_fs, next_maximized; - int maximized_width, maximized_height; - EmacsWindow *nonfs_window; - BOOL fs_is_native; + BOOL font_panel_active; + NSFont *font_panel_result; + BOOL windowClosing; + NSString *workingText; + BOOL processingCompose; + int fs_state, fs_before_fs, next_maximized; + int maximized_width, maximized_height; + EmacsWindow *nonfs_window; + BOOL fs_is_native; @public - struct frame *emacsframe; - int scrollbarsNeedingUpdate; - NSRect ns_userRect; - } + struct frame *emacsframe; + int scrollbarsNeedingUpdate; + NSRect ns_userRect; +} /* AppKit-side interface */ - (instancetype)menuDown: (id)sender; @@ -485,6 +487,7 @@ typedef id instancetype; #ifdef NS_IMPL_GNUSTEP - (void)windowDidMove: (id)sender; #endif +- (Lisp_Object) showFontPanel; - (int)fullscreenState; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 diff --git a/src/nsterm.m b/src/nsterm.m index 5d2e74ad56..5e70e0d566 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4442,10 +4442,10 @@ in certain situations (rapid incoming events). } -int -ns_select (int nfds, fd_set *readfds, fd_set *writefds, - fd_set *exceptfds, struct timespec *timeout, - sigset_t *sigmask) +static int +ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timespec *timeout, + sigset_t *sigmask, BOOL run_loop_only) /* -------------------------------------------------------------------------- Replacement for select, checking for events -------------------------------------------------------------------------- */ @@ -4461,7 +4461,7 @@ in certain situations (rapid incoming events). check_native_fs (); #endif - if (hold_event_q.nr > 0) + if (hold_event_q.nr > 0 && !run_loop_only) { /* We already have events pending. */ raise (SIGIO); @@ -4479,12 +4479,12 @@ in certain situations (rapid incoming events). if (NSApp == nil || ![NSThread isMainThread] || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) - return thread_select(pselect, nfds, readfds, writefds, - exceptfds, timeout, sigmask); + return thread_select (pselect, nfds, readfds, writefds, + exceptfds, timeout, sigmask); else { struct timespec t = {0, 0}; - thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask); + thread_select (pselect, 0, NULL, NULL, NULL, &t, sigmask); } /* FIXME: This draining of outerpool causes a crash when a buffer @@ -4602,6 +4602,15 @@ in certain situations (rapid incoming events). return result; } +int +ns_select (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timespec *timeout, + sigset_t *sigmask) +{ + return ns_select_1 (nfds, readfds, writefds, exceptfds, + timeout, sigmask, NO); +} + #ifdef HAVE_PTHREAD void ns_run_loop_break (void) @@ -6082,40 +6091,72 @@ - (void)dealloc /* Called on font panel selection. */ -- (void)changeFont: (id)sender +- (void) changeFont: (id) sender { - struct face *face = FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID); - struct font *font = face->font; - id newFont; - CGFloat size; + struct font *font = FRAME_OUTPUT_DATA (emacsframe)->font; NSFont *nsfont; - struct input_event ie; - - NSTRACE ("[EmacsView changeFont:]"); - EVENT_INIT (ie); #ifdef NS_IMPL_GNUSTEP - nsfont = ((struct nsfont_info *)font)->nsfont; -#endif -#ifdef NS_IMPL_COCOA + nsfont = ((struct nsfont_info *) font)->nsfont; +#else nsfont = (NSFont *) macfont_get_nsctfont (font); #endif - if ((newFont = [sender convertFont: nsfont])) - { - ie.kind = NS_NONKEY_EVENT; - ie.modifiers = 0; - ie.code = KEY_NS_CHANGE_FONT; - XSETFRAME (ie.frame_or_window, emacsframe); + if (!font_panel_active) + return; - size = [newFont pointSize]; - ns_input_fontsize = make_fixnum (lrint (size)); - ns_input_font = [[newFont familyName] lispString]; + if (font_panel_result) + [font_panel_result release]; - kbd_buffer_store_event (&ie); - } + font_panel_result = (NSFont *) [sender convertFont: nsfont]; + + if (font_panel_result) + [font_panel_result retain]; + + font_panel_active = NO; + [NSApp stop: self]; } +- (Lisp_Object) showFontPanel +{ + id fm = [NSFontManager sharedFontManager]; + struct font *font = FRAME_OUTPUT_DATA (emacsframe)->font; + NSFont *nsfont, *result; + struct timespec timeout; + +#ifdef NS_IMPL_GNUSTEP + nsfont = ((struct nsfont_info *) font)->nsfont; +#else + nsfont = (NSFont *) macfont_get_nsctfont (font); +#endif + + [fm setSelectedFont: nsfont isMultiple: NO]; + [fm orderFrontFontPanel: NSApp]; + + font_panel_active = YES; + timeout = make_timespec (0, 100000000); + + block_input (); + while (font_panel_active + && [[fm fontPanel: YES] isVisible]) + ns_select_1 (0, NULL, NULL, NULL, &timeout, NULL, YES); + unblock_input (); + + if (font_panel_result) + [font_panel_result autorelease]; + + result = font_panel_result; + font_panel_result = nil; + + [[fm fontPanel: YES] setIsVisible: NO]; + font_panel_active = NO; + + /* TODO: return a font spec instead of a string. */ + if (result) + return [[result familyName] lispString]; + + return Qnil; +} - (BOOL)acceptsFirstResponder { @@ -6123,7 +6164,6 @@ - (BOOL)acceptsFirstResponder return YES; } - - (void)resetCursorRects { NSRect visible = [self visibleRect]; commit 7c8bec9e1ffe087918f6f218fc4560fc968aebb2 Author: Lars Ingebrigtsen Date: Sun May 1 13:40:13 2022 +0200 Don't enter the debugger from *Backtrace* or edebug on eval errors * doc/lispref/debugging.texi (Error Debugging): Document it. * doc/lispref/edebug.texi (Edebug Eval): Mention it. * lisp/emacs-lisp/debug.el (debug-allow-recursive-debug): New user option (bug#36145). (debugger-eval-expression): Use it. * lisp/emacs-lisp/edebug.el (edebug-eval-expression): Ditto. This patch is based on a patch by Noam Postavsky. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index c258a9adc0..058c931954 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -194,6 +194,17 @@ If you set @code{debug-on-message} to a regular expression, Emacs will enter the debugger if it displays a matching message in the echo area. For example, this can be useful when trying to find the cause of a particular message. +@end defvar + +@defvar debug-allow-recursive-debug +You can evaluate forms in the current stack frame in the +@samp{*Backtrace*} buffer with the @key{e} command, and while +edebugging you can use the @key{e} and @key{C-x C-e} commands to do +something similar. By default, the debugger is inhibited by these +commands (because (re-)entering the debugger at this point will +usually take you out of the debugging context you're in). Set +@code{debug-allow-recursive-debug} to a non-@code{nil} value to allow +these commands to enter the debugger recursively. @end defvar To debug an error that happens during loading of the init @@ -520,6 +531,7 @@ Flag the current frame like @kbd{b}. Then continue execution like @kbd{c}, but temporarily disable break-on-entry for all functions that are set up to do so by @code{debug-on-entry}. +@vindex debug-allow-recursive-debug @item e Read a Lisp expression in the minibuffer, evaluate it (with the relevant lexical environment, if applicable), and print the @@ -528,7 +540,11 @@ variables, and the current buffer, as part of its operation; @kbd{e} temporarily restores their values from outside the debugger, so you can examine and change them. This makes the debugger more transparent. By contrast, @kbd{M-:} does nothing special in the debugger; it shows you -the variable values within the debugger. +the variable values within the debugger. By default, this command +suppresses the debugger during evaluation, so that an error in the +evaluated expression won't add a new error on top of the existing one. +Set the @code{debug-allow-recursive-debug} user option to a +non-@code{nil} value to override this. @item R Like @kbd{e}, but also save the result of evaluation in the diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index eff9621628..0fc5271d5a 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -700,8 +700,12 @@ on this process. @table @kbd @item e @var{exp} @key{RET} Evaluate expression @var{exp} in the context outside of Edebug -(@code{edebug-eval-expression}). That is, Edebug tries to minimize its -interference with the evaluation. +(@code{edebug-eval-expression}). That is, Edebug tries to minimize +its interference with the evaluation. By default, this command +suppresses the debugger during evaluation, so that an error in the +evaluated expression won't add a new error on top of the existing one. +Set the @code{debug-allow-recursive-debug} user option to a +non-@code{nil} value to override this. @item M-: @var{exp} @key{RET} Evaluate expression @var{exp} in the context of Edebug itself diff --git a/etc/NEWS b/etc/NEWS index 88b4e59e26..090d0b6ddd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -686,6 +686,14 @@ script that was used in ancient South Asia. A new input method, * Changes in Specialized Modes and Packages in Emacs 29.1 +** Debugging + +*** New user option 'debug-allow-recursive-debug'. +This user option controls whether the 'e' (in a *Backtrace* +buffer or while edebugging) and 'C-x C-e' (while edebugging) commands +lead to a (further) backtrace. By default, this variable is nil, +which is a change in behaviour from previous Emacs versions. + ** Compile +++ diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 46b0306d64..91e9b0716d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -90,6 +90,11 @@ The value used here is passed to `quit-restore-window'." :group 'debugger :version "24.3") +(defcustom debug-allow-recursive-debug nil + "If non-nil, erroring in debug and edebug won't recursively debug." + :type 'boolean + :version "29.1") + (defvar debugger-step-after-exit nil "Non-nil means \"single-step\" after the debugger exits.") @@ -534,7 +539,13 @@ The environment used is the one when entering the activation frame at point." (error 0)))) ;; If on first line. (base (debugger--backtrace-base))) (debugger-env-macro - (let ((val (backtrace-eval exp nframe base))) + (let ((val (if debug-allow-recursive-debug + (backtrace-eval exp nframe base) + (condition-case err + (backtrace-eval exp nframe base) + (error (format "%s: %s" + (get (car err) 'error-message) + (car (cdr err)))))))) (prog1 (debugger--print val t) (let ((str (eval-expression-print-format val))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 722283b88f..85545f9f35 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -57,6 +57,7 @@ (require 'cl-lib) (require 'seq) (eval-when-compile (require 'pcase)) +(require 'debug) ;;; Options @@ -3713,7 +3714,9 @@ Print result in minibuffer." (interactive (list (read--expression "Eval: "))) (princ (edebug-outside-excursion - (let ((result (edebug-eval expr))) + (let ((result (if debug-allow-recursive-debug + (edebug-eval expr) + (edebug-safe-eval expr)))) (values--store-value result) (concat (edebug-safe-prin1-to-string result) (eval-expression-print-format result)))))) commit 81ce4b0e4ee18520f174cc5b46219e4475fcc956 Author: Lars Ingebrigtsen Date: Sun May 1 13:07:14 2022 +0200 Correct Using Debugger lispref node * doc/lispref/debugging.texi (Using Debugger): Make documentation reflect reality (bug#36145). diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 469ff2d943..c258a9adc0 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -387,11 +387,9 @@ possibilities.) variable is temporarily set according to @code{eval-expression-debug-on-error}. If the latter variable is non-@code{nil}, @code{debug-on-error} will temporarily be set to -@code{t}. This means that any further errors that occur while doing a -debugging session will (by default) trigger another backtrace. If -this is not what you want, you can either set -@code{eval-expression-debug-on-error} to @code{nil}, or set -@code{debug-on-error} to @code{nil} in @code{debugger-mode-hook}. +@code{t}. However, further errors that occur while debugging won't +(by default) trigger another debugger, because @code{inhibit-debugger} +will also be bound to non-@code{nil}. The debugger itself must be run byte-compiled, since it makes assumptions about the state of the Lisp interpreter. These commit 730ad4a3733203d24c9d0a8db6fde0aa087034ca Author: Lars Ingebrigtsen Date: Sun May 1 12:47:31 2022 +0200 Make scroll-other-window respect target window remappings * lisp/window.el (scroll-other-window, scroll-other-window-down): Moved from window.c and change implementation so that they respect command remappings in the target window (bug#20236). diff --git a/etc/NEWS b/etc/NEWS index fc7432669c..88b4e59e26 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -586,6 +586,15 @@ available options can be restored by enabling this option. * Editing Changes in Emacs 29.1 +--- +** 'scroll-other-window' and 'scroll-other-window-down' now respects remapping. +These commands (bound to 'C-M-v' and 'C-M-V') used to scroll the other +windows without looking a customizations in that other window. These +functions now check whether they have been rebound in the buffer in +that other window, and then call the remapped function instead. In +addition, these commands now also respect the +'scroll-error-top-bottom' user option. + --- ** Indentation of 'cl-flet' and 'cl-labels' has changed. These forms now indent like this: diff --git a/lisp/window.el b/lisp/window.el index 5ceec77bd3..9f78784612 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10093,6 +10093,24 @@ If ARG is the atom `-', scroll upward by nearly full screen." (put 'scroll-down-command 'scroll-command t) +(defun scroll-other-window (&optional lines) + "Scroll next window upward LINES lines; or near full screen if no ARG. +See `scroll-up-command' for details." + (interactive "P") + (with-selected-window (other-window-for-scrolling) + (funcall (or (command-remapping #'scroll-up-command) + #'scroll-up-command) + lines))) + +(defun scroll-other-window-down (&optional lines) + "Scroll next window downward LINES lines; or near full screen if no ARG. +See `scroll-down-command' for details." + (interactive "P") + (with-selected-window (other-window-for-scrolling) + (funcall (or (command-remapping #'scroll-down-command) + #'scroll-down-command) + lines))) + ;;; Scrolling commands which scroll a line instead of full screen. (defun scroll-up-line (&optional arg) diff --git a/src/window.c b/src/window.c index cfe3977428..6d28384eeb 100644 --- a/src/window.c +++ b/src/window.c @@ -6334,36 +6334,6 @@ followed by all visible frames on the current terminal. */) return window; } -DEFUN ("scroll-other-window", Fscroll_other_window, Sscroll_other_window, 0, 1, "P", - doc: /* Scroll next window upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. If ARG is the atom `-', scroll -downward by nearly full screen. When calling from a program, supply -as argument a number, nil, or `-'. - -The next window is usually the one below the current one; -or the one at the top if the current one is at the bottom. -It is determined by the function `other-window-for-scrolling', -which see. - -Also see the `other-window-scroll-default' variable. */) - (Lisp_Object arg) -{ - specpdl_ref count = SPECPDL_INDEX (); - scroll_command (Fother_window_for_scrolling (), arg, 1); - return unbind_to (count, Qnil); -} - -DEFUN ("scroll-other-window-down", Fscroll_other_window_down, - Sscroll_other_window_down, 0, 1, "P", - doc: /* Scroll next window downward ARG lines; or near full screen if no ARG. -For more details, see the documentation for `scroll-other-window'. */) - (Lisp_Object arg) -{ - specpdl_ref count = SPECPDL_INDEX (); - scroll_command (Fother_window_for_scrolling (), arg, -1); - return unbind_to (count, Qnil); -} DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "^P\np", doc: /* Scroll selected window display ARG columns left. @@ -8608,8 +8578,6 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Sscroll_left); defsubr (&Sscroll_right); defsubr (&Sother_window_for_scrolling); - defsubr (&Sscroll_other_window); - defsubr (&Sscroll_other_window_down); defsubr (&Sminibuffer_selected_window); defsubr (&Srecenter); defsubr (&Swindow_text_width); commit 8734d60b053852a6cf4dca59da4c5876820fa7d2 Author: Eli Zaretskii Date: Sun May 1 13:06:33 2022 +0300 Improve documentation of 'malloc-trim' * src/alloc.c (Fmalloc_trim): Fix the doc string. * etc/NEWS: Document which systems support 'malloc-trim'. diff --git a/etc/NEWS b/etc/NEWS index 371fbc2145..fc7432669c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1547,7 +1547,8 @@ functions. --- ** New function 'malloc-trim'. This function allows returning unused memory back to the operating -system, and is mainly meant as a debugging tool. +system, and is mainly meant as a debugging tool. It is currently +available only when Emacs was built with glibc as the C library. --- ** 'x-show-tip' no longer hard-codes a timeout default. diff --git a/src/alloc.c b/src/alloc.c index 661f37dd5c..43fbbb79be 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7481,14 +7481,14 @@ arenas. */) #ifdef HAVE_MALLOC_TRIM DEFUN ("malloc-trim", Fmalloc_trim, Smalloc_trim, 0, 1, "", - doc: /* Release free memory from the heap. -This function asks libc to return unused memory back to the operating + doc: /* Release free heap memory to the OS. +This function asks libc to return unused heap memory back to the operating system. This function isn't guaranteed to do anything, and is mainly meant as a debugging tool. If LEAVE_PADDING is given, ask the system to leave that much unused -spaced in the heap. This should be an integer, and if not given, -defaults to 0. +space in the heap of the Emacs process. This should be an integer, and if +not given, it defaults to 0. This function returns nil if no memory could be returned to the system, and non-nil if some memory could be returned. */) commit 29f3d4d2c69a0e9d2ab0a13ee6952fa9cf4d6035 Author: Lars Ingebrigtsen Date: Sun May 1 11:51:35 2022 +0200 Add new function `malloc-trim' * configure.ac (PGTK_LIBS): Check for malloc_trim. * src/alloc.c (Fmalloc_trim): Add new function (bug#45200). diff --git a/configure.ac b/configure.ac index 53e5779e2f..b7189593a6 100644 --- a/configure.ac +++ b/configure.ac @@ -2939,6 +2939,8 @@ fi AC_SUBST(PGTK_OBJ) AC_SUBST(PGTK_LIBS) +AC_CHECK_FUNCS(malloc_trim) + dnl D-Bus has been tested under GNU/Linux only. Must be adapted for dnl other platforms. HAVE_DBUS=no diff --git a/etc/NEWS b/etc/NEWS index 3f22e0b04e..371fbc2145 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1544,6 +1544,11 @@ functions. * Lisp Changes in Emacs 29.1 +--- +** New function 'malloc-trim'. +This function allows returning unused memory back to the operating +system, and is mainly meant as a debugging tool. + --- ** 'x-show-tip' no longer hard-codes a timeout default. The new 'x-show-tooltip-timeout' variable allows the user to alter diff --git a/src/alloc.c b/src/alloc.c index b9712859c3..661f37dd5c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7479,6 +7479,37 @@ arenas. */) } #endif +#ifdef HAVE_MALLOC_TRIM +DEFUN ("malloc-trim", Fmalloc_trim, Smalloc_trim, 0, 1, "", + doc: /* Release free memory from the heap. +This function asks libc to return unused memory back to the operating +system. This function isn't guaranteed to do anything, and is mainly +meant as a debugging tool. + +If LEAVE_PADDING is given, ask the system to leave that much unused +spaced in the heap. This should be an integer, and if not given, +defaults to 0. + +This function returns nil if no memory could be returned to the +system, and non-nil if some memory could be returned. */) + (Lisp_Object leave_padding) +{ + int pad = 0; + + if (! NILP (leave_padding)) + { + CHECK_FIXNAT (leave_padding); + pad = XFIXNUM (leave_padding); + } + + /* 1 means that memory was released to the system. */ + if (malloc_trim (pad) == 1) + return Qt; + else + return Qnil; +} +#endif + static bool symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj) { @@ -7829,6 +7860,9 @@ N should be nonnegative. */); (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 10) defsubr (&Smalloc_info); +#endif +#ifdef HAVE_MALLOC_TRIM + defsubr (&Smalloc_trim); #endif defsubr (&Ssuspicious_object); commit 6984f325bdbaf15b1190d0d03b01eebe9cfbbb71 Author: Po Lu Date: Sun May 1 09:08:33 2022 +0000 Fix specifying zero as a size for fonts on Haiku * src/haiku_support.cc (MessageReceived): Set `size_specified' correctly. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 67b7e143bf..9e31e1b870 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2519,15 +2519,13 @@ class EmacsFontSelectionDialog : public BWindow else if (msg->what == B_OK && font_style_pane.CurrentSelection () >= 0) { + text = size_entry.Text (); + rq.cancel = false; rq.family_idx = font_family_pane.CurrentSelection (); rq.style_idx = font_style_pane.CurrentSelection (); - - text = size_entry.Text (); rq.size = atoi (text); - - if (rq.size > 0) - rq.size_specified = true; + rq.size_specified = rq.size > 0 || strlen (text); write_port (comm_port, 0, &rq, sizeof rq); } commit 7c50fb248d83ac02331fa717ebad96f1d56d5575 Author: Po Lu Date: Sun May 1 08:53:51 2022 +0000 Improve display of Haiku font dialog * src/haiku_support.cc (EmacsFontSelectionDialog) (class EmacsFontSelectionDialog, FrameResized): Set minimum size based on individual view dimensions and add label to size control. (BWindow_set_min_size): Delete function. * src/haiku_support.h: Update prototypes. * src/haikuterm.c (haiku_update_size_hints): Stop setting min size, since that doesn't work correctly on Haiku. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index d8a064ccac..67b7e143bf 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2565,7 +2565,7 @@ class EmacsFontSelectionDialog : public BWindow : BWindow (BRect (0, 0, 500, 500), "Select font from list", B_TITLED_WINDOW_LOOK, - B_NORMAL_WINDOW_FEEL, 0), + B_MODAL_APP_WINDOW_FEEL, 0), basic_view (NULL, 0), font_family_pane (BRect (0, 0, 10, 10), NULL, B_SINGLE_SELECTION_LIST, @@ -2584,14 +2584,15 @@ class EmacsFontSelectionDialog : public BWindow cancel_button ("Cancel", "Cancel", new BMessage (B_CANCEL)), ok_button ("OK", "OK", new BMessage (B_OK)), - size_entry (NULL, NULL, NULL, NULL), + size_entry (NULL, "Size:", NULL, NULL), allow_monospace_only (monospace_only) { BStringItem *family_item; int i, n_families; font_family name; - uint32 flags; + uint32 flags, c; BMessage *selection; + BTextView *size_text; AddChild (&basic_view); @@ -2638,12 +2639,20 @@ class EmacsFontSelectionDialog : public BWindow font_family_pane.AddItem (family_item); } } + + size_text = size_entry.TextView (); + + for (c = 0; c <= 47; ++c) + size_text->DisallowChar (c); + + for (c = 58; c <= 127; ++c) + size_text->DisallowChar (c); } void FrameResized (float new_width, float new_height) { - BRect frame = Frame (); + BRect frame; float ok_height, ok_width; float cancel_height, cancel_width; float size_width, size_height; @@ -2658,6 +2667,10 @@ class EmacsFontSelectionDialog : public BWindow max_height = std::max (std::max (ok_height, cancel_height), size_height); + SetSizeLimits (cancel_width + ok_width + size_width + 6, + 65535, max_height + 64, 65535); + frame = Frame (); + basic_view.ResizeTo (BE_RECT_WIDTH (frame), BE_RECT_HEIGHT (frame)); split_view.ResizeTo (BE_RECT_WIDTH (frame), BE_RECT_HEIGHT (frame) - 4 - max_height); @@ -2673,7 +2686,8 @@ class EmacsFontSelectionDialog : public BWindow ok_button.ResizeTo (ok_width, ok_height); cancel_button.ResizeTo (cancel_width, cancel_height); - size_entry.ResizeTo (BE_RECT_WIDTH (frame) / 6, + size_entry.ResizeTo (std::max (size_width, + BE_RECT_WIDTH (frame) / 4), size_height); } @@ -4405,17 +4419,6 @@ be_get_display_screens (void) } /* Set the minimum width the user can resize WINDOW to. */ -void -BWindow_set_min_size (void *window, int width, int height) -{ - BWindow *w = (BWindow *) window; - - if (!w->LockLooper ()) - gui_abort ("Failed to lock window looper setting min size"); - w->SetSizeLimits (width, -1, height, -1); - w->UnlockLooper (); -} - /* Synchronize WINDOW's connection to the App Server. */ void BWindow_sync (void *window) diff --git a/src/haiku_support.h b/src/haiku_support.h index c9b408589f..5522468fb3 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -468,7 +468,6 @@ extern void BWindow_change_decoration (void *, int); extern void BWindow_set_tooltip_decoration (void *); extern void BWindow_set_avoid_focus (void *, int); extern void BWindow_zoom (void *); -extern void BWindow_set_min_size (void *, int, int); extern void BWindow_set_size_alignment (void *, int, int); extern void BWindow_sync (void *); extern void BWindow_send_behind (void *, void *); diff --git a/src/haikuterm.c b/src/haikuterm.c index 1dbe3598ff..bdec82db7a 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -144,23 +144,15 @@ get_string_resource (void *ignored, const char *name, const char *class) static void haiku_update_size_hints (struct frame *f) { - int base_width, base_height; - eassert (FRAME_HAIKU_P (f) && FRAME_HAIKU_WINDOW (f)); - if (f->tooltip) return; - base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); - base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); - block_input (); BWindow_set_size_alignment (FRAME_HAIKU_WINDOW (f), - frame_resize_pixelwise ? 1 : FRAME_COLUMN_WIDTH (f), - frame_resize_pixelwise ? 1 : FRAME_LINE_HEIGHT (f)); - BWindow_set_min_size (FRAME_HAIKU_WINDOW (f), base_width, - base_height - + FRAME_TOOL_BAR_HEIGHT (f) - + FRAME_MENU_BAR_HEIGHT (f)); + (frame_resize_pixelwise + ? 1 : FRAME_COLUMN_WIDTH (f)), + (frame_resize_pixelwise + ? 1 : FRAME_LINE_HEIGHT (f))); unblock_input (); } commit 159d8f7a0afec26382d570ad95a1a3b2559f642d Author: Lars Ingebrigtsen Date: Sun May 1 10:20:07 2022 +0200 Fix the mm-decode-content-transfer-encoding overflow better * lisp/gnus/mm-bodies.el (mm-decode-content-transfer-encoding): Use it. (mm-base64-line-p): New function. diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 9f2f80b472..0d4237a64c 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -201,8 +201,11 @@ If TYPE is `text/plain' CRLF->LF translation may occur." ;; mailing list software by finding the final line with ;; base64 text. (goto-char (point-max)) - (when (re-search-backward "[A-Za-z0-9+/]{3,3}=?[\t ]*$" nil t) - (forward-line)) + (beginning-of-line) + (while (and (not (mm-base64-line-p)) + (not (bobp))) + (forward-line -1)) + (forward-line 1) (point)))) ((memq encoding '(nil 7bit 8bit binary)) ;; Do nothing. @@ -235,6 +238,18 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) +(defun mm-base64-line-p () + "Say whether the current line is base64." + ;; This is coded in this way to avoid using regexps that may + ;; overflow -- a base64 line may be megabytes long. + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (skip-chars-forward "A-Za-z0-9+") + (skip-chars-forward "=") + (skip-chars-forward " \t") + (eolp))) + (defun mm-decode-body (charset &optional encoding type) "Decode the current article that has been encoded with ENCODING to CHARSET. ENCODING is a MIME content transfer encoding. commit 2fcbc74c335d812c906028a800b5bc4d844f0d53 Author: Po Lu Date: Sun May 1 07:20:25 2022 +0000 * lisp/menu-bar.el (menu-bar-search-menu): Remove extra separator. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 44922a016a..9a3181afb8 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -339,10 +339,6 @@ (defvar menu-bar-search-menu (let ((menu (make-sparse-keymap "Search"))) - - (bindings--define-key menu [separator-tag-isearch] - menu-bar-separator) - (bindings--define-key menu [tags-continue] '(menu-item "Continue Tags Search" fileloop-continue :enable (and (featurep 'fileloop)