procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'savannah/master' into HEAD

Browse source
This commit is contained in:
Andrea Corallo 2020-04-06 18:06:29 +01:00
commit 4abb8c822c
39 changed files with 711 additions and 560 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
doc/emacs/building.texi
View file

@ -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

2
doc/man/emacs.1.in
View file

@ -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.

6
etc/NEWS
View file

@ -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
---

18
lisp/emacs-lisp/cl-macs.el
View file

@ -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

17
lisp/emacs-lisp/re-builder.el
View file

@ -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)

16
lisp/epg-config.el
View file

@ -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))

3
lisp/htmlfontify.el
View file

@ -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)

14
lisp/imenu.el
View file

@ -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)

524
lisp/mouse.el
View file

@ -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))))))
((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 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))
;; 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.

6
lisp/net/tramp-cache.el
View file

@ -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

14
lisp/net/tramp-sh.el
View file

@ -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 --

75
lisp/progmodes/gdb-mi.el
View file

@ -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 ()

14
lisp/progmodes/gud.el
View file

@ -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)

2
lisp/progmodes/project.el
View file

@ -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))

1
lisp/progmodes/xref.el
View file

@ -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))

2
lisp/vc/log-edit.el
View file

@ -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.

36
src/bignum.c
View file

@ -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);
}

8
src/buffer.c
View file

@ -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,

5
src/character.c
View file

@ -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;
}

33
src/charset.c
View file

@ -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
{

37
src/coding.c
View file

@ -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));
}

2
src/emacs-module.c
View file

@ -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;

4
src/fileio.c
View file

@ -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);

99
src/frame.c
View file

@ -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;
}

3
src/lcms.c
View file

@ -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 \

23
src/lisp.h
View file

@ -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 {

22
src/menu.c
View file

@ -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);
}

19
src/nsfns.m
View file

@ -706,14 +706,11 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side.
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 @@ value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are
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);

13
src/process.c
View file

@ -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;

9
src/search.c
View file

@ -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);

12
src/w32fns.c
View file

@ -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 ();

45
src/window.c
View file

@ -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 *

30
src/xfns.c
View file

@ -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;

4
src/xterm.c
View file

@ -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)

6
src/xwidget.c
View file

@ -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;

6
test/lisp/emacs-lisp/rx-tests.el
View file

@ -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)

89
test/lisp/net/tramp-tests.el
View file

@ -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))

25
test/lisp/vc/log-edit-tests.el
View file

@ -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 "\

19
test/src/coding-tests.el
View file

@ -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: