[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 4abb8c8 3/3: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 4abb8c8 3/3: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Mon, 6 Apr 2020 13:11:35 -0400 (EDT) |
branch: feature/native-comp
commit 4abb8c822ce02cf33712bd2699c5b77a5db49e31
Merge: 32a079a 3dc2f50
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Merge remote-tracking branch 'savannah/master' into HEAD
---
doc/emacs/building.texi | 8 +
doc/man/emacs.1.in | 2 +-
etc/NEWS | 6 +
lisp/emacs-lisp/cl-macs.el | 18 +-
lisp/emacs-lisp/re-builder.el | 17 +-
lisp/epg-config.el | 16 +-
lisp/htmlfontify.el | 3 +-
lisp/imenu.el | 14 +-
lisp/mouse.el | 526 ++++++++++++++++++++++-----------------
lisp/net/tramp-cache.el | 6 +-
lisp/net/tramp-sh.el | 14 +-
lisp/progmodes/gdb-mi.el | 75 ++++--
lisp/progmodes/gud.el | 14 +-
lisp/progmodes/project.el | 2 +
lisp/progmodes/xref.el | 1 +
lisp/vc/log-edit.el | 2 +-
src/bignum.c | 36 +++
src/buffer.c | 8 +-
src/character.c | 5 +-
src/charset.c | 33 +--
src/coding.c | 37 ++-
src/emacs-module.c | 2 +-
src/fileio.c | 4 +-
src/frame.c | 99 ++++----
src/lcms.c | 3 +-
src/lisp.h | 23 +-
src/menu.c | 22 +-
src/nsfns.m | 19 +-
src/process.c | 13 +-
src/search.c | 9 +-
src/w32fns.c | 12 +-
src/window.c | 45 ++--
src/xfns.c | 30 +--
src/xterm.c | 4 -
src/xwidget.c | 6 +-
test/lisp/emacs-lisp/rx-tests.el | 6 +
test/lisp/net/tramp-tests.el | 89 +++----
test/lisp/vc/log-edit-tests.el | 25 ++
test/src/coding-tests.el | 19 ++
39 files changed, 712 insertions(+), 561 deletions(-)
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 8a05680..77a0e80 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -1022,6 +1022,14 @@ is the relevant buffer type, such as @samp{breakpoints}.
You can do
the same with the menu bar, with the @samp{GDB-Windows} and
@samp{GDB-Frames} sub-menus of the @samp{GUD} menu.
+@vindex gdb-max-source-window-count
+@vindex gdb-display-source-buffer-action
+By default, GDB uses at most one window to display the source file.
+You can make it use more windows by customizing
+@code{gdb-max-source-window-count}. You can also customize
+@code{gdb-display-source-buffer-action} to control how GDB displays
+source files.
+
When you finish debugging, kill the GUD interaction buffer with
@kbd{C-x k}, which will also kill all the buffers associated with the
session. However you need not do this if, after editing and
diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in
index e1190cf..5a164e9 100644
--- a/doc/man/emacs.1.in
+++ b/doc/man/emacs.1.in
@@ -171,7 +171,7 @@ The editor will send messages to stderr.
You must use \-l and \-f options to specify files to execute
and functions to call.
.TP
-.BI \-\-script= "file"
+.BI \-\-script " file"
Run
.I file
as an Emacs Lisp script.
diff --git a/etc/NEWS b/etc/NEWS
index 81a70e9..1af368c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -233,6 +233,12 @@ will remember the window configuration before GDB started
and restore
it after GDB quits. A toggle button is also provided under 'Gud --
GDB-Windows'.
++++
+*** gdb-mi now has a better logic for displaying source buffers
+Now GDB only uses one source window to display source file by default.
+Customize 'gdb-max-source-window-count' to use more than one window.
+Control source file display by 'gdb-display-source-buffer-action'.
+
** Gravatar
---
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 7f5d197..45a308e 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2970,14 +2970,26 @@ Supported keywords for slots are:
(pcase-dolist (`(,cname ,args ,doc) constrs)
(let* ((anames (cl--arglist-args args))
(make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
- slots defaults)))
- (push `(,cldefsym ,cname
+ slots defaults))
+ ;; `cl-defsubst' is fundamentally broken: it substitutes
+ ;; its arguments into the body's `sexp' much too naively
+ ;; when inlinling, which results in various problems.
+ ;; For example it generates broken code if your
+ ;; argument's name happens to be the same as some
+ ;; function used within the body.
+ ;; E.g. (cl-defsubst sm-foo (list) (list list))
+ ;; will expand `(sm-foo 1)' to `(1 1)' rather than to `(list t)'!
+ ;; Try to catch this known case!
+ (con-fun (or type #'record))
+ (unsafe-cl-defsubst
+ (or (memq con-fun args) (assq con-fun args))))
+ (push `(,(if unsafe-cl-defsubst 'cl-defun cldefsym) ,cname
(&cl-defs (nil ,@descs) ,@args)
,(if (stringp doc) doc
(format "Constructor for objects of type `%s'." name))
,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
'((declare (side-effect-free t))))
- (,(or type #'record) ,@make))
+ (,con-fun ,@make))
forms)))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
;; Don't bother adding to cl-custom-print-functions since it's not used
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 580e914..0e1618e 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -767,22 +767,21 @@ If SUBEXP is non-nil mark only the corresponding
sub-expressions."
(reb-mark-non-matching-parenthesis))
nil)))
-(defsubst reb-while (limit counter where)
- (let ((count (symbol-value counter)))
- (if (= count limit)
- (progn
- (message "Reached (while limit=%s, where=%s)" limit where)
- nil)
- (set counter (1+ count)))))
+(defsubst reb-while (limit current where)
+ (if (< current limit)
+ (1+ current)
+ (message "Reached (while limit=%s, where=%s)" limit where)
+ nil))
(defun reb-mark-non-matching-parenthesis (bound)
;; We have a small string, check the whole of it, but wait until
;; everything else is fontified.
(when (>= bound (point-max))
- (let (left-pars
+ (let ((n-reb 0)
+ left-pars
faces-here)
(goto-char (point-min))
- (while (and (reb-while 100 'n-reb "mark-par")
+ (while (and (setq n-reb (reb-while 100 n-reb "mark-par"))
(not (eobp)))
(skip-chars-forward "^()")
(unless (eobp)
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 74ab651..daa9a5a 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -183,10 +183,18 @@ version requirement is met."
(defun epg-config--make-gpg-configuration (program)
(let (config groups type args)
(with-temp-buffer
- (apply #'call-process program nil (list t nil) nil
- (append (if epg-gpg-home-directory
- (list "--homedir" epg-gpg-home-directory))
- '("--with-colons" "--list-config")))
+ ;; The caller might have bound coding-system-for-* to something
+ ;; like 'no-conversion, but the below needs to call PROGRAM
+ ;; expecting human-readable text in both directions (since we
+ ;; are going to parse the output as text), so let Emacs guess
+ ;; the encoding of that text by its usual encoding-detection
+ ;; machinery.
+ (let ((coding-system-for-read 'undecided)
+ (coding-system-for-write 'undecided))
+ (apply #'call-process program nil (list t nil) nil
+ (append (if epg-gpg-home-directory
+ (list "--homedir" epg-gpg-home-directory))
+ '("--with-colons" "--list-config"))))
(goto-char (point-min))
(while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
(setq type (intern (match-string 1))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 466f6f5..1d98b63 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -628,6 +628,7 @@ STYLE is the inline CSS stylesheet (or tag referring to an
external sheet)."
\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\";>
<html xmlns=\"http://www.w3.org/1999/xhtml\";>
<head>
+ <meta charset=\"utf-8\"/>
<title>%s</title>
%s
<script type=\"text/javascript\"><!--
@@ -1508,7 +1509,7 @@ Uses `hfy-link-style-fun' to do this."
"\n<style type=\"text/css\"><!-- \n"
;; Fix-me: Add handling of page breaks here + scan for ^L
;; where appropriate.
- (format "body %s\n" (cddr (assq 'default css)))
+ (format "body, pre %s\n" (cddr (assq 'default css)))
(apply 'concat
(mapcar
(lambda (style)
diff --git a/lisp/imenu.el b/lisp/imenu.el
index fb8b3de..1949f2f 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -911,11 +911,15 @@ to `imenu-update-menubar'.")
(setq index-alist (imenu--split-submenus index-alist))
(let* ((menu (imenu--split-menu index-alist
(buffer-name)))
- (menu1 (imenu--create-keymap (car menu)
- (cdr (if (< 1 (length (cdr menu)))
- menu
- (car (cdr menu))))
- 'imenu--menubar-select)))
+ (menu1 (imenu--create-keymap
+ (car menu)
+ (cdr (if (or (< 1 (length (cdr menu)))
+ ;; Have we a non-nested single entry?
+ (atom (cdadr menu))
+ (atom (cadadr menu)))
+ menu
+ (car (cdr menu))))
+ 'imenu--menubar-select)))
(setcdr imenu--menubar-keymap (cdr menu1)))))))
(defun imenu--menubar-select (item)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index e58a2e6..9703d95 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -552,7 +552,7 @@ frame instead."
(not (eq (window-frame minibuffer-window) frame))))
;; Drag frame when the window is on the bottom of its frame and
;; there is no minibuffer window below.
- (mouse-drag-frame start-event 'move)))))
+ (mouse-drag-frame-move start-event)))))
(defun mouse-drag-header-line (start-event)
"Change the height of a window by dragging on its header line.
@@ -569,7 +569,7 @@ the frame instead."
(mouse-drag-line start-event 'header)
(let ((frame (window-frame window)))
(when (frame-parameter frame 'drag-with-header-line)
- (mouse-drag-frame start-event 'move))))))
+ (mouse-drag-frame-move start-event))))))
(defun mouse-drag-vertical-line (start-event)
"Change the width of a window by dragging on a vertical line.
@@ -577,46 +577,7 @@ START-EVENT is the starting mouse event of the drag
action."
(interactive "e")
(mouse-drag-line start-event 'vertical))
-(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
- "Helper function for `mouse-drag-frame'."
- (let* ((frame-x-y (frame-position frame))
- (frame-x (car frame-x-y))
- (frame-y (cdr frame-x-y))
- alist)
- (if (> x-diff 0)
- (when x-move
- (setq x-diff (min x-diff frame-x))
- (setq x-move (- frame-x x-diff)))
- (let* ((min-width (frame-windows-min-size frame t nil t))
- (min-diff (max 0 (- (frame-inner-width frame) min-width))))
- (setq x-diff (max x-diff (- min-diff)))
- (when x-move
- (setq x-move (+ frame-x (- x-diff))))))
-
- (if (> y-diff 0)
- (when y-move
- (setq y-diff (min y-diff frame-y))
- (setq y-move (- frame-y y-diff)))
- (let* ((min-height (frame-windows-min-size frame nil nil t))
- (min-diff (max 0 (- (frame-inner-height frame) min-height))))
- (setq y-diff (max y-diff (- min-diff)))
- (when y-move
- (setq y-move (+ frame-y (- y-diff))))))
-
- (unless (zerop x-diff)
- (when x-move
- (push `(left . ,x-move) alist))
- (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
- alist))
- (unless (zerop y-diff)
- (when y-move
- (push `(top . ,y-move) alist))
- (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
- alist))
- (when alist
- (modify-frame-parameters frame alist))))
-
-(defun mouse-drag-frame (start-event part)
+(defun mouse-drag-frame-resize (start-event part)
"Drag a frame or one of its edges with the mouse.
START-EVENT is the starting mouse event of the drag action. Its
position window denotes the frame that will be dragged.
@@ -635,9 +596,144 @@ frame with the mouse."
(frame (if (window-live-p window)
(window-frame window)
window))
- (width (frame-native-width frame))
- (height (frame-native-height frame))
- ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ ;; Initial "first" frame position and size. While dragging we
+ ;; base all calculations against that size and position.
+ (first-pos (frame-position frame))
+ (first-left (car first-pos))
+ (first-top (cdr first-pos))
+ (first-width (frame-text-width frame))
+ (first-height (frame-text-height frame))
+ ;; Don't let FRAME become less large than the size needed to
+ ;; fit all of its windows.
+ (min-text-width
+ (+ (frame-windows-min-size frame t nil t)
+ (- (frame-inner-width frame) first-width)))
+ (min-text-height
+ (+ (frame-windows-min-size frame nil nil t)
+ (- (frame-inner-height frame) first-height)))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ ;; top-level frame, FRAME's workarea.
+ (parent (frame-parent frame))
+ (parent-edges
+ (if parent
+ (frame-edges parent)
+ (let* ((attributes
+ (car (display-monitor-attributes-list)))
+ (workarea (assq 'workarea attributes)))
+ (and workarea
+ `(,(nth 1 workarea) ,(nth 2 workarea)
+ ,(+ (nth 1 workarea) (nth 3 workarea))
+ ,(+ (nth 2 workarea) (nth 4 workarea)))))))
+ (parent-left (and parent-edges (nth 0 parent-edges)))
+ (parent-top (and parent-edges (nth 1 parent-edges)))
+ (parent-right (and parent-edges (nth 2 parent-edges)))
+ (parent-bottom (and parent-edges (nth 3 parent-edges)))
+ ;; Drag types. drag-left/drag-right and drag-top/drag-bottom
+ ;; are mutually exclusive.
+ (drag-left (memq part '(bottom-left left top-left)))
+ (drag-top (memq part '(top-left top top-right)))
+ (drag-right (memq part '(top-right right bottom-right)))
+ (drag-bottom (memq part '(bottom-right bottom bottom-left)))
+ ;; Initial "first" mouse position. While dragging we base all
+ ;; calculations against that position.
+ (first-x-y (mouse-absolute-pixel-position))
+ (first-x (car first-x-y))
+ (first-y (cdr first-x-y))
+ (exitfun nil)
+ (move
+ (lambda (event)
+ (interactive "e")
+ (when (consp event)
+ (let* ((last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ (left (- last-x first-x))
+ (top (- last-y first-y))
+ alist)
+ ;; We never want to warp the mouse position here. When
+ ;; moving the mouse leftward or upward, then with a wide
+ ;; border the calculated left or top position of the
+ ;; frame could drop to a value less than zero depending
+ ;; on where precisely the mouse within the border. We
+ ;; guard against this by never allowing the frame to
+ ;; move to a position less than zero here. No such
+ ;; precautions are used for the right and bottom borders
+ ;; so with a large internal border parts of that border
+ ;; may disappear.
+ (when (and drag-left (>= last-x parent-left)
+ (>= (- first-width left) min-text-width))
+ (push `(left . ,(max (+ first-left left) 0)) alist)
+ (push `(width . (text-pixels . ,(- first-width left)))
+ alist))
+ (when (and drag-top (>= last-y parent-top)
+ (>= (- first-height top) min-text-height))
+ (push `(top . ,(max 0 (+ first-top top))) alist)
+ (push `(height . (text-pixels . ,(- first-height top)))
+ alist))
+ (when (and drag-right (<= last-x parent-right)
+ (>= (+ first-width left) min-text-width))
+ (push `(width . (text-pixels . ,(+ first-width left)))
+ alist))
+ (when (and drag-bottom (<= last-y parent-bottom)
+ (>= (+ first-height top) min-text-height))
+ (push `(height . (text-pixels . ,(+ first-height top)))
+ alist))
+ (modify-frame-parameters frame alist)))))
+ (old-track-mouse track-mouse))
+ ;; Start tracking. The special value 'dragging' signals the
+ ;; display engine to freeze the mouse pointer shape for as long
+ ;; as we drag.
+ (setq track-mouse 'dragging)
+ ;; Loop reading events and sampling the position of the mouse.
+ (setq exitfun
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [switch-frame] #'ignore)
+ (define-key map [select-window] #'ignore)
+ (define-key map [scroll-bar-movement] #'ignore)
+ (define-key map [mouse-movement] move)
+ ;; Swallow drag-mouse-1 events to avoid selecting some other
window.
+ (define-key map [drag-mouse-1]
+ (lambda () (interactive) (funcall exitfun)))
+ ;; Some of the events will of course end up looked up
+ ;; with a mode-line, header-line or vertical-line prefix ...
+ (define-key map [mode-line] map)
+ (define-key map [header-line] map)
+ (define-key map [vertical-line] map)
+ ;; ... and some maybe even with a right- or bottom-divider
+ ;; prefix.
+ (define-key map [right-divider] map)
+ (define-key map [bottom-divider] map)
+ map)
+ t (lambda () (setq track-mouse old-track-mouse))))))
+
+(defun mouse-drag-frame-move (start-event)
+ "Drag a frame or one of its edges with the mouse.
+START-EVENT is the starting mouse event of the drag action. Its
+position window denotes the frame that will be dragged.
+
+PART specifies the part that has been dragged and must be one of
+the symbols `left', `top', `right', `bottom', `top-left',
+`top-right', `bottom-left', `bottom-right' to drag an internal
+border or edge. If PART equals `move', this means to move the
+frame with the mouse."
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let* ((echo-keystrokes 0)
+ (start (event-start start-event))
+ (window (posn-window start))
+ ;; FRAME is the frame to drag.
+ (frame (if (window-live-p window)
+ (window-frame window)
+ window))
+ (native-width (frame-native-width frame))
+ (native-height (frame-native-height frame))
+ ;; Initial "first" frame position and size. While dragging we
+ ;; base all calculations against that size and position.
+ (first-pos (frame-position frame))
+ (first-left (car first-pos))
+ (first-top (cdr first-pos))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
;; top-level frame, FRAME's workarea.
(parent (frame-parent frame))
(parent-edges
@@ -654,19 +750,16 @@ frame with the mouse."
(parent-top (and parent-edges (nth 1 parent-edges)))
(parent-right (and parent-edges (nth 2 parent-edges)))
(parent-bottom (and parent-edges (nth 3 parent-edges)))
- ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
- ;; last sampled mouse position. Note that we sample absolute
- ;; mouse positions to avoid that moving the mouse from one
- ;; frame into another gets into our way. `last-x' and `last-y'
- ;; records the x- and y-coordinates of the previously sampled
- ;; position. The differences between `last-x' and `pos-x' as
- ;; well as `last-y' and `pos-y' determine the amount the mouse
- ;; has been dragged between the last two samples.
- pos-x-y pos-x pos-y
- (last-x-y (mouse-absolute-pixel-position))
- (last-x (car last-x-y))
- (last-y (cdr last-x-y))
- ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
+ ;; Initial "first" mouse position. While dragging we base all
+ ;; calculations against that position.
+ (first-x-y (mouse-absolute-pixel-position))
+ (first-x (car first-x-y))
+ (first-y (cdr first-x-y))
+ ;; `snap-width' (maybe also a yet to be provided `snap-height')
+ ;; could become floats to handle proportionality wrt PARENT.
+ ;; We don't do any checks on this parameter so far.
+ (snap-width (frame-parameter frame 'snap-width))
+ ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
;; mouse position when FRAME snapped. As soon as the
;; difference between `pos-x' and `snap-x' (or `pos-y' and
;; `snap-y') exceeds the value of FRAME's `snap-width'
@@ -678,176 +771,141 @@ frame with the mouse."
(lambda (event)
(interactive "e")
(when (consp event)
- (setq pos-x-y (mouse-absolute-pixel-position))
- (setq pos-x (car pos-x-y))
- (setq pos-y (cdr pos-x-y))
- (cond
- ((eq part 'left)
- (mouse-resize-frame frame (- last-x pos-x) 0 t))
- ((eq part 'top)
- (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
- ((eq part 'right)
- (mouse-resize-frame frame (- pos-x last-x) 0))
- ((eq part 'bottom)
- (mouse-resize-frame frame 0 (- pos-y last-y)))
- ((eq part 'top-left)
- (mouse-resize-frame
- frame (- last-x pos-x) (- last-y pos-y) t t))
- ((eq part 'top-right)
- (mouse-resize-frame
- frame (- pos-x last-x) (- last-y pos-y) nil t))
- ((eq part 'bottom-left)
- (mouse-resize-frame
- frame (- last-x pos-x) (- pos-y last-y) t))
- ((eq part 'bottom-right)
- (mouse-resize-frame
- frame (- pos-x last-x) (- pos-y last-y)))
- ((eq part 'move)
- (let* ((old-position (frame-position frame))
- (old-left (car old-position))
- (old-top (cdr old-position))
- (left (+ old-left (- pos-x last-x)))
- (top (+ old-top (- pos-y last-y)))
- right bottom
- ;; `snap-width' (maybe also a yet to be provided
- ;; `snap-height') could become floats to handle
- ;; proportionality wrt PARENT. We don't do any
- ;; checks on this parameter so far.
- (snap-width (frame-parameter frame 'snap-width)))
- ;; Docking and constraining.
- (when (and (numberp snap-width) parent-edges)
+ (let* ((last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ (left (- last-x first-x))
+ (top (- last-y first-y))
+ right bottom)
+ (setq left (+ first-left left))
+ (setq top (+ first-top top))
+ ;; Docking and constraining.
+ (when (and (numberp snap-width) parent-edges)
+ (cond
+ ;; Docking at the left parent edge.
+ ((< last-x first-x)
(cond
- ;; Docking at the left parent edge.
- ((< pos-x last-x)
- (cond
- ((and (> left parent-left)
- (<= (- left parent-left) snap-width))
- ;; Snap when the mouse moved leftward and
- ;; FRAME's left edge would end up within
- ;; `snap-width' pixels from PARENT's left edge.
- (setq snap-x pos-x)
- (setq left parent-left))
- ((and (<= left parent-left)
- (<= (- parent-left left) snap-width)
- snap-x (<= (- snap-x pos-x) snap-width))
- ;; Stay snapped when the mouse moved leftward
- ;; but not more than `snap-width' pixels from
- ;; the time FRAME snapped.
- (setq left parent-left))
- (t
- ;; Unsnap when the mouse moved more than
- ;; `snap-width' pixels leftward from the time
- ;; FRAME snapped.
- (setq snap-x nil))))
- ((> pos-x last-x)
- (setq right (+ left width))
- (cond
- ((and (< right parent-right)
- (<= (- parent-right right) snap-width))
- ;; Snap when the mouse moved rightward and
- ;; FRAME's right edge would end up within
- ;; `snap-width' pixels from PARENT's right edge.
- (setq snap-x pos-x)
- (setq left (- parent-right width)))
- ((and (>= right parent-right)
- (<= (- right parent-right) snap-width)
- snap-x (<= (- pos-x snap-x) snap-width))
- ;; Stay snapped when the mouse moved rightward
- ;; but not more more than `snap-width' pixels
- ;; from the time FRAME snapped.
- (setq left (- parent-right width)))
- (t
- ;; Unsnap when the mouse moved rightward more
- ;; than `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-x nil)))))
-
+ ((and (> left parent-left)
+ (<= (- left parent-left) snap-width))
+ ;; Snap when the mouse moved leftward and FRAME's
+ ;; left edge would end up within `snap-width'
+ ;; pixels from PARENT's left edge.
+ (setq snap-x last-x)
+ (setq left parent-left))
+ ((and (<= left parent-left)
+ (<= (- parent-left left) snap-width)
+ snap-x (<= (- snap-x last-x) snap-width))
+ ;; Stay snapped when the mouse moved leftward but
+ ;; not more than `snap-width' pixels from the time
+ ;; FRAME snapped.
+ (setq left parent-left))
+ (t
+ ;; Unsnap when the mouse moved more than
+ ;; `snap-width' pixels leftward from the time
+ ;; FRAME snapped.
+ (setq snap-x nil))))
+ ((> last-x first-x)
+ (setq right (+ left native-width))
(cond
- ((< pos-y last-y)
- (cond
- ((and (> top parent-top)
- (<= (- top parent-top) snap-width))
- ;; Snap when the mouse moved upward and FRAME's
- ;; top edge would end up within `snap-width'
- ;; pixels from PARENT's top edge.
- (setq snap-y pos-y)
- (setq top parent-top))
- ((and (<= top parent-top)
- (<= (- parent-top top) snap-width)
- snap-y (<= (- snap-y pos-y) snap-width))
- ;; Stay snapped when the mouse moved upward but
- ;; not more more than `snap-width' pixels from
- ;; the time FRAME snapped.
- (setq top parent-top))
- (t
- ;; Unsnap when the mouse moved upward more than
- ;; `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-y nil))))
- ((> pos-y last-y)
- (setq bottom (+ top height))
- (cond
- ((and (< bottom parent-bottom)
- (<= (- parent-bottom bottom) snap-width))
- ;; Snap when the mouse moved downward and
- ;; FRAME's bottom edge would end up within
- ;; `snap-width' pixels from PARENT's bottom
- ;; edge.
- (setq snap-y pos-y)
- (setq top (- parent-bottom height)))
- ((and (>= bottom parent-bottom)
- (<= (- bottom parent-bottom) snap-width)
- snap-y (<= (- pos-y snap-y) snap-width))
- ;; Stay snapped when the mouse moved downward
- ;; but not more more than `snap-width' pixels
- ;; from the time FRAME snapped.
- (setq top (- parent-bottom height)))
- (t
- ;; Unsnap when the mouse moved downward more
- ;; than `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-y nil))))))
-
- ;; If requested, constrain FRAME's draggable areas to
- ;; PARENT's edges. The `top-visible' parameter should
- ;; be set when FRAME has a draggable header-line. If
- ;; set to a number, it ascertains that the top of
- ;; FRAME is always constrained to the top of PARENT
- ;; and that at least as many pixels of FRAME as
- ;; specified by that number are visible on each of the
- ;; three remaining sides of PARENT.
- ;;
- ;; The `bottom-visible' parameter should be set when
- ;; FRAME has a draggable mode-line. If set to a
- ;; number, it ascertains that the bottom of FRAME is
- ;; always constrained to the bottom of PARENT and that
- ;; at least as many pixels of FRAME as specified by
- ;; that number are visible on each of the three
- ;; remaining sides of PARENT.
- (let ((par (frame-parameter frame 'top-visible))
- bottom-visible)
- (unless par
- (setq par (frame-parameter frame 'bottom-visible))
- (setq bottom-visible t))
- (when (and (numberp par) parent-edges)
- (setq left
- (max (min (- parent-right par) left)
- (+ (- parent-left width) par)))
- (setq top
- (if bottom-visible
- (min (max top (- parent-top (- height par)))
- (- parent-bottom height))
- (min (max top parent-top)
- (- parent-bottom par))))))
-
- ;; Use `modify-frame-parameters' since `left' and
- ;; `top' may want to move FRAME out of its PARENT.
- (modify-frame-parameters
- frame
- `((left . (+ ,left)) (top . (+ ,top)))))))
- (setq last-x pos-x)
- (setq last-y pos-y))))
- (old-track-mouse track-mouse))
+ ((and (< right parent-right)
+ (<= (- parent-right right) snap-width))
+ ;; Snap when the mouse moved rightward and FRAME's
+ ;; right edge would end up within `snap-width'
+ ;; pixels from PARENT's right edge.
+ (setq snap-x last-x)
+ (setq left (- parent-right native-width)))
+ ((and (>= right parent-right)
+ (<= (- right parent-right) snap-width)
+ snap-x (<= (- last-x snap-x) snap-width))
+ ;; Stay snapped when the mouse moved rightward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq left (- parent-right native-width)))
+ (t
+ ;; Unsnap when the mouse moved rightward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-x nil)))))
+ (cond
+ ((< last-y first-y)
+ (cond
+ ((and (> top parent-top)
+ (<= (- top parent-top) snap-width))
+ ;; Snap when the mouse moved upward and FRAME's
+ ;; top edge would end up within `snap-width'
+ ;; pixels from PARENT's top edge.
+ (setq snap-y last-y)
+ (setq top parent-top))
+ ((and (<= top parent-top)
+ (<= (- parent-top top) snap-width)
+ snap-y (<= (- snap-y last-y) snap-width))
+ ;; Stay snapped when the mouse moved upward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq top parent-top))
+ (t
+ ;; Unsnap when the mouse moved upward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))
+ ((> last-y first-y)
+ (setq bottom (+ top native-height))
+ (cond
+ ((and (< bottom parent-bottom)
+ (<= (- parent-bottom bottom) snap-width))
+ ;; Snap when the mouse moved downward and FRAME's
+ ;; bottom edge would end up within `snap-width'
+ ;; pixels from PARENT's bottom edge.
+ (setq snap-y last-y)
+ (setq top (- parent-bottom native-height)))
+ ((and (>= bottom parent-bottom)
+ (<= (- bottom parent-bottom) snap-width)
+ snap-y (<= (- last-y snap-y) snap-width))
+ ;; Stay snapped when the mouse moved downward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq top (- parent-bottom native-height)))
+ (t
+ ;; Unsnap when the mouse moved downward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))))
+
+ ;; If requested, constrain FRAME's draggable areas to
+ ;; PARENT's edges. The `top-visible' parameter should
+ ;; be set when FRAME has a draggable header-line. If
+ ;; set to a number, it ascertains that the top of FRAME
+ ;; is always constrained to the top of PARENT and that
+ ;; at least as many pixels of FRAME as specified by that
+ ;; number are visible on each of the three remaining
+ ;; sides of PARENT.
+ ;;
+ ;; The `bottom-visible' parameter should be set when
+ ;; FRAME has a draggable mode-line. If set to a number,
+ ;; it ascertains that the bottom of FRAME is always
+ ;; constrained to the bottom of PARENT and that at least
+ ;; as many pixels of FRAME as specified by that number
+ ;; are visible on each of the three remaining sides of
+ ;; PARENT.
+ (let ((par (frame-parameter frame 'top-visible))
+ bottom-visible)
+ (unless par
+ (setq par (frame-parameter frame 'bottom-visible))
+ (setq bottom-visible t))
+ (when (and (numberp par) parent-edges)
+ (setq left
+ (max (min (- parent-right par) left)
+ (+ (- parent-left native-width) par)))
+ (setq top
+ (if bottom-visible
+ (min (max top (- parent-top (- native-height
par)))
+ (- parent-bottom native-height))
+ (min (max top parent-top)
+ (- parent-bottom par))))))
+ ;; Use `modify-frame-parameters' since `left' and `top'
+ ;; may want to move FRAME out of its PARENT.
+ (modify-frame-parameters frame `((left . (+ ,left)) (top . (+
,top))))))))
+ (old-track-mouse track-mouse))
;; Start tracking. The special value 'dragging' signals the
;; display engine to freeze the mouse pointer shape for as long
;; as we drag.
@@ -879,49 +937,49 @@ frame with the mouse."
"Drag left edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'left))
+ (mouse-drag-frame-resize start-event 'left))
(defun mouse-drag-top-left-corner (start-event)
"Drag top left corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top-left))
+ (mouse-drag-frame-resize start-event 'top-left))
(defun mouse-drag-top-edge (start-event)
"Drag top edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top))
+ (mouse-drag-frame-resize start-event 'top))
(defun mouse-drag-top-right-corner (start-event)
"Drag top right corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top-right))
+ (mouse-drag-frame-resize start-event 'top-right))
(defun mouse-drag-right-edge (start-event)
"Drag right edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'right))
+ (mouse-drag-frame-resize start-event 'right))
(defun mouse-drag-bottom-right-corner (start-event)
"Drag bottom right corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom-right))
+ (mouse-drag-frame-resize start-event 'bottom-right))
(defun mouse-drag-bottom-edge (start-event)
"Drag bottom edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom))
+ (mouse-drag-frame-resize start-event 'bottom))
(defun mouse-drag-bottom-left-corner (start-event)
"Drag bottom left corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom-left))
+ (mouse-drag-frame-resize start-event 'bottom-left))
(defcustom mouse-select-region-move-to-beginning nil
"Effect of selecting a region extending backward from double click.
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 93eeb16..09e30f0 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -339,7 +339,7 @@ Return VALUE."
(when-let ((hash (tramp-get-hash-table key)))
(puthash property value hash))
(setq tramp-cache-data-changed
- (or tramp-cache-data-changed (tramp-tramp-file-p key)))
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s %s" property value)
value)
@@ -368,7 +368,7 @@ PROPERTY is set persistent when KEY is a `tramp-file-name'
structure."
(when-let ((hash (tramp-get-hash-table key)))
(remhash property hash))
(setq tramp-cache-data-changed
- (or tramp-cache-data-changed (tramp-tramp-file-p key)))
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s" property))
;;;###tramp-autoload
@@ -388,7 +388,7 @@ used to cache connection properties of the local machine."
(when-let ((hash (gethash key tramp-cache-data)))
(hash-table-keys hash)))
(setq tramp-cache-data-changed
- (or tramp-cache-data-changed (tramp-tramp-file-p key)))
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
;;;###tramp-autoload
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index c770e3c..95425cb 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -481,6 +481,7 @@ The string is used in `tramp-methods'.")
;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
;; IRIX64: /usr/bin
;; QNAP QTS: ---
+;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin
;;;###tramp-autoload
(defcustom tramp-remote-path
'(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
@@ -4045,11 +4046,14 @@ variable PATH."
(if (< (length command) pipe-buf)
(tramp-send-command vec command)
;; Use a temporary file.
- (setq tmpfile
- (tramp-make-tramp-file-name vec (tramp-make-tramp-temp-file vec)))
- (write-region command nil tmpfile)
- (tramp-send-command vec (format ". %s" (tramp-file-local-name tmpfile)))
- (delete-file tmpfile))))
+ (setq tmpfile (tramp-make-tramp-temp-file vec))
+ (tramp-send-command vec (format
+ "cat >%s <<'%s'\n%s\n%s"
+ (tramp-shell-quote-argument tmpfile)
+ tramp-end-of-heredoc
+ command tramp-end-of-heredoc))
+ (tramp-send-command vec (format ". %s" tmpfile))
+ (tramp-send-command vec (format "rm -f %s" tmpfile)))))
;; ------------------------------------------------------------
;; -- Communication with external shell --
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 0750683..ba58698 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -224,7 +224,9 @@ Only used for files that Emacs can't find.")
(defvar gdb-source-file-list nil
"List of source files for the current executable.")
(defvar gdb-first-done-or-error t)
-(defvar gdb-source-window nil)
+(defvar gdb-source-window-list nil
+ "List of windows used for displaying source files.
+Sorted in most-recently-visited-first order.")
(defvar gdb-inferior-status nil)
(defvar gdb-continuation nil)
(defvar gdb-supports-non-stop nil)
@@ -645,6 +647,21 @@ Note that this variable only takes effect when variable
:group 'gdb
:version "28.1")
+(defcustom gdb-display-source-buffer-action '(nil . ((inhibit-same-window .
t)))
+ "`display-buffer' action used when GDB displays a source buffer."
+ :type 'list
+ :group 'gdb
+ :version "28.1")
+
+(defcustom gdb-max-source-window-count 1
+ "Maximum number of source windows to use.
+Until there are such number of source windows on screen, GDB
+tries to open a new window when visiting a new source file; after
+that GDB starts to reuse existing source windows."
+ :type 'number
+ :group 'gdb
+ :version "28.1")
+
(defvar gdbmi-debug-mode nil
"When non-nil, print the messages sent/received from GDB/MI in *Messages*.")
@@ -984,7 +1001,7 @@ detailed description of this mode.
gdb-first-done-or-error t
gdb-buffer-fringe-width (car (window-fringes))
gdb-debug-log nil
- gdb-source-window nil
+ gdb-source-window-list nil
gdb-inferior-status nil
gdb-continuation nil
gdb-buf-publisher '()
@@ -2070,17 +2087,36 @@ is running."
;; GDB frame (after up, down etc). If no GDB frame is visible but the last
;; visited breakpoint is, use that window.
(defun gdb-display-source-buffer (buffer)
- (let* ((last-window (if gud-last-last-frame
- (get-buffer-window
- (gud-find-file (car gud-last-last-frame)))))
- (source-window (or last-window
- (if (and gdb-source-window
- (window-live-p gdb-source-window))
- gdb-source-window))))
- (when source-window
- (setq gdb-source-window source-window)
- (set-window-buffer source-window buffer))
- source-window))
+ "Find a window to display BUFFER.
+Always find a window to display buffer, and return it."
+ ;; This function doesn't take care of setting up source window(s) at startup,
+ ;; that's handled by `gdb-setup-windows' (if `gdb-many-windows' is non-nil).
+ ;; If `buffer' is already shown in a window, use that window.
+ (or (get-buffer-window buffer)
+ (progn
+ ;; First, update the window list.
+ (setq gdb-source-window-list
+ (cl-remove-duplicates
+ (cl-remove-if-not
+ (lambda (win)
+ (and (window-live-p win)
+ (eq (window-frame win)
+ (selected-frame))))
+ gdb-source-window-list)))
+ ;; Should we create a new window or reuse one?
+ (if (> gdb-max-source-window-count
+ (length gdb-source-window-list))
+ ;; Create a new window, push it to window list and return it.
+ (car (push (display-buffer buffer gdb-display-source-buffer-action)
+ gdb-source-window-list))
+ ;; Reuse a window, we use the oldest window and put that to
+ ;; the front of the window list.
+ (let ((last-win (car (last gdb-source-window-list)))
+ (rest (butlast gdb-source-window-list)))
+ (set-window-buffer last-win buffer)
+ (setq gdb-source-window-list
+ (cons last-win rest))
+ last-win)))))
(defun gdbmi-start-with (str offset match)
@@ -4071,9 +4107,7 @@ DOC is an optional documentation string."
(let* ((buffer (find-file-noselect
(if (file-exists-p file) file
(cdr (assoc bptno gdb-location-alist)))))
- (window (or (gdb-display-source-buffer buffer)
- (display-buffer buffer))))
- (setq gdb-source-window window)
+ (window (gdb-display-source-buffer buffer)))
(with-current-buffer buffer
(goto-char (point-min))
(forward-line (1- (string-to-number line)))
@@ -4722,7 +4756,7 @@ file\" where the GDB session starts (see
`gdb-main-file')."
(select-window win2)
(set-window-buffer win2 (or (gdb-get-source-buffer)
(list-buffers-noselect)))
- (setq gdb-source-window (selected-window))
+ (setq gdb-source-window-list (list (selected-window)))
(let ((win4 (split-window-right)))
(gdb-set-window-buffer
(gdb-get-buffer-create 'gdb-inferior-io) nil win4))
@@ -4798,7 +4832,8 @@ You can later restore this configuration from that file by
(error "Unrecognized gdb buffer mode: %s"
major-mode)))
;; Command buffer.
((derived-mode-p 'gud-mode) 'command)
- ((equal (selected-window) gdb-source-window) 'source)))
+ ;; Consider everything else as source buffer.
+ (t 'source)))
(with-window-non-dedicated nil
(set-window-buffer nil placeholder)
(set-window-prev-buffers (selected-window) nil)
@@ -4841,7 +4876,7 @@ FILE should be a window configuration file saved by
(pcase buffer-type
('source (when source-buffer
(set-window-buffer nil source-buffer)
- (setq gdb-source-window (selected-window))))
+ (push (selected-window) gdb-source-window-list)))
('command (switch-to-buffer gud-comint-buffer))
(_ (let ((buffer (gdb-get-buffer-create buffer-type)))
(with-window-non-dedicated nil
@@ -4882,7 +4917,7 @@ This arrangement depends on the values of variable
(if gud-last-last-frame
(gud-find-file (car gud-last-last-frame))
(gud-find-file gdb-main-file)))
- (setq gdb-source-window win)))))
+ (setq gdb-source-window-list (list win))))))
;; Called from `gud-sentinel' in gud.el:
(defun gdb-reset ()
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 567f452..eb43e8b 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -2826,9 +2826,13 @@ Obeying it means displaying in another window the
specified file and line."
(buffer
(with-current-buffer gud-comint-buffer
(gud-find-file true-file)))
- (window (and buffer
- (or (get-buffer-window buffer)
- (display-buffer buffer '(nil (inhibit-same-window .
t))))))
+ (window
+ (when buffer
+ (if (eq gud-minor-mode 'gdbmi)
+ (gdb-display-source-buffer buffer)
+ ;; Gud still has the old behavior.
+ (or (get-buffer-window buffer)
+ (display-buffer buffer '(nil (inhibit-same-window . t)))))))
(pos))
(when buffer
(with-current-buffer buffer
@@ -2858,9 +2862,7 @@ Obeying it means displaying in another window the
specified file and line."
(widen)
(goto-char pos))))
(when window
- (set-window-point window gud-overlay-arrow-position)
- (if (eq gud-minor-mode 'gdbmi)
- (setq gdb-source-window window))))))
+ (set-window-point window gud-overlay-arrow-position)))))
;; The gud-call function must do the right thing whether its invoking
;; keystroke is from the GUD buffer itself (via major-mode binding)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index f467868..1f4cbe9 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -480,6 +480,8 @@ pattern to search for."
nil)))
(defun project--find-regexp-in-files (regexp files)
+ (unless files
+ (user-error "Empty file list"))
(let ((xrefs (xref-matches-in-files regexp files)))
(unless xrefs
(user-error "No matches for: %s" regexp))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 1a34456..c36a9bd 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1232,6 +1232,7 @@ IGNORES is a list of glob patterns for files to ignore."
"Find all matches for REGEXP in FILES.
Return a list of xref values.
FILES must be a list of absolute file names."
+ (cl-assert (consp files))
(pcase-let*
((output (get-buffer-create " *project grep output*"))
(`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index d5d4614..906f9a9 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -529,7 +529,7 @@ according to `fill-column'."
(and (< beg end)
(re-search-forward
(concat "\\(?1:" change-log-unindented-file-names-re
- "\\)\\|^\\(?1:\\)(")
+ "\\)\\|^\\(?1:\\)[[:blank:]]*(")
end t)
(copy-marker (match-end 1)))
;; Fill prose between log entries.
diff --git a/src/bignum.c b/src/bignum.c
index 51d90ff..669df4d 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -431,3 +431,39 @@ make_bignum_str (char const *num, int base)
eassert (check == 0);
return make_lisp_ptr (b, Lisp_Vectorlike);
}
+
+/* Check that X is a Lisp integer in the range LO..HI.
+ Return X's value as an intmax_t. */
+
+intmax_t
+check_integer_range (Lisp_Object x, intmax_t lo, intmax_t hi)
+{
+ CHECK_INTEGER (x);
+ intmax_t i;
+ if (! (integer_to_intmax (x, &i) && lo <= i && i <= hi))
+ args_out_of_range_3 (x, make_int (lo), make_int (hi));
+ return i;
+}
+
+/* Check that X is a Lisp integer in the range 0..HI.
+ Return X's value as an uintmax_t. */
+
+uintmax_t
+check_uinteger_max (Lisp_Object x, uintmax_t hi)
+{
+ CHECK_INTEGER (x);
+ uintmax_t i;
+ if (! (integer_to_uintmax (x, &i) && i <= hi))
+ args_out_of_range_3 (x, make_fixnum (0), make_uint (hi));
+ return i;
+}
+
+/* Check that X is a Lisp integer no greater than INT_MAX,
+ and return its value or zero, whichever is greater. */
+
+int
+check_int_nonnegative (Lisp_Object x)
+{
+ CHECK_INTEGER (x);
+ return NILP (Fnatnump (x)) ? 0 : check_integer_range (x, 0, INT_MAX);
+}
diff --git a/src/buffer.c b/src/buffer.c
index d8842a6..f3532a8 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -6236,10 +6236,10 @@ Lisp programs may give this variable certain special
values:
DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
doc: /* Non-nil means disregard read-only status of buffers or
characters.
-If the value is t, disregard `buffer-read-only' and all `read-only'
-text properties. If the value is a list, disregard `buffer-read-only'
-and disregard a `read-only' text property if the property value
-is a member of the list. */);
+A non-nil value that is a list means disregard `buffer-read-only' status,
+and disregard a `read-only' text property if the property value is a
+member of the list. Any other non-nil value means disregard `buffer-read-only'
+and all `read-only' text properties. */);
Vinhibit_read_only = Qnil;
DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
diff --git a/src/character.c b/src/character.c
index a566cac..c938e9f 100644
--- a/src/character.c
+++ b/src/character.c
@@ -876,10 +876,7 @@ usage: (unibyte-string &rest BYTES) */)
Lisp_Object str = make_uninit_string (n);
unsigned char *p = SDATA (str);
for (ptrdiff_t i = 0; i < n; i++)
- {
- CHECK_RANGED_INTEGER (args[i], 0, 255);
- *p++ = XFIXNUM (args[i]);
- }
+ *p++ = check_integer_range (args[i], 0, 255);
return str;
}
diff --git a/src/charset.c b/src/charset.c
index 2771b0b..9e55d0c 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -866,15 +866,10 @@ usage: (define-charset-internal ...) */)
val = args[charset_arg_code_space];
for (i = 0, dimension = 0, nchars = 1; ; i++)
{
- Lisp_Object min_byte_obj, max_byte_obj;
- int min_byte, max_byte;
-
- min_byte_obj = Faref (val, make_fixnum (i * 2));
- max_byte_obj = Faref (val, make_fixnum (i * 2 + 1));
- CHECK_RANGED_INTEGER (min_byte_obj, 0, 255);
- min_byte = XFIXNUM (min_byte_obj);
- CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255);
- max_byte = XFIXNUM (max_byte_obj);
+ Lisp_Object min_byte_obj = Faref (val, make_fixnum (i * 2));
+ Lisp_Object max_byte_obj = Faref (val, make_fixnum (i * 2 + 1));
+ int min_byte = check_integer_range (min_byte_obj, 0, 255);
+ int max_byte = check_integer_range (max_byte_obj, min_byte, 255);
charset.code_space[i * 4] = min_byte;
charset.code_space[i * 4 + 1] = max_byte;
charset.code_space[i * 4 + 2] = max_byte - min_byte + 1;
@@ -887,13 +882,8 @@ usage: (define-charset-internal ...) */)
}
val = args[charset_arg_dimension];
- if (NILP (val))
- charset.dimension = dimension;
- else
- {
- CHECK_RANGED_INTEGER (val, 1, 4);
- charset.dimension = XFIXNUM (val);
- }
+ charset.dimension
+ = !NILP (val) ? check_integer_range (val, 1, 4) : dimension;
charset.code_linear_p
= (charset.dimension == 1
@@ -979,13 +969,7 @@ usage: (define-charset-internal ...) */)
}
val = args[charset_arg_iso_revision];
- if (NILP (val))
- charset.iso_revision = -1;
- else
- {
- CHECK_RANGED_INTEGER (val, -1, 63);
- charset.iso_revision = XFIXNUM (val);
- }
+ charset.iso_revision = !NILP (val) ? check_integer_range (val, -1, 63) : -1;
val = args[charset_arg_emacs_mule_id];
if (NILP (val))
@@ -1090,8 +1074,7 @@ usage: (define-charset-internal ...) */)
car_part = XCAR (elt);
cdr_part = XCDR (elt);
CHECK_CHARSET_GET_ID (car_part, this_id);
- CHECK_TYPE_RANGED_INTEGER (int, cdr_part);
- offset = XFIXNUM (cdr_part);
+ offset = check_integer_range (cdr_part, INT_MIN, INT_MAX);
}
else
{
diff --git a/src/coding.c b/src/coding.c
index 0bea2a0c2..49c1e62 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9471,6 +9471,17 @@ not fully specified.) */)
return code_convert_region (start, end, coding_system, destination, 1, 0);
}
+/* Whether a string only contains chars in the 0..127 range. */
+static bool
+string_ascii_p (Lisp_Object str)
+{
+ ptrdiff_t nbytes = SBYTES (str);
+ for (ptrdiff_t i = 0; i < nbytes; i++)
+ if (SREF (str, i) > 127)
+ return false;
+ return true;
+}
+
Lisp_Object
code_convert_string (Lisp_Object string, Lisp_Object coding_system,
Lisp_Object dst_object, bool encodep, bool nocopy,
@@ -9485,7 +9496,7 @@ code_convert_string (Lisp_Object string, Lisp_Object
coding_system,
if (! norecord)
Vlast_coding_system_used = Qno_conversion;
if (NILP (dst_object))
- return (nocopy ? Fcopy_sequence (string) : string);
+ return nocopy ? string : Fcopy_sequence (string);
}
if (NILP (coding_system))
@@ -9502,7 +9513,21 @@ code_convert_string (Lisp_Object string, Lisp_Object
coding_system,
chars = SCHARS (string);
bytes = SBYTES (string);
- if (BUFFERP (dst_object))
+ if (EQ (dst_object, Qt))
+ {
+ /* Fast path for ASCII-only input and an ASCII-compatible coding:
+ act as identity. */
+ Lisp_Object attrs = CODING_ID_ATTRS (coding.id);
+ if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
+ && (STRING_MULTIBYTE (string)
+ ? (chars == bytes) : string_ascii_p (string)))
+ return (nocopy
+ ? string
+ : (encodep
+ ? make_unibyte_string (SSDATA (string), bytes)
+ : make_multibyte_string (SSDATA (string), bytes, bytes)));
+ }
+ else if (BUFFERP (dst_object))
{
struct buffer *buf = XBUFFER (dst_object);
ptrdiff_t buf_pt = BUF_PT (buf);
@@ -11061,10 +11086,8 @@ usage: (define-coding-system-internal ...) */)
else
{
CHECK_CONS (val);
- CHECK_RANGED_INTEGER (XCAR (val), 0, 255);
- from = XFIXNUM (XCAR (val));
- CHECK_RANGED_INTEGER (XCDR (val), from, 255);
- to = XFIXNUM (XCDR (val));
+ from = check_integer_range (XCAR (val), 0, 255);
+ to = check_integer_range (XCDR (val), from, 255);
}
for (int i = from; i <= to; i++)
SSET (valids, i, 1);
@@ -11149,7 +11172,7 @@ usage: (define-coding-system-internal ...) */)
val = XCAR (tail);
CHECK_CONS (val);
CHECK_CHARSET_GET_ID (XCAR (val), id);
- CHECK_RANGED_INTEGER (XCDR (val), 0, 3);
+ check_integer_range (XCDR (val), 0, 3);
XSETCAR (val, make_fixnum (id));
}
diff --git a/src/emacs-module.c b/src/emacs-module.c
index cdcbe06..e43e490 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -683,7 +683,7 @@ module_copy_string_contents (emacs_env *env, emacs_value
value, char *buf,
/* Since we set HANDLE-8-BIT and HANDLE-OVER-UNI to nil, the return
value can be nil, and we have to check for that. */
- CHECK_TYPE (!NILP (lisp_str_utf8), Qunicode_string_p, lisp_str_utf8);
+ CHECK_TYPE (!NILP (lisp_str_utf8), Qunicode_string_p, lisp_str);
ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
ptrdiff_t required_buf_size = raw_size + 1;
diff --git a/src/fileio.c b/src/fileio.c
index 978a373..2f1d2f8 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5682,8 +5682,8 @@ in `current-time' or an integer flag as returned by
`visited-file-modtime'. */)
struct timespec mtime;
if (FIXNUMP (time_flag))
{
- CHECK_RANGED_INTEGER (time_flag, -1, 0);
- mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XFIXNUM
(time_flag));
+ int flag = check_integer_range (time_flag, -1, 0);
+ mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - flag);
}
else
mtime = lisp_time_argument (time_flag);
diff --git a/src/frame.c b/src/frame.c
index c7e4f2f..884de2f 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -2558,26 +2558,26 @@ before calling this function on it, like this.
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
/* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y));
+ frame_set_mouse_position (XFRAME (frame), xval, yval);
#else
#if defined (MSDOS)
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
- mouse_moveto (XFIXNUM (x), XFIXNUM (y));
+ mouse_moveto (xval, yval);
}
#else
#ifdef HAVE_GPM
{
Fselect_frame (frame, Qnil);
- term_mouse_moveto (XFIXNUM (x), XFIXNUM (y));
+ term_mouse_moveto (xval, yval);
}
#endif
#endif
@@ -2599,26 +2599,26 @@ before calling this function on it, like this.
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
/* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_pixel_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y));
+ frame_set_mouse_pixel_position (XFRAME (frame), xval, yval);
#else
#if defined (MSDOS)
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
- mouse_moveto (XFIXNUM (x), XFIXNUM (y));
+ mouse_moveto (xval, yval);
}
#else
#ifdef HAVE_GPM
{
Fselect_frame (frame, Qnil);
- term_mouse_moveto (XFIXNUM (x), XFIXNUM (y));
+ term_mouse_moveto (xval, yval);
}
#endif
#endif
@@ -3545,6 +3545,21 @@ DEFUN ("frame-bottom-divider-width",
Fbottom_divider_width, Sbottom_divider_widt
return make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame)));
}
+static int
+check_frame_pixels (Lisp_Object size, Lisp_Object pixelwise, int item_size)
+{
+ CHECK_INTEGER (size);
+ if (!NILP (pixelwise))
+ item_size = 1;
+ intmax_t sz;
+ int pixel_size; /* size * item_size */
+ if (! integer_to_intmax (size, &sz)
+ || INT_MULTIPLY_WRAPV (sz, item_size, &pixel_size))
+ args_out_of_range_3 (size, make_int (INT_MIN / item_size),
+ make_int (INT_MAX / item_size));
+ return pixel_size;
+}
+
DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4,
"(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
doc: /* Set text height of frame FRAME to HEIGHT lines.
@@ -3562,15 +3577,9 @@ currently selected frame will be set to this height. */)
(Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object
pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_height;
-
- CHECK_TYPE_RANGED_INTEGER (int, height);
-
- pixel_height = (!NILP (pixelwise)
- ? XFIXNUM (height)
- : XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
+ int pixel_height = check_frame_pixels (height, pixelwise,
+ FRAME_LINE_HEIGHT (f));
adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight);
-
return Qnil;
}
@@ -3591,15 +3600,9 @@ currently selected frame will be set to this width.
*/)
(Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object
pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_width;
-
- CHECK_TYPE_RANGED_INTEGER (int, width);
-
- pixel_width = (!NILP (pixelwise)
- ? XFIXNUM (width)
- : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
+ int pixel_width = check_frame_pixels (width, pixelwise,
+ FRAME_COLUMN_WIDTH (f));
adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth);
-
return Qnil;
}
@@ -3613,19 +3616,11 @@ font height. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object
pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_width, pixel_height;
-
- CHECK_TYPE_RANGED_INTEGER (int, width);
- CHECK_TYPE_RANGED_INTEGER (int, height);
-
- pixel_width = (!NILP (pixelwise)
- ? XFIXNUM (width)
- : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
- pixel_height = (!NILP (pixelwise)
- ? XFIXNUM (height)
- : XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
+ int pixel_width = check_frame_pixels (width, pixelwise,
+ FRAME_COLUMN_WIDTH (f));
+ int pixel_height = check_frame_pixels (height, pixelwise,
+ FRAME_LINE_HEIGHT (f));
adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize);
-
return Qnil;
}
@@ -3655,18 +3650,14 @@ bottom edge of FRAME's display. */)
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
struct frame *f = decode_live_frame (frame);
-
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
if (FRAME_WINDOW_P (f))
{
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_TERMINAL (f)->set_frame_offset_hook)
- FRAME_TERMINAL (f)->set_frame_offset_hook (f,
- XFIXNUM (x),
- XFIXNUM (y),
- 1);
+ FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1);
#endif
}
@@ -4641,23 +4632,22 @@ gui_set_right_fringe (struct frame *f, Lisp_Object
new_value, Lisp_Object old_va
void
gui_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- CHECK_TYPE_RANGED_INTEGER (int, arg);
+ int border_width = check_integer_range (arg, INT_MIN, INT_MAX);
- if (XFIXNUM (arg) == f->border_width)
+ if (border_width == f->border_width)
return;
if (FRAME_NATIVE_WINDOW (f) != 0)
error ("Cannot change the border width of a frame");
- f->border_width = XFIXNUM (arg);
+ f->border_width = border_width;
}
void
gui_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
{
int old = FRAME_RIGHT_DIVIDER_WIDTH (f);
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- int new = max (0, XFIXNUM (arg));
+ int new = check_int_nonnegative (arg);
if (new != old)
{
f->right_divider_width = new;
@@ -4671,8 +4661,7 @@ void
gui_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
{
int old = FRAME_BOTTOM_DIVIDER_WIDTH (f);
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- int new = max (0, XFIXNUM (arg));
+ int new = check_int_nonnegative (arg);
if (new != old)
{
f->bottom_divider_width = new;
@@ -5651,8 +5640,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object
parms, bool tabbar_p,
f->top_pos = 0;
else
{
- CHECK_TYPE_RANGED_INTEGER (int, top);
- f->top_pos = XFIXNUM (top);
+ f->top_pos = check_integer_range (top, INT_MIN, INT_MAX);
if (f->top_pos < 0)
window_prompting |= YNegative;
}
@@ -5682,8 +5670,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object
parms, bool tabbar_p,
f->left_pos = 0;
else
{
- CHECK_TYPE_RANGED_INTEGER (int, left);
- f->left_pos = XFIXNUM (left);
+ f->left_pos = check_integer_range (left, INT_MIN, INT_MAX);
if (f->left_pos < 0)
window_prompting |= XNegative;
}
diff --git a/src/lcms.c b/src/lcms.c
index c19397f..924bdd2 100644
--- a/src/lcms.c
+++ b/src/lcms.c
@@ -254,8 +254,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ
*wp,
#define PARSE_VIEW_CONDITION_INT(field)
\
if (CONSP (view) && FIXNATP (XCAR (view))) \
{ \
- CHECK_RANGED_INTEGER (XCAR (view), 1, 4);
\
- vc->field = XFIXNUM (XCAR (view));
\
+ vc->field = check_integer_range (XCAR (view), 1, 4); \
view = XCDR (view); \
} \
else \
diff --git a/src/lisp.h b/src/lisp.h
index 1a5215d..9eccbd2 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -331,8 +331,8 @@ typedef EMACS_INT Lisp_Word;
used elsewhere.
FIXME: Remove the lisp_h_OP macros, and define just the inline OP
- functions, once "gcc -Og" (new to GCC 4.8) works well enough for
- Emacs developers. Maybe in the year 2020. See Bug#11935.
+ functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well
+ enough for Emacs developers. Maybe in the year 2025. See Bug#11935.
For the macros that have corresponding functions (defined later),
see these functions for commentary. */
@@ -589,15 +589,19 @@ INLINE void set_sub_char_table_contents (Lisp_Object,
ptrdiff_t,
Lisp_Object);
/* Defined in bignum.c. */
+extern int check_int_nonnegative (Lisp_Object);
+extern intmax_t check_integer_range (Lisp_Object, intmax_t, intmax_t);
extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST;
extern Lisp_Object make_bigint (intmax_t);
extern Lisp_Object make_biguint (uintmax_t);
+extern uintmax_t check_uinteger_max (Lisp_Object, uintmax_t);
/* Defined in chartab.c. */
extern Lisp_Object char_table_ref (Lisp_Object, int);
extern void char_table_set (Lisp_Object, int, Lisp_Object);
/* Defined in data.c. */
+extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
extern Lisp_Object default_value (Lisp_Object symbol);
@@ -3013,20 +3017,6 @@ CHECK_FIXNAT (Lisp_Object x)
CHECK_TYPE (FIXNATP (x), Qwholenump, x);
}
-#define CHECK_RANGED_INTEGER(x, lo, hi)
\
- do { \
- CHECK_FIXNUM (x); \
- if (! ((lo) <= XFIXNUM (x) && XFIXNUM (x) <= (hi)))
\
- args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi)); \
- } while (false)
-#define CHECK_TYPE_RANGED_INTEGER(type, x) \
- do { \
- if (TYPE_SIGNED (type)) \
- CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
- else \
- CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type));
\
- } while (false)
-
INLINE double
XFLOATINT (Lisp_Object n)
{
@@ -3592,7 +3582,6 @@ extern uintmax_t cons_to_unsigned (Lisp_Object,
uintmax_t);
extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
-extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern AVOID circular_list (Lisp_Object);
extern Lisp_Object do_symval_forwarding (lispfwd);
enum Set_Internal_Bind {
diff --git a/src/menu.c b/src/menu.c
index 28bfcae..6b8b5dd 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1253,18 +1253,16 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
but I don't want to make one now. */
CHECK_WINDOW (window);
- CHECK_RANGED_INTEGER (x,
- (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
- ? (EMACS_INT) INT_MIN - xpos
- : MOST_NEGATIVE_FIXNUM),
- INT_MAX - xpos);
- CHECK_RANGED_INTEGER (y,
- (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
- ? (EMACS_INT) INT_MIN - ypos
- : MOST_NEGATIVE_FIXNUM),
- INT_MAX - ypos);
- xpos += XFIXNUM (x);
- ypos += XFIXNUM (y);
+ xpos += check_integer_range (x,
+ (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - xpos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - xpos);
+ ypos += check_integer_range (y,
+ (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - ypos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - ypos);
XSETFRAME (Vmenu_updating_frame, f);
}
diff --git a/src/nsfns.m b/src/nsfns.m
index f6e7f4e..273fb5f 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -706,14 +706,11 @@ static void
ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
{
int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
+ int new_width = check_int_nonnegative (arg);
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- f->internal_border_width = XFIXNUM (arg);
- if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
- f->internal_border_width = 0;
-
- if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
+ if (new_width == old_width)
return;
+ f->internal_border_width = new_width;
if (FRAME_NATIVE_WINDOW (f) != 0)
adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
@@ -2956,16 +2953,16 @@ The coordinates X and Y are interpreted in pixels
relative to a position
if (FRAME_INITIAL_P (f) || !FRAME_NS_P (f))
return Qnil;
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
- mouse_x = screen_frame.origin.x + XFIXNUM (x);
+ mouse_x = screen_frame.origin.x + xval;
if (screen == primary_screen)
- mouse_y = screen_frame.origin.y + XFIXNUM (y);
+ mouse_y = screen_frame.origin.y + yval;
else
mouse_y = (primary_screen_height - screen_frame.size.height
- - screen_frame.origin.y) + XFIXNUM (y);
+ - screen_frame.origin.y) + yval;
CGPoint mouse_pos = CGPointMake(mouse_x, mouse_y);
CGWarpMouseCursorPosition (mouse_pos);
diff --git a/src/process.c b/src/process.c
index e6d18fb..6e5bcf3 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1392,14 +1392,12 @@ nil otherwise. */)
CHECK_PROCESS (process);
/* All known platforms store window sizes as 'unsigned short'. */
- CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
- CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
+ unsigned short h = check_uinteger_max (height, USHRT_MAX);
+ unsigned short w = check_uinteger_max (width, USHRT_MAX);
if (NETCONN_P (process)
|| XPROCESS (process)->infd < 0
- || (set_window_size (XPROCESS (process)->infd,
- XFIXNUM (height), XFIXNUM (width))
- < 0))
+ || set_window_size (XPROCESS (process)->infd, h, w) < 0)
return Qnil;
else
return Qt;
@@ -7075,10 +7073,7 @@ SIGCODE may be an integer, or a symbol whose name is a
signal name. */)
}
if (FIXNUMP (sigcode))
- {
- CHECK_TYPE_RANGED_INTEGER (int, sigcode);
- signo = XFIXNUM (sigcode);
- }
+ signo = check_integer_range (sigcode, INT_MIN, INT_MAX);
else
{
char *name;
diff --git a/src/search.c b/src/search.c
index 7389fbe..08b57c5 100644
--- a/src/search.c
+++ b/src/search.c
@@ -2392,14 +2392,7 @@ since only regular expressions have distinguished
subexpressions. */)
if (num_regs <= 0)
error ("`replace-match' called before any match found");
- if (NILP (subexp))
- sub = 0;
- else
- {
- CHECK_RANGED_INTEGER (subexp, 0, num_regs - 1);
- sub = XFIXNUM (subexp);
- }
-
+ sub = !NILP (subexp) ? check_integer_range (subexp, 0, num_regs - 1) : 0;
ptrdiff_t sub_start = search_regs.start[sub];
ptrdiff_t sub_end = search_regs.end[sub];
eassert (sub_start <= sub_end);
diff --git a/src/w32fns.c b/src/w32fns.c
index 2f01fb5..9bb4e27 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1700,10 +1700,8 @@ w32_clear_under_internal_border (struct frame *f)
static void
w32_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
{
- int border;
-
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- border = max (XFIXNUM (arg), 0);
+ int argval = check_integer_range (arg, INT_MIN, INT_MAX);
+ int border = max (argval, 0);
if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
{
@@ -9203,8 +9201,8 @@ The coordinates X and Y are interpreted in pixels
relative to a position
UINT trail_num = 0;
BOOL ret = false;
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
block_input ();
/* When "mouse trails" are in effect, moving the mouse cursor
@@ -9213,7 +9211,7 @@ The coordinates X and Y are interpreted in pixels
relative to a position
if (os_subtype == OS_NT
&& w32_major_version + w32_minor_version >= 6)
ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0);
- SetCursorPos (XFIXNUM (x), XFIXNUM (y));
+ SetCursorPos (xval, yval);
if (ret)
SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0);
unblock_input ();
diff --git a/src/window.c b/src/window.c
index 075fd4e..e2dea8b 100644
--- a/src/window.c
+++ b/src/window.c
@@ -2108,30 +2108,20 @@ though when run from an idle timer with a delay of zero
seconds. */)
|| window_outdated (w))
return Qnil;
- if (NILP (first))
- row = (NILP (body)
- ? MATRIX_ROW (w->current_matrix, 0)
- : MATRIX_FIRST_TEXT_ROW (w->current_matrix));
- else if (FIXNUMP (first))
- {
- CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows);
- row = MATRIX_ROW (w->current_matrix, XFIXNUM (first));
- }
- else
- error ("Invalid specification of first line");
-
- if (NILP (last))
-
- end_row = (NILP (body)
- ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
- : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
- else if (FIXNUMP (last))
- {
- CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows);
- end_row = MATRIX_ROW (w->current_matrix, XFIXNUM (last));
- }
- else
- error ("Invalid specification of last line");
+ row = (!NILP (first)
+ ? MATRIX_ROW (w->current_matrix,
+ check_integer_range (first, 0,
+ w->current_matrix->nrows))
+ : NILP (body)
+ ? MATRIX_ROW (w->current_matrix, 0)
+ : MATRIX_FIRST_TEXT_ROW (w->current_matrix));
+ end_row = (!NILP (last)
+ ? MATRIX_ROW (w->current_matrix,
+ check_integer_range (last, 0,
+ w->current_matrix->nrows))
+ : NILP (body)
+ ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
+ : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
while (row <= end_row && row->enabled_p
&& row->y + row->height < max_y)
@@ -4325,11 +4315,11 @@ Note: This function does not operate on any child
windows of WINDOW. */)
EMACS_INT size_min = NILP (add) ? 0 : - XFIXNUM (w->new_pixel);
EMACS_INT size_max = size_min + min (INT_MAX, MOST_POSITIVE_FIXNUM);
- CHECK_RANGED_INTEGER (size, size_min, size_max);
+ int checked_size = check_integer_range (size, size_min, size_max);
if (NILP (add))
wset_new_pixel (w, size);
else
- wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + XFIXNUM (size)));
+ wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + checked_size));
return w->new_pixel;
}
@@ -7506,8 +7496,7 @@ extract_dimension (Lisp_Object dimension)
{
if (NILP (dimension))
return -1;
- CHECK_RANGED_INTEGER (dimension, 0, INT_MAX);
- return XFIXNUM (dimension);
+ return check_integer_range (dimension, 0, INT_MAX);
}
static struct window *
diff --git a/src/xfns.c b/src/xfns.c
index 8de4c8b..ebe51b7 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1230,13 +1230,10 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
for (i = 0; i < mouse_cursor_max; i++)
{
Lisp_Object shape_var = *mouse_cursor_types[i].shape_var_ptr;
- if (!NILP (shape_var))
- {
- CHECK_TYPE_RANGED_INTEGER (unsigned, shape_var);
- cursor_data.cursor_num[i] = XFIXNUM (shape_var);
- }
- else
- cursor_data.cursor_num[i] = mouse_cursor_types[i].default_shape;
+ cursor_data.cursor_num[i]
+ = (!NILP (shape_var)
+ ? check_uinteger_max (shape_var, UINT_MAX)
+ : mouse_cursor_types[i].default_shape);
}
block_input ();
@@ -1801,10 +1798,7 @@ x_change_tool_bar_height (struct frame *f, int height)
static void
x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
{
- int border;
-
- CHECK_TYPE_RANGED_INTEGER (int, arg);
- border = max (XFIXNUM (arg), 0);
+ int border = check_int_nonnegative (arg);
if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
{
@@ -3376,10 +3370,12 @@ x_icon (struct frame *f, Lisp_Object parms)
= gui_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0,
RES_TYPE_NUMBER);
Lisp_Object icon_y
= gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0,
RES_TYPE_NUMBER);
+ int icon_xval, icon_yval;
+
if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
{
- CHECK_TYPE_RANGED_INTEGER (int, icon_x);
- CHECK_TYPE_RANGED_INTEGER (int, icon_y);
+ icon_xval = check_integer_range (icon_x, INT_MIN, INT_MAX);
+ icon_yval = check_integer_range (icon_y, INT_MIN, INT_MAX);
}
else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
error ("Both left and top icon corners of icon must be specified");
@@ -3387,7 +3383,7 @@ x_icon (struct frame *f, Lisp_Object parms)
block_input ();
if (! EQ (icon_x, Qunbound))
- x_wm_set_icon_position (f, XFIXNUM (icon_x), XFIXNUM (icon_y));
+ x_wm_set_icon_position (f, icon_xval, icon_yval);
#if false /* gui_display_get_arg removes the visibility parameter as a
side effect, but x_create_frame still needs it. */
@@ -5550,12 +5546,12 @@ The coordinates X and Y are interpreted in pixels
relative to a position
if (FRAME_INITIAL_P (f) || !FRAME_X_P (f))
return Qnil;
- CHECK_TYPE_RANGED_INTEGER (int, x);
- CHECK_TYPE_RANGED_INTEGER (int, y);
+ int xval = check_integer_range (x, INT_MIN, INT_MAX);
+ int yval = check_integer_range (y, INT_MIN, INT_MAX);
block_input ();
XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY
(f)),
- 0, 0, 0, 0, XFIXNUM (x), XFIXNUM (y));
+ 0, 0, 0, 0, xval, yval);
unblock_input ();
return Qnil;
diff --git a/src/xterm.c b/src/xterm.c
index fc68c77..bd9688f 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1291,11 +1291,7 @@ x_clear_under_internal_border (struct frame *f)
int border = FRAME_INTERNAL_BORDER_WIDTH (f);
int width = FRAME_PIXEL_WIDTH (f);
int height = FRAME_PIXEL_HEIGHT (f);
-#ifdef USE_GTK
- int margin = 0;
-#else
int margin = FRAME_TOP_MARGIN_HEIGHT (f);
-#endif
int face_id =
!NILP (Vface_remapping_alist)
? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
diff --git a/src/xwidget.c b/src/xwidget.c
index ea8987f..0347f1e 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -750,11 +750,9 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize,
3, 3, 0,
(Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height)
{
CHECK_XWIDGET (xwidget);
- CHECK_RANGED_INTEGER (new_width, 0, INT_MAX);
- CHECK_RANGED_INTEGER (new_height, 0, INT_MAX);
+ int w = check_integer_range (new_width, 0, INT_MAX);
+ int h = check_integer_range (new_height, 0, INT_MAX);
struct xwidget *xw = XXWIDGET (xwidget);
- int w = XFIXNAT (new_width);
- int h = XFIXNAT (new_height);
xw->width = w;
xw->height = h;
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 0fece40..0e6f278 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -63,6 +63,7 @@
(ert-deftest rx-char-any ()
"Test character alternatives with `]' and `-' (Bug#25123)."
(should (equal
+ ;; relint suppression: Range .<-]. overlaps previous .]-{
(rx string-start (1+ (char (?\] . ?\{) (?< . ?\]) (?- . ?:)))
string-end)
"\\`[.-:<-{-]+\\'")))
@@ -127,6 +128,10 @@
"[[:lower:][:upper:]-][^[:lower:][:upper:]-]"))
(should (equal (rx (any "]" lower upper) (not (any "]" lower upper)))
"[][:lower:][:upper:]][^][:lower:][:upper:]]"))
+ ;; relint suppression: Duplicated character .-.
+ ;; relint suppression: Single-character range .f-f
+ ;; relint suppression: Range .--/. overlaps previous .-
+ ;; relint suppression: Range .\*--. overlaps previous .--/
(should (equal (rx (any "-a" "c-" "f-f" "--/*--"))
"[*-/acf]"))
(should (equal (rx (any "]-a" ?-) (not (any "]-a" ?-)))
@@ -140,6 +145,7 @@
"\\`a\\`[^z-a]"))
(should (equal (rx (any "") (not (any "")))
"\\`a\\`[^z-a]"))
+ ;; relint suppression: Duplicated class .space.
(should (equal (rx (any space ?a digit space))
"[a[:space:][:digit:]]"))
(should (equal (rx (not "\n") (not ?\n) (not (any "\n")) (not-char ?\n)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7722219..7db9ad4 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -109,6 +109,10 @@
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
+(defconst tramp-test-vec
+ (tramp-dissect-file-name tramp-test-temporary-file-directory)
+ "The used `tramp-file-name' structure.")
+
(setq auth-source-save-behavior nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
@@ -141,9 +145,7 @@ being the result.")
(when (cdr tramp--test-enabled-checked)
;; Cleanup connection.
(ignore-errors
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- nil 'keep-password)))
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
;; Return result.
(cdr tramp--test-enabled-checked))
@@ -195,16 +197,12 @@ properly. BODY shall not contain a timeout."
(defsubst tramp--test-message (fmt-string &rest arguments)
"Emit a message into ERT *Messages*."
(tramp--test-instrument-test-case 0
- (apply
- #'tramp-message
- (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
- fmt-string arguments)))
+ (apply #'tramp-message tramp-test-vec 0 fmt-string arguments)))
(defsubst tramp--test-backtrace ()
"Dump a backtrace into ERT *Messages*."
(tramp--test-instrument-test-case 10
- (tramp-backtrace
- (tramp-dissect-file-name tramp-test-temporary-file-directory))))
+ (tramp-backtrace tramp-test-vec)))
(defmacro tramp--test-print-duration (message &rest body)
"Run BODY and print a message with duration, prompted by MESSAGE."
@@ -1966,9 +1964,9 @@ properly. BODY shall not contain a timeout."
;; Host names must match rules in case the command template of a
;; method doesn't use them.
(dolist (m '("su" "sg" "sudo" "doas" "ksu"))
- (let ((vec (tramp-dissect-file-name tramp-test-temporary-file-directory))
- tramp-connection-properties tramp-default-proxies-alist)
- (ignore-errors (tramp-cleanup-connection vec nil 'keep-password))
+ (let (tramp-connection-properties tramp-default-proxies-alist)
+ (ignore-errors
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password))
;; Single hop. The host name must match `tramp-local-host-regexp'.
(should-error
(find-file (format "/%s:foo:" m))
@@ -3136,8 +3134,7 @@ This tests also `access-file', `file-readable-p',
(setq test-file-ownership-preserved-p
(= (tramp-compat-file-attribute-group-id
(file-attributes tmp-name1))
- (tramp-get-remote-gid
- (tramp-dissect-file-name tmp-name1) 'integer)))
+ (tramp-get-remote-gid tramp-test-vec 'integer)))
(delete-file tmp-name1))
(should-error
@@ -3406,7 +3403,7 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
;; in tramp-sh.el, we must ensure that the remote chmod command
;; supports the "-h" argument.
(when (and (tramp--test-emacs28-p) (tramp--test-sh-p)
- (tramp-get-remote-chmod-h (tramp-dissect-file-name tmp-name1)))
+ (tramp-get-remote-chmod-h tramp-test-vec))
(unwind-protect
(with-no-warnings
(write-region "foo" nil tmp-name1)
@@ -4038,7 +4035,6 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(when (not (memq system-type '(cygwin windows-nt)))
(let ((method (file-remote-p tramp-test-temporary-file-directory 'method))
(host (file-remote-p tramp-test-temporary-file-directory 'host))
- (vec (tramp-dissect-file-name tramp-test-temporary-file-directory))
(orig-syntax tramp-syntax))
(when (and (stringp host) (string-match tramp-host-with-port-regexp
host))
(setq host (match-string 1 host)))
@@ -4051,7 +4047,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
;; for completion. We must refill the cache.
- (tramp-set-connection-property vec "property" nil)
+ (tramp-set-connection-property tramp-test-vec "property" nil)
(let ;; This is needed for the `simplified' syntax.
((method-marker
@@ -4252,7 +4248,6 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(ert-deftest tramp-test29-start-file-process ()
"Check `start-file-process'."
- :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed)
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
@@ -4326,14 +4321,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
- :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed)
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
- (tramp--test-instrument-test-case 10
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -4494,7 +4487,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmpfile))))))))
+ (ignore-errors (delete-file tmpfile)))))))
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
@@ -4744,7 +4737,6 @@ INPUT, if non-nil, is a string sent to the process."
;; This test is inspired by Bug#23952.
(ert-deftest tramp-test33-environment-variables ()
"Check that remote processes set / unset environment variables properly."
- :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed)
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
@@ -4790,9 +4782,7 @@ INPUT, if non-nil, is a string sent to the process."
(funcall this-shell-command-to-string "set")))))
;; We force a reconnect, in order to have a clean environment.
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(unwind-protect
;; Unset the variable.
(let ((tramp-remote-process-environment
@@ -5039,23 +5029,20 @@ INPUT, if non-nil, is a string sent to the process."
(default-directory tramp-test-temporary-file-directory)
(orig-exec-path (with-no-warnings (exec-path)))
(tramp-remote-path tramp-remote-path)
- (orig-tramp-remote-path tramp-remote-path))
+ (orig-tramp-remote-path tramp-remote-path)
+ path)
(unwind-protect
(progn
;; Non existing directories are removed.
(setq tramp-remote-path
(cons (file-remote-p tmp-name 'localname) tramp-remote-path))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
(setq tramp-remote-path orig-tramp-remote-path)
;; Double entries are removed.
(setq tramp-remote-path (append '("/" "/") tramp-remote-path))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should
(equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path)))
(setq tramp-remote-path orig-tramp-remote-path)
@@ -5067,26 +5054,30 @@ INPUT, if non-nil, is a string sent to the process."
(let ((dir (make-temp-file (file-name-as-directory tmp-name)
'dir)))
(should (file-directory-p dir))
(setq tramp-remote-path
- (cons (file-remote-p dir 'localname) tramp-remote-path)
+ (append
+ tramp-remote-path `(,(file-remote-p dir 'localname)))
orig-exec-path
- (cons (file-remote-p dir 'localname) orig-exec-path))))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (append
+ (butlast orig-exec-path)
+ `(,(file-remote-p dir 'localname))
+ (last orig-exec-path)))))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
- (should
- (string-equal
- ;; Ignore trailing newline.
- (substring (shell-command-to-string "echo $PATH") nil -1)
+ ;; Ignore trailing newline.
+ (setq path (substring (shell-command-to-string "echo $PATH") nil -1))
+ ;; The shell doesn't handle such long strings.
+ (unless (<= (length path)
+ (tramp-get-connection-property
+ tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'.
- (mapconcat #'identity (butlast orig-exec-path) ":")))
+ (should
+ (string-equal
+ path (mapconcat #'identity (butlast orig-exec-path) ":"))))
;; The shell "sh" shall always exist.
(should (apply #'executable-find '("sh" remote))))
;; Cleanup.
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(setq tramp-remote-path orig-tramp-remote-path)
(ignore-errors (delete-directory tmp-name 'recursive)))))
@@ -5123,8 +5114,7 @@ INPUT, if non-nil, is a string sent to the process."
tramp-remote-process-environment))
;; We must force a reconnect, in order to activate $BZR_HOME.
(tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ tramp-test-vec 'keep-debug 'keep-password)
'(Bzr))
(t nil))))
;; Suppress nasty messages.
@@ -6072,10 +6062,7 @@ process sentinels. They shall not disturb each other."
0 timer-repeat
(lambda ()
(tramp--test-with-proper-process-name-and-buffer
- (get-buffer-process
- (tramp-get-buffer
- (tramp-dissect-file-name
- tramp-test-temporary-file-directory)))
+ (get-buffer-process (tramp-get-buffer tramp-test-vec))
(when (> (- (time-to-seconds) (time-to-seconds timer-start))
tramp--test-asynchronous-requests-timeout)
(tramp--test-timeout-handler))
diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el
index bb3f658..86a40a9 100644
--- a/test/lisp/vc/log-edit-tests.el
+++ b/test/lisp/vc/log-edit-tests.el
@@ -74,6 +74,31 @@ couple of sentences. Long enough to be
filled for several lines.
\(fun9): Etc."))))
+(ert-deftest log-edit-fill-entry-indented-func-entries ()
+ ;; Indenting function entries is a typical mistake caused by using a
+ ;; misconfigured or non-ChangeLog specific fill function.
+ (with-temp-buffer
+ (insert "\
+* dir/file.ext (fun1):
+ (fun2):
+ (fun3):
+* file2.txt (fun4):
+ (fun5):
+ (fun6):
+ (fun7): Some prose.
+ (fun8): A longer description of a complicated change.\
+ Spread over a couple of sentences.\
+ Long enough to be filled for several lines.
+ (fun9): Etc.")
+ (goto-char (point-min))
+ (let ((fill-column 72)) (log-edit-fill-entry))
+ (should (equal (buffer-string) "\
+* dir/file.ext (fun1, fun2, fun3):
+* file2.txt (fun4, fun5, fun6, fun7): Some prose.
+\(fun8): A longer description of a complicated change. Spread over a
+couple of sentences. Long enough to be filled for several lines.
+\(fun9): Etc."))))
+
(ert-deftest log-edit-fill-entry-trailing-prose ()
(with-temp-buffer
(insert "\
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 094a1fa..93e6709 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -375,6 +375,25 @@
(with-temp-buffer (insert-file-contents (car file))))))
(insert (format "%s: %s\n" (car file) result)))))))
+(ert-deftest coding-nocopy-trivial ()
+ "Check that the NOCOPY parameter works for the trivial coding system."
+ (let ((s "abc"))
+ (should-not (eq (decode-coding-string s nil nil) s))
+ (should (eq (decode-coding-string s nil t) s))
+ (should-not (eq (encode-coding-string s nil nil) s))
+ (should (eq (encode-coding-string s nil t) s))))
+
+(ert-deftest coding-nocopy-ascii ()
+ "Check that the NOCOPY parameter works for ASCII-only strings."
+ (let* ((uni (apply #'string (number-sequence 0 127)))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ (dolist (coding '(us-ascii iso-latin-1 utf-8))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s))
+ (should (eq (encode-coding-string s coding t) s))))))
+
;; Local Variables:
;; byte-compile-warnings: (not obsolete)
;; End: