commit c4a67a405072601b9d7dd95dc94c0b402e1e0ae6 (HEAD, refs/remotes/origin/master) Author: Manuel Giraud Date: Mon Feb 3 16:57:58 2025 +0100 Fix OpenBSD compilation (bug#76009) * configure.ac: Remove a bogus LD_SWITCH_SYSTEM for OpenBSD. diff --git a/configure.ac b/configure.ac index 7b4c03c0908..33d04a5bdb9 100644 --- a/configure.ac +++ b/configure.ac @@ -2161,9 +2161,7 @@ case "$opsys" in ;; openbsd) - ## Han Boetes says this is necessary, - ## otherwise Emacs dumps core on elf systems. - LD_SWITCH_SYSTEM="-Z" + : ;; esac AC_SUBST([LD_SWITCH_SYSTEM]) commit f3ac16b3cc5778041332bb46f819a51e8b697099 Author: Stefan Monnier Date: Mon Feb 3 16:33:39 2025 -0500 (save-place-abbreviate-file-names): Don't eagerly load alist (bug#75730) Change the way we handle `save-place-abbreviate-file-names` such that this preference is applied lazily when we load the alist, rather than eagerly when we define it (which forced the alist to be loaded before we needed it). * lisp/saveplace.el (save-place-load-alist-from-file): Use `unless`, `when`, and `with-temp-buffer` to hopefully help readability. Call `save-place--normalize-alist`. (save-place--normalize-alist): New function extracted from the setter of `save-place-abbreviate-file-names`. (save-place-abbreviate-file-names): Use it. (save-place-alist-to-file): Use `with-temp-buffer`. diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 37b657073cc..b6c57d2da80 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -101,47 +101,44 @@ this happens automatically before saving `save-place-alist' to :type 'boolean) (defun save-place-load-alist-from-file () - (if (not save-place-loaded) - (progn - (setq save-place-loaded t) - (let ((file (expand-file-name save-place-file))) - ;; make sure that the alist does not get overwritten, and then - ;; load it if it exists: - (if (file-readable-p file) - ;; don't want to use find-file because we have been - ;; adding hooks to it. - (with-current-buffer (get-buffer-create " *Saved Places*") - (delete-region (point-min) (point-max)) - ;; Make sure our 'coding:' cookie in the save-place - ;; file will take effect, in case the caller binds - ;; coding-system-for-read. - (let (coding-system-for-read) - (insert-file-contents file)) - (goto-char (point-min)) - (setq save-place-alist - (with-demoted-errors "Error reading save-place-file: %S" - (car (read-from-string - (buffer-substring (point-min) (point-max)))))) - - ;; If there is a limit, and we're over it, then we'll - ;; have to truncate the end of the list: - (if save-place-limit - (if (<= save-place-limit 0) - ;; Zero gets special cased. I'm not thrilled - ;; with this, but the loop for >= 1 is tight. - (setq save-place-alist nil) - ;; Else the limit is >= 1, so enforce it by - ;; counting and then `setcdr'ing. - (let ((s save-place-alist) - (count 1)) - (while s - (if (>= count save-place-limit) - (setcdr s nil) - (setq count (1+ count))) - (setq s (cdr s)))))) - - (kill-buffer (current-buffer)))) - nil)))) + (unless save-place-loaded + (setq save-place-loaded t) + ;; FIXME: Obey `save-place-abbreviate-file-names'? + (let ((file (expand-file-name save-place-file))) + ;; make sure that the alist does not get overwritten, and then + ;; load it if it exists: + (when (file-readable-p file) + ;; don't want to use find-file because we have been + ;; adding hooks to it. + (with-temp-buffer + ;; Make sure our 'coding:' cookie in the save-place + ;; file will take effect, in case the caller binds + ;; coding-system-for-read. + (let (coding-system-for-read) + (insert-file-contents file)) + (goto-char (point-min)) + (setq save-place-alist + (with-demoted-errors "Error reading save-place-file: %S" + (car (read-from-string + (buffer-substring (point-min) (point-max)))))) + + ;; If there is a limit, and we're over it, then we'll + ;; have to truncate the end of the list: + (if save-place-limit + (if (<= save-place-limit 0) + ;; Zero gets special cased. I'm not thrilled + ;; with this, but the loop for >= 1 is tight. + (setq save-place-alist nil) + ;; Else the limit is >= 1, so enforce it by + ;; counting and then `setcdr'ing. + (let ((s save-place-alist) + (count 1)) + (while s + (if (>= count save-place-limit) + (setcdr s nil) + (setq count (1+ count))) + (setq s (cdr s)))))))) + (save-place--normalize-alist)))) (defcustom save-place-abbreviate-file-names nil "If non-nil, abbreviate file names before saving them. @@ -154,27 +151,32 @@ just using `setq' may cause out-of-sync problems. You should use either `setopt' or \\[customize-variable] to set this option." :type 'boolean :set (lambda (sym val) - (set-default sym val) - (or save-place-loaded (save-place-load-alist-from-file)) - (let ((fun (if val #'abbreviate-file-name #'expand-file-name)) - ;; Don't expand file names for non-existing remote connections. - (non-essential t)) - (setq save-place-alist - (cl-delete-duplicates - (cl-loop for (k . v) in save-place-alist - collect - (cons (funcall fun k) - (if (listp v) - (cl-loop for (k1 . v1) in v - collect - (cons k1 (funcall fun v1))) - v))) - :key #'car - :from-end t - :test #'equal))) - val) + (let ((old (if (default-boundp sym) (default-value sym)))) + (set-default sym val) + (if (or (equal old val) (not save-place-loaded)) + nil ;Nothing to do. + (save-place--normalize-alist)))) :version "28.1") +(defun save-place--normalize-alist () + (let ((fun (if save-place-abbreviate-file-names + #'abbreviate-file-name #'expand-file-name)) + ;; Don't expand file names for non-existing remote connections. + (non-essential t)) + (setq save-place-alist + (cl-delete-duplicates + (cl-loop for (k . v) in save-place-alist + collect + (cons (funcall fun k) + (if (listp v) + (cl-loop for (k1 . v1) in v + collect + (cons k1 (funcall fun v1))) + v))) + :key #'car + :from-end t + :test #'equal)))) + (defcustom save-place-save-skipped t "If non-nil, remember files matching `save-place-skip-check-regexp'. @@ -273,7 +275,6 @@ Use `setopt' or Customize commands to set this option." This means when you visit a file, point goes to the last place where it was when you previously visited the same file." :global t - :group 'save-place (save-place--setup-hooks save-place-mode) (save-place--manage-timer)) @@ -383,8 +384,7 @@ may have changed) back to `save-place-alist'." (defun save-place-alist-to-file () (let ((file (expand-file-name save-place-file)) (coding-system-for-write 'utf-8)) - (with-current-buffer (get-buffer-create " *Saved Places*") - (delete-region (point-min) (point-max)) + (with-temp-buffer (when save-place-forget-unreadable-files (save-place-forget-unreadable-files)) (insert (format ";;; -*- coding: %s; mode: lisp-data -*-\n" @@ -402,8 +402,7 @@ may have changed) back to `save-place-alist'." (condition-case nil ;; Don't use write-file; we don't want this buffer to visit it. (write-region (point-min) (point-max) file) - (file-error (message "Saving places: can't write %s" file))) - (kill-buffer (current-buffer)))))) + (file-error (message "Saving places: can't write %s" file))))))) (defun save-places-to-alist () ;; go through buffer-list, saving places to alist if save-place-mode commit 14ebe4d5dbd4e6637de227c8561aab22cf4b632c Author: Pip Cet Date: Mon Feb 3 20:40:34 2025 +0000 Fix GC-related crashes in styled_format (bug#75754) This approach ensures we don't use an SSDATA pointer after GC, and that no Lisp callback code can modify the format string while we're working on it. * src/editfns.c (styled_format): Operate on a copy of the format string rather than the original. Ensure final NUL byte is copied. diff --git a/src/editfns.c b/src/editfns.c index 4ba356d627c..f9258392146 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3442,9 +3442,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } *info; CHECK_STRING (args[0]); - char *format_start = SSDATA (args[0]); bool multibyte_format = STRING_MULTIBYTE (args[0]); ptrdiff_t formatlen = SBYTES (args[0]); + char *format_start = SAFE_ALLOCA (formatlen + 1); + memcpy (format_start, SSDATA (args[0]), formatlen + 1); bool fmt_props = !!string_intervals (args[0]); /* Upper bound on number of format specs. Each uses at least 2 chars. */ commit b5316e1ddb728ab7502e2b2fffcc84e9c47316dd Author: Daniel Mendler Date: Mon Feb 3 09:54:47 2025 +0100 read-face-name: Build common completion table for CR and CRM * lisp/faces.el (read-face-name): Build a common completion table for both `completing-read' and `completing-read-multiple' with completion metadata (bug#74865). diff --git a/lisp/faces.el b/lisp/faces.el index 5fe3ab1a294..dd8c24f5001 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1137,19 +1137,30 @@ returned. Otherwise, DEFAULT is returned verbatim." (let ((prompt (if default (format-prompt prompt default) (format "%s: " prompt))) - aliasfaces nonaliasfaces faces) + aliasfaces nonaliasfaces table) ;; Build up the completion tables. (mapatoms (lambda (s) (if (facep s) (if (get s 'face-alias) (push (symbol-name s) aliasfaces) (push (symbol-name s) nonaliasfaces))))) + (setq table + (completion-table-with-metadata + (completion-table-in-turn nonaliasfaces aliasfaces) + `((affixation-function + . ,(lambda (faces) + (mapcar + (lambda (face) + (list face + (concat (propertize read-face-name-sample-text + 'face face) + "\t") + "")) + faces)))))) (if multiple - (progn - (dolist (face (completing-read-multiple - prompt - (completion-table-in-turn nonaliasfaces aliasfaces) - nil t nil 'face-name-history default)) + (let (faces) + (dolist (face (completing-read-multiple prompt table nil t nil + 'face-name-history default)) ;; Ignore elements that are not faces ;; (for example, because DEFAULT was "all faces") (if (facep face) (push (if (stringp face) @@ -1157,21 +1168,8 @@ returned. Otherwise, DEFAULT is returned verbatim." face) faces))) (nreverse faces)) - (let ((face (completing-read - prompt - (completion-table-with-metadata - (completion-table-in-turn nonaliasfaces aliasfaces) - `((affixation-function - . ,(lambda (faces) - (mapcar - (lambda (face) - (list face - (concat (propertize read-face-name-sample-text - 'face face) - "\t") - "")) - faces))))) - nil t nil 'face-name-history defaults))) + (let ((face (completing-read prompt table nil t nil + 'face-name-history defaults))) (when (facep face) (if (stringp face) (intern face) face))))))) commit a22e971a119dfd1385fe38d6f594bccfe8911152 Author: Eli Zaretskii Date: Mon Feb 3 18:36:11 2025 +0200 Fix -nw sessions on MS-Windows * src/w32console.c (w32con_clear_end_of_line): Set the space glyphs' frame to NULL. (w32con_write_glyphs): Handle face_id_frame == NULL, when called from 'w32con_clear_end_of_line'. (tty_draw_row_with_mouse_face): Adjust to changes in term.c. diff --git a/src/w32console.c b/src/w32console.c index 9cfedde3b3f..b18eda437ad 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -167,7 +167,7 @@ w32con_clear_end_of_line (struct frame *f, int end) for (i = 0; i < glyphs_len; i++) { memcpy (&glyphs[i], &space_glyph, sizeof (struct glyph)); - glyphs[i].frame = f; + glyphs[i].frame = NULL; } ceol_initialized = TRUE; } @@ -339,8 +339,10 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string, && string[n].frame == face_id_frame)) break; + /* w32con_clear_end_of_line sets frame of glyphs to NULL. */ + struct frame *attr_frame = face_id_frame ? face_id_frame : f; /* Turn appearance modes of the face of the run on. */ - char_attr = w32_face_attributes (face_id_frame, face_id); + char_attr = w32_face_attributes (attr_frame, face_id); if (n == len) /* This is the last run. */ @@ -425,34 +427,88 @@ w32con_write_glyphs_with_face (struct frame *f, register int x, register int y, /* Implementation of draw_row_with_mouse_face for W32 console. */ void -tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, - int start_hpos, int end_hpos, +tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *window_row, + int window_start_x, int window_end_x, enum draw_glyphs_face draw) { - int nglyphs = end_hpos - start_hpos; struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct tty_display_info *tty = FRAME_TTY (f); - int face_id = tty->mouse_highlight.mouse_face_face_id; - int pos_x, pos_y; - - if (end_hpos >= row->used[TEXT_AREA]) - nglyphs = row->used[TEXT_AREA] - start_hpos; - - pos_y = row->y + WINDOW_TOP_EDGE_Y (w); - pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w); - - if (draw == DRAW_MOUSE_FACE) - w32con_write_glyphs_with_face (f, pos_x, pos_y, - row->glyphs[TEXT_AREA] + start_hpos, - nglyphs, face_id); - else if (draw == DRAW_NORMAL_TEXT) + struct frame *root = root_frame (f); + + /* Window coordinates are relative to the text area. Make + them relative to the window's left edge, */ + window_end_x = min (window_end_x, window_row->used[TEXT_AREA]); + window_start_x += window_row->used[LEFT_MARGIN_AREA]; + window_end_x += window_row->used[LEFT_MARGIN_AREA]; + + /* Translate from window to window's frame. */ + int frame_start_x = WINDOW_LEFT_EDGE_X (w) + window_start_x; + int frame_end_x = WINDOW_LEFT_EDGE_X (w) + window_end_x; + int frame_y = window_row->y + WINDOW_TOP_EDGE_Y (w); + + /* Translate from (possible) child frame to root frame. */ + int root_start_x, root_end_x, root_y; + root_xy (f, frame_start_x, frame_y, &root_start_x, &root_y); + root_xy (f, frame_end_x, frame_y, &root_end_x, &root_y); + struct glyph_row *root_row = MATRIX_ROW (root->current_matrix, root_y); + + /* Remember current cursor coordinates so that we can restore + them at the end. */ + COORD save_coords = cursor_coords; + + /* If the root frame displays child frames, we cannot naively + write to the terminal what the window thinks should be drawn. + Instead, write only those parts that are not obscured by + other frames. */ + for (int root_x = root_start_x; root_x < root_end_x; ) { - COORD save_coords = cursor_coords; + /* Find the start of a run of glyphs from frame F. */ + struct glyph *root_start = root_row->glyphs[TEXT_AREA] + root_x; + while (root_x < root_end_x && root_start->frame != f) + ++root_x, ++root_start; + + /* If start of a run of glyphs from F found. */ + int root_run_start_x = root_x; + if (root_run_start_x < root_end_x) + { + /* Find the end of the run of glyphs from frame F. */ + struct glyph *root_end = root_start; + while (root_x < root_end_x && root_end->frame == f) + ++root_x, ++root_end; - w32con_move_cursor (f, pos_y, pos_x); - write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); - w32con_move_cursor (f, save_coords.Y, save_coords.X); + /* If we have a run glyphs to output, do it. */ + if (root_end > root_start) + { + w32con_move_cursor (root, root_y, root_run_start_x); + + ptrdiff_t nglyphs = root_end - root_start; + switch (draw) + { + case DRAW_NORMAL_TEXT: + write_glyphs (f, root_start, nglyphs); + break; + + case DRAW_MOUSE_FACE: + { + struct tty_display_info *tty = FRAME_TTY (f); + int face_id = tty->mouse_highlight.mouse_face_face_id; + w32con_write_glyphs_with_face (f, root_run_start_x, root_y, + root_start, nglyphs, + face_id); + } + break; + + case DRAW_INVERSE_VIDEO: + case DRAW_CURSOR: + case DRAW_IMAGE_RAISED: + case DRAW_IMAGE_SUNKEN: + emacs_abort (); + } + } + } } + + /* Restore cursor where it was before. */ + w32con_move_cursor (f, save_coords.Y, save_coords.X); } static void commit 1639ad2814ae100c9f878a1388eb9ffc9d208b07 Author: Ulrich Müller Date: Sat Feb 1 23:10:53 2025 +0100 Avoid ln(10) expression in calc units definition * lisp/calc/calc-ext.el (calc-init-extensions): Autoload calc-math for math-ln-10. * lisp/calc/calc-units.el (math-standard-units): Use new ln10 constant instead of ln(10) in the decibel definition. (math-find-base-units-rec): Allow ln10 in expression. (math-to-standard-rec): Recognize the ln10 constant. (Bug#75861) diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 4ec96d3ef53..060d352fe66 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -877,7 +877,7 @@ calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw math-exp-minus-1-raw math-exp-raw math-from-radians math-from-radians-2 math-hypot math-infinite-dir -math-ln-raw math-nearly-equal math-nearly-equal-float +math-ln-10 math-ln-raw math-nearly-equal math-nearly-equal-float math-nearly-zerop math-nearly-zerop-float math-nth-root math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw math-tan-raw math-to-radians math-to-radians-2) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index d2396a9b262..4a638e66132 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -314,7 +314,8 @@ ;; Logarithmic units ( Np nil "*Neper") - ( dB "(ln(10)/20) Np" "decibel")) + ( dB "(ln10/20) Np" "Decibel" nil + "(ln(10)/20) Np")) "List of predefined units for Calc. Each element is (NAME DEF DESC TEMP-UNIT HUMAN-DEF), where: @@ -948,10 +949,9 @@ If COMP or STD is non-nil, put that in the units table instead." ((eq (car expr) '+) (math-find-base-units-rec (nth 1 expr) pow)) ((eq (car expr) 'var) - (or (eq (nth 1 expr) 'pi) + (or (memq (nth 1 expr) '(pi ln10)) (error "Unknown name %s in defining expression for unit %s" (nth 1 expr) (car math-fbu-entry)))) - ((equal expr '(calcFunc-ln 10))) (t (error "Malformed defining expression for unit %s" (car math-fbu-entry)))))) @@ -1055,9 +1055,9 @@ If COMP or STD is non-nil, put that in the units table instead." math-unit-prefixes)) expr))) expr) - (if (eq base 'pi) - (math-pi) - expr))) + (cond ((eq base 'pi) (math-pi)) + ((eq base 'ln10) (math-ln-10)) + (t expr)))) (if (or (Math-primp expr) (and (eq (car-safe expr) 'calcFunc-subscr)