commit e65647a70e5c055c4cdab004d671c198c7a1d3ce (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Fri Jun 3 12:32:17 2022 +0800 Add easier-to-use interfaces for initiating drag-and-drop The previous interface required that users know intricacies of the data types used to transfer data on each platform Emacs supports. * doc/lispref/frames.texi (Drag and Drop): Document new functions. * lisp/dired.el (dired-last-dragged-remote-file) (dired-remove-last-dragged-local-file): Delete functions. (dired-mouse-drag): Use `dnd-begin-file-drag'. * lisp/dnd.el (dnd-last-dragged-remote-file) (dnd-remove-last-dragged-remote-file): New variables and functions. (dnd-begin-text-drag, dnd-begin-file-drag): New functions. * src/xterm.c (x_dnd_begin_drag_and_drop): Add porting note. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a2a74f8148..26b519be23 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4094,6 +4094,95 @@ specific drag-n-drop protocol being used. Plain text may be On capable window systems, Emacs also supports dragging contents from its frames to windows of other applications. +@defun dnd-begin-text-drag text &optional frame action allow-same-frame +This function begins dragging text from @var{frame} to another program +(the drop target), and returns until it is dropped or the +drag-and-drop operation is cancelled. + +The return value is the action that the drop target actually +performed, which can be one of the following symbols: + +@table @code +@item copy +The drop target inserted @var{text}. + +@item move +The drop target inserted @var{text}, but in addition the caller should +delete @var{text} from wherever it originated, such as a buffer. + +@item private +The drop target performed an unspecified action. +@end table + +@code{nil} can also be returned if the drag-and-drop operation was +cancelled. + +@var{text} is the text that will be inserted by the drop target. + +@var{action} must be one of the symbols @code{copy} or @code{move}, +where @code{copy} means that @var{text} should be inserted by the drop +target, and @code{move} means the same as @code{copy}, but in addition +the caller may have to delete @var{text} from its source as explained +above. + +@var{frame} is the frame where the mouse is currently held down, or +@code{nil}, which means to use the selected frame. This function may +return immediately if no mouse buttons are held down, so it should be +only called immediately after a @code{down-mouse-1} or similar event +(@pxref{Mouse Events}), with @var{frame} set to the frame where that +event was generated (@pxref{Click Events}). + +@var{allow-same-frame} specifies whether or not drops on top of +@var{frame} itself won't be ignored. +@end defun + +@defun dnd-begin-file-drag file &optional frame action allow-same-frame +This function begins dragging @var{file} from @var{frame} to another +program, and returns until it is dropped or the drag-and-drop +operation is cancelled. + +The return value is the action that the drop target actually +performed, which can be one of the following symbols: + +@table @code +@item copy +The drop target opened or copied @var{file} to a different location. + +@item move +The drop target moved @var{file} to a different location. + +@item link +The drop target (usually a file manager) created a symbolic link to +@var{file}. + +@item private +The drop target performed an unspecified action. +@end table + +@code{nil} can also be returned if the drag-and-drop operation was +cancelled. + +If @var{file} is a remote file, then a temporary copy will be made. + +@var{action} must be one of the symbols @code{copy}, @code{move} or +@code{link}, where @code{copy} means that @var{file} should be opened +or copied by the drop target, @code{move} means the drop target should +move the file to another location, and @code{link} means the drop +target should create a symbolic link to @var{file}. It is an error to +specify @code{link} as the action if @var{file} is a remote file. + +@var{frame} and @var{allow-same-frame} mean the same as in +@code{dnd-begin-text-drag}. +@end defun + +@cindex initiating drag-and-drop, low-level + The high-level interfaces described above are implemented on top of +a lower-level primitive. If you need to drag content other than files +or text, the low-level interface @code{x-begin-drag} can be used +instead. However, using it will require detailed knowledge of the +data types and actions used by the programs to transfer content via +drag-and-drop on each platform you want to support. + @defun x-begin-drag targets &optional action frame return-frame allow-current-frame This function begins a drag from @var{frame}, and returns when the drag-and-drop operation ends, either because the drop was successful, diff --git a/lisp/dired.el b/lisp/dired.el index 5a1fce860e..94df2ddc4e 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -38,6 +38,7 @@ (eval-when-compile (require 'cl-lib)) ;; When bootstrapping dired-loaddefs has not been generated. (require 'dired-loaddefs nil t) +(require 'dnd) (declare-function dired-buffer-more-recently-used-p "dired-x" (buffer1 buffer2)) @@ -1702,29 +1703,13 @@ see `dired-use-ls-dired' for more details.") beg)) beg)))) -(defvar dired-last-dragged-remote-file nil - "If non-nil, the name of a local copy of the last remote file that was dragged. -It can't be removed immediately after the drag-and-drop operation -completes, since there is no way to determine when the drop -target has finished opening it. So instead, this file is removed -when Emacs exits or the user drags another file.") - (declare-function x-begin-drag "xfns.c") -(defun dired-remove-last-dragged-local-file () - "Remove the local copy of the last remote file to be dragged." - (when dired-last-dragged-remote-file - (unwind-protect - (delete-file dired-last-dragged-remote-file) - (setq dired-last-dragged-remote-file nil))) - (remove-hook 'kill-emacs-hook #'dired-remove-last-dragged-local-file)) - (defun dired-mouse-drag (event) "Begin a drag-and-drop operation for the file at EVENT." (interactive "e") (when mark-active (deactivate-mark)) - (dired-remove-last-dragged-local-file) (save-excursion (with-selected-window (posn-window (event-end event)) (goto-char (posn-point (event-end event)))) @@ -1753,32 +1738,10 @@ when Emacs exits or the user drags another file.") (event-end event)) (dired-file-name-at-point)))) (when filename - ;; In theory x-dnd-username combined with a proper - ;; file URI containing the hostname of the remote - ;; server could be used here instead of creating a - ;; local copy of the remote file, but no program - ;; actually implements file DND according to the - ;; spec. - (when (file-remote-p filename) - (setq filename (file-local-copy filename)) - (setq dired-last-dragged-remote-file filename) - (add-hook 'kill-emacs-hook - #'dired-remove-last-dragged-local-file)) - (gui-backend-set-selection - ;; FIXME: this seems arbitrarily confusing. - ;; Should drag-and-drop for common items (such as - ;; files and text) should be abstracted into - ;; dnd.el? - 'XdndSelection - (propertize filename 'text/uri-list - (concat "file://" - (expand-file-name filename)))) - (x-begin-drag '("text/uri-list" "text/x-dnd-username" - "FILE_NAME" "FILE" "HOST_NAME" "_DT_NETFILE") - (if (eq 'dired-mouse-drag-files 'link) - 'XdndActionLink - 'XdndActionCopy) - nil nil t))) + (dnd-begin-file-drag filename nil + (if (eq 'dired-mouse-drag-files 'link) + 'move 'copy) + t))) (error (when (eq (event-basic-type new-event) 'mouse-1) (push new-event unread-command-events)))))))))) diff --git a/lisp/dnd.el b/lisp/dnd.el index 4f71edf1aa..f45f8fc849 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -33,6 +33,9 @@ ;;; Customizable variables +(eval-when-compile + (require 'cl-lib)) + (defgroup dnd nil "Handling data from drag and drop." :group 'environment) @@ -278,6 +281,168 @@ TEXT is the text as a string, WINDOW is the window where the drop happened." (insert text)) action) + +;;; Functions for dragging stuff to other programs. These build upon +;;; the lower-level `x-begin-drag' interface, but take care of data +;;; types and abstracting around the different return values. + +(defvar dnd-last-dragged-remote-file nil + "If non-nil, the name of a local copy of the last remote file that was dragged. +It can't be removed immediately after the drag-and-drop operation +completes, since there is no way to determine when the drop +target has finished opening it. So instead, this file is removed +when Emacs exits or the user drags another file.") + +(defun dnd-remove-last-dragged-remote-file () + "Remove the local copy of the last remote file to be dragged." + (when dnd-last-dragged-remote-file + (unwind-protect + (delete-file dnd-last-dragged-remote-file) + (setq dnd-last-dragged-remote-file nil))) + (remove-hook 'kill-emacs-hook #'dnd-remove-last-dragged-remote-file)) + +(declare-function x-begin-drag "xfns.c") + +(defun dnd-begin-text-drag (text &optional frame action allow-same-frame) + "Begin dragging TEXT from FRAME. +Initate a drag-and-drop operation allowing the user to drag text +from Emacs to another program (the drop target), then block until +the drop happens or is cancelled. + +Return the action that the drop target actually performed, which +can be one of the following symbols: + + - `copy', which means TEXT was inserted by the drop target. + + - `move', which means TEXT was inserted, and the caller should + additionally delete TEXT from its source (such as the buffer + where it originated). + + - `private', which means the drop target chose to perform an + unspecified action. + +Return nil if the drop was cancelled. + +TEXT is a string containing text that will be inserted by the +program where the drop happened. FRAME is the frame where the +mouse is currently held down, or nil (which means to use the +current frame). ACTION is one of the symbols `copy' or `move', +where `copy' means that the text should be inserted by the drop +target, and `move' means the the same as copy, but in addition +the caller might have to delete TEXT from its source after this +function returns. If ALLOW-SAME-FRAME is nil, any drops on FRAME +itself will be ignored. + +This function might return immediately if no mouse buttons are +currently being held down. It should only be called upon a +`down-mouse-1' (or similar) event." + (unless (fboundp 'x-begin-drag) + (error "Dragging text from Emacs is not supported by this window system")) + (gui-set-selection 'XdndSelection text) + (unless action + (setq action 'copy)) + (let ((return-value + (x-begin-drag '(;; Traditional X selection targets used by GTK, the + ;; Motif drag-and-drop protocols, and programs like + ;; Xterm. `STRING' is also used on NS and Haiku. + "STRING" "TEXT" "COMPOUND_TEXT" "UTF8_STRING" + ;; Used by Xdnd clients that strictly comply with + ;; the standard (i.e. Qt programs). + "text/plain" "text/plain;charset=utf-8") + (cl-ecase action + ('copy 'XdndActionCopy) + ('move 'XdndActionMove)) + frame nil allow-same-frame))) + (cond + ((eq return-value 'XdndActionCopy) 'copy) + ((eq return-value 'XdndActionMove) 'move) + ((not return-value) nil) + (t 'private)))) + +(defun dnd-begin-file-drag (file &optional frame action allow-same-frame) + "Begin dragging FILE from FRAME. +Initate a drag-and-drop operation allowing the user to drag files +from Emacs to another program (the drop target), then block until +the drop happens or is cancelled. + +Return the action that the drop target actually performed, which +can be one of the following symbols: + + - `copy', which means FILE was opened by the drop target. + + - `move', which means FILE was moved to another location by the + drop target. + + - `link', which means a symbolic link was created to FILE by + the drop target, usually a file manager. + + - `private', which means the drop target chose to perform an + unspecified action. + +Return nil if the drop was cancelled. + +FILE is the file name that will be inserted by the program where +the drop happened. If it is a remote file, a temporary copy will +be made. FRAME is the frame where the mouse is currently held +down, or nil (which means to use the current frame). ACTION is +one of the symbols `copy', `move' or `link', where `copy' means +that the file should be opened or copied by the drop target, +`move' means the drop target should move the file to another +location, and `link' means the drop target should create a +symbolic link to FILE. It is an error to specify `link' as the +action if FILE is a remote file. If ALLOW-SAME-FRAME is nil, any +drops on FRAME itself will be ignored. + +This function might return immediately if no mouse buttons are +currently being held down. It should only be called upon a +`down-mouse-1' (or similar) event." + (unless (fboundp 'x-begin-drag) + (error "Dragging files from Emacs is not supported by this window system")) + (dnd-remove-last-dragged-remote-file) + (unless action + (setq action 'copy)) + (let ((original-file file)) + (when (file-remote-p file) + (if (eq action 'link) + (error "Cannot create symbolic link to remote file") + (setq file (file-local-copy file)) + (setq dnd-last-dragged-remote-file file) + (add-hook 'kill-emacs-hook + #'dnd-remove-last-dragged-remote-file))) + (gui-set-selection 'XdndSelection + (propertize file 'text/uri-list + (concat "file://" + (expand-file-name file)))) + (let ((return-value + (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other + ;; modern programs that expect filenames to + ;; be supplied as URIs. + "text/uri-list" "text/x-dnd-username" + ;; Traditional X selection targets used by + ;; programs supporting the Motif + ;; drag-and-drop protocols. Also used by NS + ;; and Haiku. + "FILE_NAME" "FILE" "HOST_NAME" + ;; ToolTalk filename. Mostly used by CDE + ;; programs. + "_DT_NETFILE") + (cl-ecase action + ('copy 'XdndActionCopy) + ('move 'XdndActionMove) + ('link 'XdndActionLink)) + frame nil allow-same-frame))) + (cond + ((eq return-value 'XdndActionCopy) 'copy) + ((eq return-value 'XdndActionMove) + (prog1 'move + ;; If original-file is a remote file, delete it from the + ;; remote as well. + (when (file-remote-p original-file) + (ignore-errors + (delete-file original-file))))) + ((eq return-value 'XdndActionLink) 'link) + ((not return-value) nil) + (t 'private))))) (provide 'dnd) diff --git a/src/xterm.c b/src/xterm.c index bca24f22e3..ecee000439 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10414,6 +10414,20 @@ x_next_event_from_any_display (XEvent *event) /* This function is defined far away from the rest of the XDND code so it can utilize `x_any_window_to_frame'. */ +/* Implementors beware! On most other platforms (where drag-and-drop + data is not provided via selections, but some kind of serialization + mechanism), it is usually much easier to implement a suitable + primitive instead of copying the C code here, and then to build + `x-begin-drag' on top of that, by making it a wrapper function in + Lisp that converts the list of targets and value of `XdndSelection' + to serialized data. Also be sure to update the data types used in + dnd.el. + + For examples of how to do this, see `haiku-drag-message' and + `x-begin-drag' in haikuselect.c and lisp/term/haiku-win.el, and + `ns-begin-drag' and `x-begin-drag' in nsselect.m and + lisp/term/ns-win.el. */ + Lisp_Object x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, Lisp_Object return_frame, Atom *ask_action_list, commit 1d5eb67c6a87bcf155429b11af98de913e901dd9 Author: Lars Ingebrigtsen Date: Fri Jun 3 05:56:44 2022 +0200 Add a new user option battery-update-functions * doc/emacs/display.texi (Optional Mode Line): Document it. * lisp/battery.el (battery-update-functions): New user option (bug#55770). (battery-update): Use it. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2fea79b2bb..16d6d5567e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1594,7 +1594,9 @@ charge on the mode-line, by using the command @code{battery-mode-line-format} determines the way the battery charge is displayed; the exact mode-line message depends on the operating system, and it usually shows the current battery charge as a -percentage of the total charge. +percentage of the total charge. The functions in +@code{battery-update-functions} are run after updating the mode line, +and can be used to trigger actions based on the battery status. @cindex mode line, 3D appearance @cindex attributes of mode line, changing diff --git a/etc/NEWS b/etc/NEWS index 352f575bee..3870e937df 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -862,6 +862,12 @@ so automatically. * Changes in Specialized Modes and Packages in Emacs 29.1 +** Battery + ++++ +*** New user option 'battery-update-functions'. +This can be used to trigger actions based on the battery status. + ** Enriched Mode +++ diff --git a/lisp/battery.el b/lisp/battery.el index b7b81a11a1..cd68d7601f 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -232,6 +232,40 @@ The text being displayed in the echo area is controlled by the variables (funcall battery-status-function)) "Battery status not available"))) +(defcustom battery-update-functions nil + "Functions run by `display-battery-mode' after updating the status. +These functions will be called with one parameter: An alist that +contains data about the current battery status. The key in the +alist is a character, and the values in the alist are strings. +Different battery backends deliver different information, so the +following information may or may not be available: + + v: driver-version + V: bios-version + I: bios-interface + L: line-status + B: battery-status + b: battery-status-symbol + p: load-percentage + s: seconds + m: minutes + h: hours + t: remaining-time + +For instance, to play an alarm when the battery power dips below +10%, you could use a function like the following: + +(defvar my-prev-battery nil) +(defun my-battery-alarm (data) + (when (and my-prev-battery + (equal (alist-get ?L data) \"off-line\") + (< (string-to-number (alist-get ?p data)) 10) + (>= (string-to-number (alist-get ?p my-prev-battery)) 10)) + (play-sound-file \"~/alarm.wav\" 5)) + (setq my-prev-battery data))" + :version "29.1" + :type '(repeat function)) + ;;;###autoload (define-minor-mode display-battery-mode "Toggle battery status display in mode line (Display Battery mode). @@ -239,7 +273,11 @@ The text being displayed in the echo area is controlled by the variables The text displayed in the mode line is controlled by `battery-mode-line-format' and `battery-status-function'. The mode line is be updated every `battery-update-interval' -seconds." +seconds. + +The update function will call the functions in +`battery-update-functions', which can be used to trigger actions +based on battery events." :global t (setq battery-mode-line-string "") (or global-mode-string (setq global-mode-string '(""))) @@ -279,7 +317,8 @@ seconds." ((< percentage battery-load-low) (add-face-text-property 0 len 'battery-load-low t res))) (put-text-property 0 len 'help-echo "Battery status information" res)) - (setq battery-mode-line-string (or res ""))) + (setq battery-mode-line-string (or res "")) + (run-hook-with-args 'battery-update-functions data)) (force-mode-line-update t)) commit 1e42c2c5fcf3f6162de3072d221c2f97c9fb1c67 Author: Lars Ingebrigtsen Date: Fri Jun 3 05:20:16 2022 +0200 Remove window-max-characters-per-line * doc/lispref/windows.texi (Window Sizes): * doc/lispref/display.texi (Size of Displayed Text): Remove documentation. * lisp/fringe.el (fringe-mode): Point to the right function. * lisp/window.el (window-char-pixel-width) (window-char-pixel-height, window-max-characters-per-line): Remove functions -- this was already added as window-max-chars-per-line. * src/window.c (Fwindow_body_width): Adjust doc string. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index f428fb858b..653b249a40 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2257,20 +2257,6 @@ This is a convenience function that uses @code{window-text-pixel-size} to compute the width of @var{string} (in pixels). @end defun -@defun window-char-pixel-width &optional window face -Return the average character width for the font used by @var{face} in -@var{window}. If @var{face} is @code{nil} or omitted, the -@code{default} face is used. If @var{windows} is @code{nil} or -omitted, the currently selected window is used. -@end defun - -@defun window-char-pixel-height &optional window face -Return the average character height for the font used by @var{face} in -@var{window}. If @var{face} is @code{nil} or omitted, the -@code{default} face is used. If @var{windows} is @code{nil} or -omitted, the currently selected window is used. -@end defun - @defun line-pixel-height This function returns the height in pixels of the line at point in the selected window. The value includes the line spacing of the line diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 03d0f28867..0d285b2ad4 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -759,15 +759,6 @@ column and total width (@pxref{Coordinates and Windows}). The optional argument @var{round} behaves as it does for @code{window-total-height}. @end defun -@defun window-max-characters-per-line &optional window face -The maximum width of a line that can be displayed in a window (without -breaking the line) depends on many things, like the font used on the -line, and whether there are fringes around the window. This -convenience function can be used to calculate that number. If -@var{window} isn't given, this defaults to the currently selected -window. if @var{var} isn't given, the @code{default} face is used. -@end defun - @defun window-total-size &optional window horizontal round This function returns either the total height in lines or the total width in columns of the window @var{window}. If @var{horizontal} is diff --git a/etc/NEWS b/etc/NEWS index 71c19c06b4..352f575bee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2022,12 +2022,6 @@ The new 'x-show-tooltip-timeout' variable allows the user to alter this for packages that don't use 'tooltip-show', but instead call the lower level function directly. -+++ -** New function 'window-max-characters-per-line'. - -+++ -** New function 'window-char-pixel-width'. - --- ** New function 'current-cpu-time'. It gives access to the CPU time used by the Emacs process, for diff --git a/lisp/fringe.el b/lisp/fringe.el index 2fcdc9be07..657a73772d 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -253,7 +253,7 @@ Note that removing a right or left fringe (by setting the width to zero) makes Emacs reserve one column of the window body to display a line continuation marker. (This happens for both the left and right fringe, since Emacs can display both left-to-right -and right-to-left text.) You can use `window-max-characters-per-line' +and right-to-left text.) You can use `window-max-chars-per-line' to check the effective width. Fringe widths set by `set-window-fringes' override the default diff --git a/lisp/window.el b/lisp/window.el index 7f1265b9ac..5da867715f 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10570,55 +10570,6 @@ displaying that processes's buffer." (put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) (put 'shrink-window 'repeat-map 'resize-window-repeat-map) -(defun window-char-pixel-width (&optional window face) - "Return average character width for the font of FACE used in WINDOW. -WINDOW must be a live window and defaults to the selected one. - -If FACE is nil or omitted, the default face is used. If FACE is -remapped (see `face-remapping-alist'), the function returns the -information for the remapped face." - (with-selected-window (window-normalize-window window t) - (let* ((info (font-info (face-font (or face 'default)))) - (width (aref info 11))) - (if (> width 0) - width - (aref info 10))))) - -(defun window-char-pixel-height (&optional window face) - "Return character height for the font of FACE used in WINDOW. -WINDOW must be a live window and defaults to the selected one. - -If FACE is nil or omitted, the default face is used. If FACE is -remapped (see `face-remapping-alist'), the function returns the -information for the remapped face." - (with-selected-window (window-normalize-window window t) - (aref (font-info (face-font (or face 'default))) 3))) - -(defun window-max-characters-per-line (&optional window face) - "Return the number of characters that can be displayed on one line in WINDOW. -WINDOW must be a live window and defaults to the selected one. - -The character width of FACE is used for the calculation. If FACE -is nil or omitted, the default face is used. If FACE is -remapped (see `face-remapping-alist'), the function uses the -remapped face. - -This function is different from `window-body-width' in two -ways. First, it accounts for the portions of the line reserved -for the continuation glyph. Second, it accounts for the size of -the font, which may have been adjusted, e.g., using -`text-scale-increase')." - (with-selected-window (window-normalize-window window t) - (let* ((window-width (window-body-width window t)) - (font-width (window-char-pixel-width window face)) - (ncols (/ window-width font-width))) - (if (and (display-graphic-p) - overflow-newline-into-fringe - (/= (frame-parameter nil 'left-fringe) 0) - (/= (frame-parameter nil 'right-fringe) 0)) - ncols - (1- ncols))))) - (provide 'window) ;;; window.el ends here diff --git a/src/window.c b/src/window.c index d3e8afd68a..eba1390fed 100644 --- a/src/window.c +++ b/src/window.c @@ -1081,7 +1081,7 @@ visible, that column is not counted. Note that the returned value includes the column reserved for the continuation glyph. -Also see `window-max-characters-per-line'. */) +Also see `window-max-chars-per-line'. */) (Lisp_Object window, Lisp_Object pixelwise) { return make_fixnum (window_body_width (decode_live_window (window), commit 2340243a312367e225437c7018cd1139afd7e189 Author: Po Lu Date: Fri Jun 3 09:43:42 2022 +0800 Fix GTK build * src/xterm.c (x_dnd_begin_drag_and_drop) [USE_GTK]: Adjust call to x_dnd_free_toplevels as well. diff --git a/src/xterm.c b/src/xterm.c index d64d78f647..bca24f22e3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10917,7 +10917,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_dnd_waiting_for_finish = false; if (x_dnd_use_toplevels) - x_dnd_free_toplevels (); + x_dnd_free_toplevels (true); x_dnd_return_frame_object = NULL; x_dnd_movement_frame = NULL; commit 36af7004e2bf0db1d9c2fd1312215a931c1db3df Author: Po Lu Date: Fri Jun 3 08:51:49 2022 +0800 Don't call XSelectInput on a dying display when cancelling drag-and-drop * src/xterm.c (x_dnd_free_toplevels): New argument `display_alive'. (x_dnd_cleanup_drag_and_drop, x_dnd_begin_drag_and_drop) (handle_one_xevent): Change calls to `x_dnd_free_toplevels'. (x_connection_closed, x_delete_terminal): Set it to false. diff --git a/src/xterm.c b/src/xterm.c index f8b1f0db74..d64d78f647 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -2288,7 +2288,7 @@ x_dnd_send_xm_leave_for_drop (struct x_display_info *dpyinfo, } static void -x_dnd_free_toplevels (void) +x_dnd_free_toplevels (bool display_alive) { struct x_client_list_window *last; struct x_client_list_window *tem = x_dnd_toplevels; @@ -2298,13 +2298,16 @@ x_dnd_free_toplevels (void) last = tem; tem = tem->next; - x_catch_errors (last->dpy); - XSelectInput (last->dpy, last->window, - last->previous_event_mask); + if (display_alive) + { + x_catch_errors (last->dpy); + XSelectInput (last->dpy, last->window, + last->previous_event_mask); #ifdef HAVE_XSHAPE - XShapeSelectInput (last->dpy, last->window, None); + XShapeSelectInput (last->dpy, last->window, None); #endif - x_uncatch_errors (); + x_uncatch_errors (); + } #ifdef HAVE_XSHAPE if (last->n_input_rects != -1) @@ -4054,7 +4057,7 @@ x_dnd_cleanup_drag_and_drop (void *frame) x_dnd_waiting_for_finish = false; if (x_dnd_use_toplevels) - x_dnd_free_toplevels (); + x_dnd_free_toplevels (true); FRAME_DISPLAY_INFO (f)->grabbed = 0; #ifdef USE_GTK @@ -10647,7 +10650,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, { if (x_dnd_compute_toplevels (FRAME_DISPLAY_INFO (f))) { - x_dnd_free_toplevels (); + x_dnd_free_toplevels (true); x_dnd_use_toplevels = false; } } @@ -10843,7 +10846,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_dnd_waiting_for_finish = false; if (x_dnd_use_toplevels) - x_dnd_free_toplevels (); + x_dnd_free_toplevels (true); x_dnd_return_frame_object = NULL; x_dnd_movement_frame = NULL; @@ -10993,7 +10996,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_dnd_return_frame_object = NULL; if (x_dnd_use_toplevels) - x_dnd_free_toplevels (); + x_dnd_free_toplevels (true); FRAME_DISPLAY_INFO (f)->grabbed = 0; /* Emacs can't respond to DND events inside the nested event @@ -15901,11 +15904,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, { if (x_dnd_use_toplevels) { - x_dnd_free_toplevels (); + x_dnd_free_toplevels (true); if (x_dnd_compute_toplevels (dpyinfo)) { - x_dnd_free_toplevels (); + x_dnd_free_toplevels (true); x_dnd_use_toplevels = false; } } @@ -21790,7 +21793,7 @@ x_connection_closed (Display *dpy, const char *error_message, bool ioerror) x_dnd_waiting_for_finish = false; if (x_dnd_use_toplevels) - x_dnd_free_toplevels (); + x_dnd_free_toplevels (false); x_dnd_return_frame_object = NULL; x_dnd_movement_frame = NULL; @@ -25838,8 +25841,10 @@ x_delete_terminal (struct terminal *terminal) x_dnd_in_progress = false; x_dnd_waiting_for_finish = false; + /* The display is going away, so there's no point in + de-selecting for input on the DND toplevels. */ if (x_dnd_use_toplevels) - x_dnd_free_toplevels (); + x_dnd_free_toplevels (false); x_dnd_return_frame_object = NULL; x_dnd_movement_frame = NULL; commit 8f279c8666dc642ed1f8f49aa709530fcea47374 Author: Lars Ingebrigtsen Date: Thu Jun 2 19:14:00 2022 +0200 Make checkdoc-file-comments-engine match more ;;;### forms * lisp/emacs-lisp/checkdoc.el (checkdoc-file-comments-engine): Use the more general lisp-mode-autoload-regexp instead of generate-autoload-cookie (i.e., also match ;;;###tramp-autoload). diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 346c20c590..5700afbb03 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2464,11 +2464,9 @@ Code:, and others referenced in the style guide." pos) (goto-char (point-min)) ;; match ";;;###autoload" cookie to keep it with the form - (require 'autoload) (while (and cont (re-search-forward - (concat "^\\(" - (regexp-quote generate-autoload-cookie) - "\n\\)?" + (concat "^\\(" lisp-mode-autoload-regexp + "\n\\)?" "(") nil t)) (setq pos (match-beginning 0) commit da736c9f028f4d8fb117f116569fb72f706c9b45 Author: Lars Ingebrigtsen Date: Thu Jun 2 15:06:27 2022 +0200 Make `M-x grep' work better with "git grep" * lisp/progmodes/compile.el (compilation-start): Bind PAGER to "" to avoid errors in output from "git grep" and similar commands (bug#4359). diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 8b70e8400b..d28fce9dbd 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1956,6 +1956,9 @@ Returns the compilation buffer created." (and (derived-mode-p 'comint-mode) (comint-term-environment)) (list (format "INSIDE_EMACS=%s,compile" emacs-version)) + ;; Some external programs (like "git grep") use a pager; + ;; defeat that. + (list "PAGER=") (copy-sequence process-environment)))) (setq-local compilation-arguments (list command mode name-function highlight-regexp)) commit 52e527a02f40686f355d18ab2ba2d1d7c9fa0fbc Author: Mattias Engdegård Date: Thu Jun 2 11:46:18 2022 +0200 Make ?\LF generate 10, not -1 (bug#55738) The old -1 value was an artefact of the reader implementation. * src/lread.c (read_escape): Remove the `stringp` argument; assume character literal syntax. Never return -1. (read_string_literal): Handle string-specific escape semantics here and simplify. * test/src/lread-tests.el (lread-escaped-lf): New test. diff --git a/src/lread.c b/src/lread.c index 52fc0fff30..4b7d38a8e6 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2633,7 +2633,7 @@ enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 }; If the escape sequence forces unibyte, return eight-bit char. */ static int -read_escape (Lisp_Object readcharfun, bool stringp) +read_escape (Lisp_Object readcharfun) { int c = READCHAR; /* \u allows up to four hex digits, \U up to eight. Default to the @@ -2663,12 +2663,6 @@ read_escape (Lisp_Object readcharfun, bool stringp) return '\t'; case 'v': return '\v'; - case '\n': - return -1; - case ' ': - if (stringp) - return -1; - return ' '; case 'M': c = READCHAR; @@ -2676,7 +2670,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | meta_modifier; case 'S': @@ -2685,7 +2679,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | shift_modifier; case 'H': @@ -2694,7 +2688,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | hyper_modifier; case 'A': @@ -2703,19 +2697,19 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | alt_modifier; case 's': c = READCHAR; - if (stringp || c != '-') + if (c != '-') { UNREAD (c); return ' '; } c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); return c | super_modifier; case 'C': @@ -2726,7 +2720,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) case '^': c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun); if ((c & ~CHAR_MODIFIER_MASK) == '?') return 0177 | (c & CHAR_MODIFIER_MASK); else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) @@ -3011,7 +3005,7 @@ read_char_literal (Lisp_Object readcharfun) } if (ch == '\\') - ch = read_escape (readcharfun, 0); + ch = read_escape (readcharfun); int modifiers = ch & CHAR_MODIFIER_MASK; ch &= ~CHAR_MODIFIER_MASK; @@ -3065,14 +3059,24 @@ read_string_literal (char stackbuf[VLA_ELEMS (stackbufsize)], if (ch == '\\') { - ch = read_escape (readcharfun, 1); - - /* CH is -1 if \ newline or \ space has just been seen. */ - if (ch == -1) + /* First apply string-specific escape rules: */ + ch = READCHAR; + switch (ch) { + case 's': + /* `\s' is always a space in strings. */ + ch = ' '; + break; + case ' ': + case '\n': + /* `\SPC' and `\LF' generate no characters at all. */ if (p == read_buffer) cancel = true; continue; + default: + UNREAD (ch); + ch = read_escape (readcharfun); + break; } int modifiers = ch & CHAR_MODIFIER_MASK; @@ -3084,19 +3088,13 @@ read_string_literal (char stackbuf[VLA_ELEMS (stackbufsize)], force_multibyte = true; else /* I.e. ASCII_CHAR_P (ch). */ { - /* Allow `\C- ' and `\C-?'. */ - if (modifiers == CHAR_CTL) + /* Allow `\C-SPC' and `\^SPC'. This is done here because + the literals ?\C-SPC and ?\^SPC (rather inconsistently) + yield (' ' | CHAR_CTL); see bug#55738. */ + if (modifiers == CHAR_CTL && ch == ' ') { - if (ch == ' ') - { - ch = 0; - modifiers = 0; - } - else if (ch == '?') - { - ch = 127; - modifiers = 0; - } + ch = 0; + modifiers = 0; } if (modifiers & CHAR_SHIFT) { diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 47351c1d11..99eec9d548 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -317,4 +317,9 @@ literals (Bug#20852)." (should (equal (read-from-string "#_") '(## . 2)))) +(ert-deftest lread-escaped-lf () + ;; ?\LF should produce LF (only inside string literals do we ignore \LF). + (should (equal (read-from-string "?\\\n") '(?\n . 3))) + (should (equal (read-from-string "\"a\\\nb\"") '("ab" . 6)))) + ;;; lread-tests.el ends here commit 4bacd2a64575ccd55fd9ef8b4648f440243d597a Author: Mattias Engdegård Date: Thu Jun 2 15:42:40 2022 +0200 * src/lread.c (skip_lazy_string): Fix uninitialised variable. diff --git a/src/lread.c b/src/lread.c index 158ac36042..52fc0fff30 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3480,7 +3480,7 @@ skip_lazy_string (Lisp_Object readcharfun) /* Copy that many bytes into saved_doc_string. */ ptrdiff_t i = 0; - int c; + int c = 0; for (int n = min (nskip, infile->lookahead); n > 0; n--) saved_doc_string[i++] = c = infile->buf[--infile->lookahead]; block_input (); commit ba7c564bfe0eec84c845d3c7eef7785187433f90 Author: Stefan Kangas Date: Thu Jun 2 14:55:35 2022 +0200 * lisp/play/morse.el: Doc fixes. diff --git a/lisp/play/morse.el b/lisp/play/morse.el index 974e9fbc49..5b7d343a79 100644 --- a/lisp/play/morse.el +++ b/lisp/play/morse.el @@ -1,6 +1,6 @@ ;;; morse.el --- convert text to morse code and back -*- lexical-binding: t -*- -;; Copyright (C) 1995, 2001-2022 Free Software Foundation, Inc. +;; Copyright (C) 1995-2022 Free Software Foundation, Inc. ;; Author: Rick Farnbach ;; Keywords: games @@ -22,11 +22,11 @@ ;;; Commentary: -;; Converts text to Morse code and back with M-x morse-region and -;; M-x unmorse-region (though Morse code is no longer official :-(). +;; Convert plain text to Morse code and back with `M-x morse-region' and +;; `M-x unmorse-region'. -;; Converts text to NATO phonetic alphabet and back with M-x -;; nato-region and M-x denato-region. +;; Convert plain text to NATO spelling alphabet and back with +;; `M-x nato-region' and `M-x denato-region'. ;;; Code: @@ -142,14 +142,16 @@ ("(" . "Open") (")" . "Close") ("@" . "At")) - "NATO phonetic alphabet. + "NATO spelling alphabet. See “International Code of Signals” (INTERCO), United States Edition, 1969 Edition (Revised 2003) available from National -Geospatial-Intelligence Agency at URL `https://www.nga.mil/'") +Geospatial-Intelligence Agency at . +See also .") ;;;###autoload (defun morse-region (beg end) - "Convert all text in a given region to morse code." + "Convert plain text in region to Morse code. +See ." (interactive "*r") (if (integerp end) (setq end (copy-marker end))) @@ -172,7 +174,7 @@ Geospatial-Intelligence Agency at URL `https://www.nga.mil/'") ;;;###autoload (defun unmorse-region (beg end) - "Convert morse coded text in region to ordinary ASCII text." + "Convert Morse coded text in region to plain text." (interactive "*r") (if (integerp end) (setq end (copy-marker end))) @@ -194,7 +196,7 @@ Geospatial-Intelligence Agency at URL `https://www.nga.mil/'") ;;;###autoload (defun nato-region (beg end) - "Convert all text in a given region to NATO phonetic alphabet." + "Convert plain text in region to NATO spelling alphabet." ;; Copied from morse-region. -- ashawley 2009-02-10 (interactive "*r") (if (integerp end) @@ -218,7 +220,7 @@ Geospatial-Intelligence Agency at URL `https://www.nga.mil/'") ;;;###autoload (defun denato-region (beg end) - "Convert NATO phonetic alphabet in region to ordinary ASCII text." + "Convert NATO spelling alphabet text in region to plain text." ;; Copied from unmorse-region. -- ashawley 2009-02-10 (interactive "*r") (if (integerp end) commit ed02be04ae847c69247435084a7237ba03e7e505 Author: Po Lu Date: Thu Jun 2 19:54:09 2022 +0800 More gracefully handle errors during Motif drag window creation * src/xterm.c (xm_drag_window_error_handler): Store whether or not an error happened. (xm_get_drag_window): Handle errors during XCreateWindow and XChangeProperty without leaking anything. (x_error_handler): Fix coding style. diff --git a/src/xterm.c b/src/xterm.c index d0aa8874b6..f8b1f0db74 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1231,6 +1231,10 @@ static bool x_dnd_use_toplevels; /* Motif drag-and-drop protocol support. */ +/* Pointer to a variable which stores whether or not an X error + occured while trying to create the Motif drag window. */ +static volatile bool *xm_drag_window_error; + typedef enum xm_byte_order { XM_BYTE_ORDER_LSB_FIRST = 'l', @@ -1629,6 +1633,9 @@ xm_write_drag_initiator_info (Display *dpy, Window wdesc, static int xm_drag_window_error_handler (Display *display, XErrorEvent *event) { + if (xm_drag_window_error) + *xm_drag_window_error = true; + return 0; } @@ -1651,6 +1658,9 @@ xm_get_drag_window (struct x_display_info *dpyinfo) XSetWindowAttributes attrs; Display *temp_display; void *old_handler, *old_io_handler; + /* These are volatile because GCC mistakenly warns about them being + clobbered by longjmp. */ + volatile bool error, created; drag_window = None; rc = XGetWindowProperty (dpyinfo->display, dpyinfo->root_window, @@ -1706,6 +1716,9 @@ xm_get_drag_window (struct x_display_info *dpyinfo) return None; } + error = false; + xm_drag_window_error = &error; + XGrabServer (temp_display); XSetCloseDownMode (temp_display, RetainPermanent); @@ -1716,6 +1729,9 @@ xm_get_drag_window (struct x_display_info *dpyinfo) _MOTIF_DRAG_WINDOW = XInternAtom (temp_display, "_MOTIF_DRAG_WINDOW", False); + if (error) + goto give_up; + /* Some other program might've created a drag window between now and when we first looked. Use that if it exists. */ @@ -1733,8 +1749,12 @@ xm_get_drag_window (struct x_display_info *dpyinfo) if (tmp_data) XFree (tmp_data); + error = false; + if (drag_window == None) { + created = true; + attrs.override_redirect = True; drag_window = XCreateWindow (temp_display, DefaultRootWindow (temp_display), -1, -1, 1, 1, 0, CopyFromParent, InputOnly, @@ -1743,6 +1763,34 @@ xm_get_drag_window (struct x_display_info *dpyinfo) _MOTIF_DRAG_WINDOW, XA_WINDOW, 32, PropModeReplace, (unsigned char *) &drag_window, 1); } + else + created = false; + + /* Handle all errors now. */ + XSync (temp_display, False); + + give_up: + + /* Some part of the drag window creation process failed, so + punt. */ + if (error) + { + /* If the drag window was actually created, delete it now. + Probably, a BadAlloc happened during the XChangeProperty + request. */ + if (created) + { + if (drag_window != None) + XDestroyWindow (temp_display, drag_window); + + XDeleteProperty (temp_display, DefaultRootWindow (temp_display), + _MOTIF_DRAG_WINDOW); + } + + drag_window = None; + } + + xm_drag_window_error = NULL; /* FIXME: why does XCloseDisplay hang if SIGIO arrives and there are multiple displays? */ @@ -21854,11 +21902,10 @@ x_error_handler (Display *display, XErrorEvent *event) #endif #if defined USE_GTK && defined HAVE_GTK3 - if ((event->error_code == BadMatch || event->error_code == BadWindow) + if ((event->error_code == BadMatch + || event->error_code == BadWindow) && event->request_code == X_SetInputFocus) - { - return 0; - } + return 0; #endif /* If we try to ungrab or grab a device that doesn't exist anymore commit 43b0210f83c38fb91cfcfc5a2d4a8c3131331476 Author: Lars Ingebrigtsen Date: Thu Jun 2 13:52:58 2022 +0200 Fix out-of-tree build problems with loaddefs.el * lisp/Makefile.in ($(lisp)/loaddefs.el): Use the new function. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Pass in whether to inhibit a partial build (to make the code more general). (loaddefs-generate--emacs-batch): Add a new function specially for the Emacs build that has the special rules needed. (This also fixes out-of-tree builds.) loaddefs-generate-batch can be used in general for packages etc. (loaddefs-generate-batch): Remove the special code for Emacs builds. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 040b9a4ca3..8728467977 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -198,13 +198,13 @@ org-manuals: main-first # We make $(lisp)/loaddefs.el a dependency of .PHONY to cause Make to # ignore its time stamp. That's because the real dependencies of # loaddefs.el aren't known to Make, they are implemented in -# loaddefs-generate-batch. +# loaddefs-generate--emacs-batch. autoloads .PHONY: $(lisp)/loaddefs.el $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) $(lisp)/emacs-lisp/loaddefs-gen.elc $(AM_V_GEN)$(emacs) \ -l $(lisp)/emacs-lisp/loaddefs-gen.elc \ - -f loaddefs-generate-batch $(lisp)/loaddefs.el ${SUBDIRS_ALMOST} + -f loaddefs-generate--emacs-batch ${SUBDIRS_ALMOST} # autoloads only runs when loaddefs.el is nonexistent, although it # generates a number of different files. Provide a force option to enable diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 46aec173e8..2e345d6669 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -480,7 +480,8 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." ;;;###autoload (defun loaddefs-generate (dir output-file &optional excluded-files - extra-data include-package-version) + extra-data include-package-version + generate-full) "Generate loaddefs files for Lisp files in the directories DIRS. DIR can be either a single directory or a list of directories. @@ -493,7 +494,9 @@ directory or directories specified. If EXTRA-DATA, include this string at the start of the generated file. -If INCLUDE-PACKAGE-VERSION, include package version data." +If INCLUDE-PACKAGE-VERSION, include package version data. + +If GENERATE-FULL, don't update, but regenerate all the loaddefs files." (let* ((files-re (let ((tmp nil)) (dolist (suf (get-load-suffixes)) ;; We don't use module-file-suffix below because @@ -508,13 +511,7 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (directory-files (expand-file-name d) t files-re)) (if (consp dir) dir (list dir))))) - (updating (and (file-exists-p output-file) - ;; Always do a complete update if loaddefs-gen.el - ;; has been updated and we're doing a base build. - include-package-version - (file-newer-than-file-p - output-file - (expand-file-name "emacs-lisp/loaddefs-gen.el")))) + (updating (and (file-exists-p output-file) (not generate-full))) (defs nil)) ;; Collect all the autoload data. @@ -647,16 +644,26 @@ This scans for ;;;###autoload forms and related things. The first element on the command line should be the (main) loaddefs.el output file, and the rest are the directories to use." - (let* ((args command-line-args-left) - (output-file (expand-file-name (car args) lisp-directory))) + (let ((args command-line-args-left)) + (setq command-line-args-left nil) + (loaddefs-generate (cdr args) (expand-file-name (car args))))) + +(defun loaddefs-generate--emacs-batch () + "Generate the loaddefs for the Emacs build. +This is like `loaddefs-generate-batch', but has some specific +rules for built-in packages and excluded files." + (let ((args command-line-args-left) + (output-file (expand-file-name "loaddefs.el" lisp-directory))) (setq command-line-args-left nil) (loaddefs-generate - (cdr args) output-file + args output-file (loaddefs-generate--excluded-files) - nil - ;; When generating the top-level Emacs loaddefs file, we want to - ;; include the `package--builtin-versions' things. - (equal (file-name-directory output-file) lisp-directory)))) + nil t + ;; Always do a complete update if loaddefs-gen.el has been + ;; updated. + (file-newer-than-file-p + (expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory) + output-file)))) (provide 'loaddefs-gen) commit c7b7c9d40f9b8f73792cf434ee3b2fdfe62af3cc Author: Lars Ingebrigtsen Date: Thu Jun 2 11:51:09 2022 +0200 Reinstate the Qload file name handler * src/lread.c (Fload): Reinstate the Qload file name handler (bug#12598). This makes loading non-ASCII elc.gz files work. diff --git a/src/lread.c b/src/lread.c index a1045184d9..158ac36042 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1244,10 +1244,9 @@ Return t if the file exists and loads successfully. */) CHECK_STRING (file); /* If file name is magic, call the handler. */ - /* This shouldn't be necessary any more now that `openp' handles it right. - handler = Ffind_file_name_handler (file, Qload); - if (!NILP (handler)) - return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */ + handler = Ffind_file_name_handler (file, Qload); + if (!NILP (handler)) + return call5 (handler, Qload, file, noerror, nomessage, nosuffix); /* The presence of this call is the result of a historical accident: it used to be in every file-operation and when it got removed diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index c7ce03cc9b..54ada08800 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -939,7 +939,7 @@ unquoted file names." (files-tests--with-temp-non-special (tmpfile nospecial) (should (load nospecial nil t))) (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) - (should (load nospecial nil t)))) + (should-error (load nospecial nil t)))) (ert-deftest files-tests-file-name-non-special-make-auto-save-file-name () (files-tests--with-temp-non-special (tmpfile nospecial) @@ -1838,7 +1838,6 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil." (should (eq major-mode 'text-mode))) (ert-deftest files-load-elc-gz-file () - :expected-result :failed (skip-unless (executable-find "gzip")) (ert-with-temp-directory dir (let* ((pref (expand-file-name "compile-utf8" dir)) commit a947c10d9093b9f3a29b60a52bda8afa43b6fd29 Author: Frédéric Giquel Date: Thu Jun 2 11:38:56 2022 +0200 Use `read-process-output-max' when creating pipes on GNU/Linux * src/process.c (syms_of_process): Note max size. (create_process): Set the pipe size from `read-process-output-max' (bug#55737). Copyright-paperwork-exempt: yes diff --git a/src/process.c b/src/process.c index fe3e12343f..ccfc0bdf54 100644 --- a/src/process.c +++ b/src/process.c @@ -2145,6 +2145,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) inchannel = p->open_fd[READ_FROM_SUBPROCESS]; forkout = p->open_fd[SUBPROCESS_STDOUT]; +#if defined(GNU_LINUX) && defined(F_SETPIPE_SZ) + fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max); +#endif + if (!NILP (p->stderrproc)) { struct Lisp_Process *pp = XPROCESS (p->stderrproc); @@ -8631,7 +8635,10 @@ returns non-nil. */); DEFVAR_INT ("read-process-output-max", read_process_output_max, doc: /* Maximum number of bytes to read from subprocess in a single chunk. Enlarge the value only if the subprocess generates very large (megabytes) -amounts of data in one go. */); +amounts of data in one go. + +On GNU/Linux systems, the value should not exceed +/proc/sys/fs/pipe-max-size. See pipe(7) manpage for details. */); read_process_output_max = 4096; DEFVAR_INT ("process-error-pause-time", process_error_pause_time, commit 8b431382e5102e5a3a61c567ca78b4eb927b98bb Author: yilkalargaw Date: Thu Jun 2 11:30:23 2022 +0200 Fix usage of absolute :height in manoj-dark-theme * etc/themes/manoj-dark-theme.el (manoj-dark): Avoid using absolute heights (bug#55759). diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index b70620fe21..c7d2d3fee5 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -400,7 +400,7 @@ jarring angry fruit salad look to reduce eye fatigue.") '(compilation-warning-face ((t (:bold t :foreground "Orange" :weight bold)))) '(completions-common-part ((t (:width normal :weight normal :slant normal :foreground "WhiteSmoke" - :background "black" :height 81)))) + :background "black" :height 0.9)))) '(completions-first-difference ((t (:bold t :weight bold)))) '(css-selector ((t (:foreground "LightSteelBlue")))) commit afc0bfd38076d8184c506d3f3c2e9f4313103c1b Author: Lars Ingebrigtsen Date: Thu Jun 2 11:13:08 2022 +0200 Speed up loaddefs-generate on slow disks * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Make file update comparisons faster. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index e5a5c21d23..46aec173e8 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -522,11 +522,15 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (byte-compile-info (concat "Scraping files for loaddefs")) 0 (length files) nil 10)) + (output-time + (file-attribute-modification-time (file-attributes output-file))) (file-count 0)) (dolist (file files) (progress-reporter-update progress (setq file-count (1+ file-count))) (when (or (not updating) - (file-newer-than-file-p file output-file)) + (time-less-p output-time + (file-attribute-modification-time + (file-attributes file)))) (setq defs (nconc (loaddefs-generate--parse-file file output-file commit 760fd43082975ba9400d846b87e2016f43e98c85 Author: Po Lu Date: Thu Jun 2 16:36:03 2022 +0800 Fix rare crash when async input happens while creating xm drag window * src/xterm.c (xm_get_drag_window): Work around XCloseDisplay freezing upon being interrupted by a signal. diff --git a/src/xterm.c b/src/xterm.c index f280fea4cb..d0aa8874b6 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1744,7 +1744,12 @@ xm_get_drag_window (struct x_display_info *dpyinfo) (unsigned char *) &drag_window, 1); } + /* FIXME: why does XCloseDisplay hang if SIGIO arrives and there + are multiple displays? */ + unrequest_sigio (); XCloseDisplay (temp_display); + request_sigio (); + XSetErrorHandler (old_handler); XSetIOErrorHandler (old_io_handler); commit da274d73f9e12d461eee1a750694df9d81ad94fe Merge: 835ce688e2 76ffd4427d Author: Eli Zaretskii Date: Thu Jun 2 10:52:19 2022 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 835ce688e24ae599b8834fa5160e4b1559d0c172 Author: Eli Zaretskii Date: Thu Jun 2 10:51:37 2022 +0300 ; * src/emacs.c (main): Move -version output after initialization. diff --git a/src/emacs.c b/src/emacs.c index e4257a66b4..43b9901e08 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1415,77 +1415,19 @@ main (int argc, char **argv) should be explicitly recognized, ignored, and removed from 'command-line-args-left' in 'command-line-1'. */ + bool only_version = false; sort_args (argc, argv); argc = 0; while (argv[argc]) argc++; skip_args = 0; if (argmatch (argv, argc, "-version", "--version", 3, NULL, &skip_args)) - { - Lisp_Object rversion, rbranch, rtime; - const char *version, *copyright; - - if (initialized) - { - Lisp_Object tem, tem2; - - /* Fformat_time_string below manipulates bignums, so we need - this initialization. */ - init_bignum (); - - tem = Fsymbol_value (intern_c_string ("emacs-version")); - tem2 = Fsymbol_value (intern_c_string ("emacs-copyright")); - if (!STRINGP (tem)) - { - fputs ("Invalid value of 'emacs-version'\n", stderr); - exit (1); - } - if (!STRINGP (tem2)) - { - fputs ("Invalid value of 'emacs-copyright'\n", stderr); - exit (1); - } - else - { - version = SSDATA (tem); - copyright = SSDATA (tem2); - } - } - else - { - version = emacs_version; - copyright = emacs_copyright; - } - printf ("%s %s\n", PACKAGE_NAME, version); - - rversion - = Fsymbol_value (intern_c_string ("emacs-repository-version")); - rbranch - = Fsymbol_value (intern_c_string ("emacs-repository-branch")); - rtime - = Fsymbol_value (intern_c_string ("emacs-build-time")); - - if (!NILP (rversion) && !NILP (rbranch) && !NILP (rtime)) - printf ("Development version %s on %s branch; build date %s.\n", - SSDATA (Fsubstring (rversion, make_fixnum (0), - make_fixnum (12))), - SSDATA (rbranch), - SSDATA (Fformat_time_string (build_string ("%Y-%m-%d"), - rtime, Qnil))); - - printf (("%s\n" - "%s comes with ABSOLUTELY NO WARRANTY.\n" - "You may redistribute copies of %s\n" - "under the terms of the GNU General Public License.\n" - "For more information about these matters, " - "see the file named COPYING.\n"), - copyright, PACKAGE_NAME, PACKAGE_NAME); - exit (0); - } + only_version = true; #ifdef HAVE_PDUMPER if (argmatch (argv, argc, "-fingerprint", "--fingerprint", 4, - NULL, &skip_args)) + NULL, &skip_args) + && !only_version) { if (initialized) { @@ -1510,7 +1452,8 @@ main (int argc, char **argv) pdumper_record_wd (emacs_wd); #endif - if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args)) + if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args) + && !only_version) { #ifdef WINDOWSNT /* argv[] array is kept in its original ANSI codepage encoding, @@ -1636,7 +1579,7 @@ main (int argc, char **argv) inhibit_window_system = 0; /* Handle the -t switch, which specifies filename to use as terminal. */ - while (1) + while (!only_version) { char *term; if (argmatch (argv, argc, "-t", "--terminal", 4, &term, &skip_args)) @@ -1674,7 +1617,8 @@ main (int argc, char **argv) /* Handle the -batch switch, which means don't do interactive display. */ noninteractive = 0; - if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args)) + if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args) + || only_version) { noninteractive = 1; Vundo_outer_limit = Qnil; @@ -1691,7 +1635,8 @@ main (int argc, char **argv) } /* Handle the --help option, which gives a usage message. */ - if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args)) + if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args) + && !only_version) { int i; printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]); @@ -1712,20 +1657,27 @@ main (int argc, char **argv) int sockfd = -1; - if (argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, NULL, &skip_args) - || argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, &dname_arg, &skip_args)) + if (!only_version) { - daemon_type = 1; /* foreground */ - } - else if (argmatch (argv, argc, "-daemon", "--daemon", 5, NULL, &skip_args) - || argmatch (argv, argc, "-daemon", "--daemon", 5, &dname_arg, &skip_args) - || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, NULL, &skip_args) - || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, &dname_arg, &skip_args)) - { - daemon_type = 2; /* background */ + if (argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, NULL, + &skip_args) + || argmatch (argv, argc, "-fg-daemon", "--fg-daemon", 10, &dname_arg, + &skip_args)) + { + daemon_type = 1; /* foreground */ + } + else if (argmatch (argv, argc, "-daemon", "--daemon", 5, NULL, &skip_args) + || argmatch (argv, argc, "-daemon", "--daemon", 5, &dname_arg, + &skip_args) + || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, NULL, + &skip_args) + || argmatch (argv, argc, "-bg-daemon", "--bg-daemon", 10, + &dname_arg, &skip_args)) + { + daemon_type = 2; /* background */ + } } - if (daemon_type > 0) { #ifndef DOS_NT @@ -2001,7 +1953,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem bool module_assertions = argmatch (argv, argc, "-module-assertions", "--module-assertions", 15, NULL, &skip_args); - if (will_dump_p () && module_assertions) + if (will_dump_p () && module_assertions && !only_version) { fputs ("Module assertions are not supported during dumping\n", stderr); exit (1); @@ -2049,7 +2001,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem int count_before = skip_args; /* Skip any number of -d options, but only use the last one. */ - while (1) + while (!only_version) { int count_before_this = skip_args; @@ -2191,6 +2143,72 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_callproc (); /* Must follow init_cmdargs but not init_sys_modes. */ init_fileio (); init_lread (); + + /* If "-version" was specified, produce version information and + exit. We do it here because the code below needs to call Lisp + primitives, which cannot be done safely before we call all the + init_FOO initialization functions above. */ + if (only_version) + { + const char *version, *copyright; + + if (initialized) + { + Lisp_Object tem = Fsymbol_value (intern_c_string ("emacs-version")); + Lisp_Object tem2 = Fsymbol_value (intern_c_string ("emacs-copyright")); + if (!STRINGP (tem)) + { + fputs ("Invalid value of 'emacs-version'\n", stderr); + exit (1); + } + if (!STRINGP (tem2)) + { + fputs ("Invalid value of 'emacs-copyright'\n", stderr); + exit (1); + } + else + { + version = SSDATA (tem); + copyright = SSDATA (tem2); + } + } + else + { + version = emacs_version; + copyright = emacs_copyright; + } + printf ("%s %s\n", PACKAGE_NAME, version); + + if (initialized) + { + Lisp_Object rversion, rbranch, rtime; + + rversion + = Fsymbol_value (intern_c_string ("emacs-repository-version")); + rbranch + = Fsymbol_value (intern_c_string ("emacs-repository-branch")); + rtime + = Fsymbol_value (intern_c_string ("emacs-build-time")); + + if (!NILP (rversion) && !NILP (rbranch) && !NILP (rtime)) + printf ("Development version %s on %s branch; build date %s.\n", + SSDATA (Fsubstring (rversion, make_fixnum (0), + make_fixnum (12))), + SSDATA (rbranch), + SSDATA (Fformat_time_string (build_string ("%Y-%m-%d"), + rtime, Qnil))); + } + + printf (("%s\n" + "%s comes with ABSOLUTELY NO WARRANTY.\n" + "You may redistribute copies of %s\n" + "under the terms of the GNU General Public License.\n" + "For more information about these matters, " + "see the file named COPYING.\n"), + copyright, PACKAGE_NAME, PACKAGE_NAME); + exit (0); + } + #ifdef WINDOWSNT /* Check to see if Emacs has been installed correctly. */ check_windows_init_file (); commit 76ffd4427d5ea037b0945ea0dae5d844add91f44 Author: Po Lu Date: Thu Jun 2 15:49:50 2022 +0800 Fix macOS build * src/nsterm.m (ns_mouse_position): Fix typos. diff --git a/src/nsterm.m b/src/nsterm.m index b7b7bc2ad3..ecaca5b87f 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2337,8 +2337,8 @@ Hide the window (X11 semantics) belowWindowWithWindowNumber: window_number]; w = [NSApp windowWithWindowNumber: window_number]; - if (EQ (EQ (track_mouse, Qdrag_source) - || EQ (track_mouse, Qdropping)) + if ((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) && w && [[w delegate] isKindOfClass: [EmacsTooltip class]]) continue; commit f71fad50fc4d10caaf156c37610f78f5edf3a255 Author: Po Lu Date: Thu Jun 2 15:48:12 2022 +0800 Fix potential NULL pointer dereference on NS * src/nsterm.m (ns_mouse_position): Don't test f's tooltip-ness if it's NULL. diff --git a/src/nsterm.m b/src/nsterm.m index 9a23efe3ac..b7b7bc2ad3 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2365,7 +2365,7 @@ Hide the window (X11 semantics) if (!FRAME_NS_P (f)) f = NULL; - if (FRAME_TOOLTIP_P (f)) + if (f && FRAME_TOOLTIP_P (f)) f = dpyinfo->last_mouse_frame; /* While dropping, use the last mouse frame only if there is no commit caf8a83730c82155b55b63de18e019c276dee2de Author: Po Lu Date: Thu Jun 2 15:46:42 2022 +0800 Fix flickering tooltips with mouse DND without interprogram drag * src/haikuterm.c (haiku_read_socket): * src/nsterm.m (ns_mouse_position): * src/xterm.c (XTmouse_position, handle_one_xevent): Apply special tooltip treatment to `dropping' as well as `drag-source'. diff --git a/src/haikuterm.c b/src/haikuterm.c index d3a02ff6e5..0a994b7e60 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3290,7 +3290,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) leave notification events for this. */ if (any_help_event_p - && !(EQ (track_mouse, Qdrag_source) + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) && gui_mouse_grabbed (x_display_list))) do_help = -1; break; @@ -3339,7 +3340,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) haiku_new_focus_frame (x_display_list->focused_frame); if (any_help_event_p - && !(EQ (track_mouse, Qdrag_source) + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) && gui_mouse_grabbed (x_display_list))) do_help = -1; } diff --git a/src/nsterm.m b/src/nsterm.m index a663aa7379..9a23efe3ac 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2337,7 +2337,8 @@ Hide the window (X11 semantics) belowWindowWithWindowNumber: window_number]; w = [NSApp windowWithWindowNumber: window_number]; - if (EQ (track_mouse, Qdrag_source) + if (EQ (EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) && w && [[w delegate] isKindOfClass: [EmacsTooltip class]]) continue; @@ -2346,7 +2347,8 @@ Hide the window (X11 semantics) else if (EQ (track_mouse, Qdrag_source)) break; - if (f && EQ (track_mouse, Qdrag_source) + if (f && (EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) && FRAME_TOOLTIP_P (f)) continue; } diff --git a/src/xterm.c b/src/xterm.c index cd6b6af58f..f280fea4cb 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11715,7 +11715,9 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, /* If CHILD is a tooltip frame, look below it if track-mouse is drag-source. */ - if (child != None) + if (child != None + && (EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping))) { maybe_tooltip = x_any_window_to_frame (dpyinfo, child); @@ -16822,7 +16824,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* But never if `mouse-drag-and-drop-region' is in progress, since that results in the tooltip being dismissed when the mouse moves on top. */ - && !(EQ (track_mouse, Qdrag_source) + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) && gui_mouse_grabbed (dpyinfo))) do_help = -1; } @@ -18163,7 +18166,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, in progress, since that results in the tooltip being dismissed when the mouse moves on top. */ - && !(EQ (track_mouse, Qdrag_source) + && !((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) && gui_mouse_grabbed (dpyinfo))) do_help = -1; } commit 77854b1af64a0778ab2311eebe90c643b2b6fb7b Author: Po Lu Date: Thu Jun 2 15:21:35 2022 +0800 Fix tooltip frames leaking into mouse position on NS * src/nsterm.m (ns_mouse_position): Avoid tooltip frames and look underneath them when `drag-source'. ([EmacsView mouseDown:]): ([EmacsView mouseMoved:]): Ignore events from tip frames. diff --git a/src/nsterm.m b/src/nsterm.m index 46ce2cc5e4..a663aa7379 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2337,10 +2337,18 @@ Hide the window (X11 semantics) belowWindowWithWindowNumber: window_number]; w = [NSApp windowWithWindowNumber: window_number]; + if (EQ (track_mouse, Qdrag_source) + && w && [[w delegate] isKindOfClass: [EmacsTooltip class]]) + continue; + if (w && [[w delegate] isKindOfClass: [EmacsView class]]) f = ((EmacsView *) [w delegate])->emacsframe; else if (EQ (track_mouse, Qdrag_source)) break; + + if (f && EQ (track_mouse, Qdrag_source) + && FRAME_TOOLTIP_P (f)) + continue; } while (window_number > 0 && !f); #endif @@ -2355,6 +2363,9 @@ Hide the window (X11 semantics) if (!FRAME_NS_P (f)) f = NULL; + if (FRAME_TOOLTIP_P (f)) + f = dpyinfo->last_mouse_frame; + /* While dropping, use the last mouse frame only if there is no currently focused frame. */ if (!f && (EQ (track_mouse, Qdropping) @@ -7095,6 +7106,9 @@ - (void)mouseDown: (NSEvent *)theEvent if (!emacs_event) return; + if (FRAME_TOOLTIP_P (emacsframe)) + return; + dpyinfo->last_mouse_frame = emacsframe; /* Appears to be needed to prevent spurious movement events generated on button clicks. */ @@ -7295,7 +7309,8 @@ - (void)mouseDown: (NSEvent *)theEvent tab_bar_p = EQ (window, emacsframe->tab_bar_window); if (tab_bar_p) - tab_bar_arg = handle_tab_bar_click (emacsframe, x, y, EV_UDMODIFIERS (theEvent) & down_modifier, + tab_bar_arg = handle_tab_bar_click (emacsframe, x, y, + EV_UDMODIFIERS (theEvent) & down_modifier, EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent)); } @@ -7370,6 +7385,9 @@ - (void)mouseMoved: (NSEvent *)e NSPoint pt; BOOL dragging; + if (FRAME_TOOLTIP_P (emacsframe)) + return; + NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsView mouseMoved:]"); dpyinfo->last_mouse_movement_time = EV_TIMESTAMP (e);