commit 00a5bc9314cf18c8b6e3801765c832fca5f9f3f1 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Thu Jun 2 07:05:21 2022 +0000 Handle dropping text/uri-list on Haiku * lisp/term/haiku-win.el (window-system-initialization): Remove extra whitespace. (haiku-drag-and-drop): Handle "text/uri-list". diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 2a31dd38c8..2fa27ed08a 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -185,7 +185,6 @@ The resources should be a list of strings in COMMAND-LINE-RESOURCES." "Set up the window system. WINDOW-SYSTEM must be HAIKU. DISPLAY may be set to the name of a display that will be initialized." (cl-assert (not haiku-initialized)) - (create-default-fontset) (when x-command-line-resources (haiku--handle-x-command-line-resources @@ -307,6 +306,11 @@ or a pair of markers) and turns it into a file system reference." (dolist (filename (cddr (assoc "refs" string))) (dnd-handle-one-url window 'private (concat "file:" filename))))) + ((assoc "text/uri-list" string) + (dolist (text (cddr (assoc "text/uri-list" string))) + (let ((uri-list (split-string text "[\0\r\n]" t))) + (dolist (bf uri-list) + (dnd-handle-one-url window 'private bf))))) ((assoc "text/plain" string) (with-selected-window window (raise-frame) commit 2244dc5ce9f78ecab7232323e8dfeb9e79835b2b Author: Po Lu Date: Thu Jun 2 14:27:38 2022 +0800 Fix help-echo tooltips interfering with mouse drag-and-drop * lisp/mouse.el (mouse-drag-and-drop-region): Disable tooltip-mode while mouse drag-and-drop is in progress. Also restore state correctly in some more cases. diff --git a/lisp/mouse.el b/lisp/mouse.el index 4b5f6ed223..5834d4a666 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -3067,7 +3067,10 @@ is copied instead of being cut." (cdr bounds))) (region-bounds))) (region-noncontiguous (region-noncontiguous-p)) + ;; Otherwise, the mouse periodically moves on top of the + ;; tooltip. (mouse-fine-grained-tracking t) + (was-tooltip-mode tooltip-mode) ;; Whether or not some text was ``cut'' from Emacs to another ;; program and the cleaanup code should not try modifying the ;; region. @@ -3086,372 +3089,382 @@ is copied instead of being cut." window-exempt drag-again-mouse-position) - ;; STATES stores for each window on this frame its start and point - ;; positions so we can restore them on all windows but for the one - ;; where the drop occurs. For inter-frame drags we'll have to do - ;; this for all windows on all visible frames. In addition we save - ;; also the cursor type for the window's buffer so we can restore it - ;; in case we modified it. - ;; https://lists.gnu.org/r/emacs-devel/2017-12/msg00090.html - (walk-window-tree - (lambda (window) - (setq states - (cons - (list - window - (copy-marker (window-start window)) - (copy-marker (window-point window)) - (with-current-buffer (window-buffer window) - cursor-type)) - states)))) - - (ignore-errors - (catch 'cross-program-drag - (track-mouse - (setq track-mouse (if mouse-drag-and-drop-region-cross-program - ;; When `track-mouse' is `drop', we - ;; get events with a posn-window of - ;; the grabbed frame even if some - ;; window is between that and the - ;; pointer. This makes dragging to a - ;; window on top of a frame - ;; impossible. With this value of - ;; `track-mouse', no frame is returned - ;; in that particular case. - 'drag-source - 'drop)) - ;; When event was "click" instead of "drag", skip loop. - (while (progn - (setq event (read-key)) ; read-event or read-key - (or (mouse-movement-p event) - ;; Handle `mouse-autoselect-window'. - (memq (car event) '(select-window switch-frame)))) - (catch 'drag-again - ;; If the mouse is in the drag scroll margin, scroll - ;; either up or down depending on which margin it is in. - (when mouse-drag-and-drop-region-scroll-margin - (let* ((row (cdr (posn-col-row (event-end event)))) - (window (when (windowp (posn-window (event-end event))) - (posn-window (event-end event)))) - (text-height (when window - (window-text-height window))) - ;; Make sure it's possible to scroll both up - ;; and down if the margin is too large for the - ;; window. - (margin (when text-height - (min (/ text-height 3) - mouse-drag-and-drop-region-scroll-margin)))) - (when (windowp window) - ;; At 2 lines, the window becomes too small for any - ;; meaningful scrolling. - (unless (<= text-height 2) - ;; We could end up at the beginning or end of the - ;; buffer. - (ignore-errors - (cond - ;; Inside the bottom scroll margin, scroll up. - ((> row (- text-height margin)) - (with-selected-window window - (scroll-up 1))) - ;; Inside the top scroll margin, scroll down. - ((< row margin) - (with-selected-window window - (scroll-down 1))))))))) - - ;; Obtain the dragged text in region. When the loop was - ;; skipped, value-selection remains nil. - (unless value-selection - (setq value-selection (funcall region-extract-function nil)) - (when mouse-drag-and-drop-region-show-tooltip - (let ((text-size mouse-drag-and-drop-region-show-tooltip)) - (setq text-tooltip - (if (and (integerp text-size) - (> (length value-selection) text-size)) - (concat - (substring value-selection 0 (/ text-size 2)) - "\n...\n" - (substring value-selection (- (/ text-size 2)) -1)) - value-selection)))) - - ;; Check if selected text is read-only. - (setq text-from-read-only - (or text-from-read-only - (catch 'loop - (dolist (bound (region-bounds)) - (when (text-property-not-all - (car bound) (cdr bound) 'read-only nil) - (throw 'loop t))))))) - - (when (and mouse-drag-and-drop-region-cross-program - (display-graphic-p) - (fboundp 'x-begin-drag) - (or (and (framep (posn-window (event-end event))) - (let ((location (posn-x-y (event-end event))) - (frame (posn-window (event-end event)))) - (or (< (car location) 0) - (< (cdr location) 0) - (> (car location) - (frame-pixel-width frame)) - (> (cdr location) - (frame-pixel-height frame))))) - (and (or (not drag-again-mouse-position) - (let ((mouse-position (mouse-absolute-pixel-position))) - (or (< 5 (abs (- (car drag-again-mouse-position) - (car mouse-position)))) - (< 5 (abs (- (cdr drag-again-mouse-position) - (cdr mouse-position))))))) - (not (posn-window (event-end event)))))) - (setq drag-again-mouse-position nil) - (mouse-drag-and-drop-region-hide-tooltip) - (gui-set-selection 'XdndSelection value-selection) - (let ((drag-action-or-frame - (condition-case nil - (x-begin-drag '("UTF8_STRING" "text/plain" - "text/plain;charset=utf-8" - "STRING" "TEXT" "COMPOUND_TEXT") - (if mouse-drag-and-drop-region-cut-when-buffers-differ - 'XdndActionMove - 'XdndActionCopy) - (posn-window (event-end event)) 'now - ;; On platforms where we know - ;; `return-frame' doesn't - ;; work, allow dropping on - ;; the drop frame. - (eq window-system 'haiku)) - (quit nil)))) - (when (framep drag-action-or-frame) - ;; With some window managers `x-begin-drag' - ;; returns a frame sooner than `mouse-position' - ;; will return one, due to over-wide frame windows - ;; being drawn by the window manager. To avoid - ;; that, we just require the mouse move a few - ;; pixels before beginning another cross-program - ;; drag. - (setq drag-again-mouse-position - (mouse-absolute-pixel-position)) - (throw 'drag-again nil)) - - (let ((min-char (point))) - (when (eq drag-action-or-frame 'XdndActionMove) - ;; Remove the dragged text from source buffer like - ;; operation `cut'. - (dolist (overlay mouse-drag-and-drop-overlays) - (when (< min-char (min (overlay-start overlay) - (overlay-end overlay))) - (setq min-char (min (overlay-start overlay) - (overlay-end overlay)))) - (delete-region (overlay-start overlay) - (overlay-end overlay))) - (goto-char min-char) - (setq deactivate-mark t) - (setq drag-was-cross-program t))) - - (when (eq drag-action-or-frame 'XdndActionCopy) - ;; Set back the dragged text as region on source buffer - ;; like operation `copy'. - (activate-mark))) - (throw 'cross-program-drag nil)) - - (setq window-to-paste (posn-window (event-end event))) - (setq point-to-paste (posn-point (event-end event))) - ;; Set nil when target buffer is minibuffer. - (setq buffer-to-paste (let (buf) - (when (windowp window-to-paste) - (setq buf (window-buffer window-to-paste)) - (when (not (minibufferp buf)) - buf)))) - (setq cursor-in-text-area (and window-to-paste - point-to-paste - buffer-to-paste)) - - (when cursor-in-text-area - ;; Check if point under mouse is read-only. - (save-window-excursion + (unwind-protect + (progn + ;; Without this moving onto text with a help-echo will + ;; interfere with the tooltip containing dragged text. + (tooltip-mode -1) + ;; STATES stores for each window on this frame its start and point + ;; positions so we can restore them on all windows but for the one + ;; where the drop occurs. For inter-frame drags we'll have to do + ;; this for all windows on all visible frames. In addition we save + ;; also the cursor type for the window's buffer so we can restore it + ;; in case we modified it. + ;; https://lists.gnu.org/r/emacs-devel/2017-12/msg00090.html + (walk-window-tree + (lambda (window) + (setq states + (cons + (list + window + (copy-marker (window-start window)) + (copy-marker (window-point window)) + (with-current-buffer (window-buffer window) + cursor-type)) + states)))) + + (ignore-errors + (catch 'cross-program-drag + (track-mouse + (setq track-mouse (if mouse-drag-and-drop-region-cross-program + ;; When `track-mouse' is `drop', we + ;; get events with a posn-window of + ;; the grabbed frame even if some + ;; window is between that and the + ;; pointer. This makes dragging to a + ;; window on top of a frame + ;; impossible. With this value of + ;; `track-mouse', no frame is returned + ;; in that particular case, which + ;; tells us to initiate interprogram + ;; drag-and-drop. + 'drag-source + 'drop)) + ;; When event was "click" instead of "drag", skip loop. + (while (progn + (setq event (read-key)) ; read-event or read-key + (or (mouse-movement-p event) + ;; Handle `mouse-autoselect-window'. + (memq (car event) '(select-window switch-frame)))) + (catch 'drag-again + ;; If the mouse is in the drag scroll margin, scroll + ;; either up or down depending on which margin it is in. + (when mouse-drag-and-drop-region-scroll-margin + (let* ((row (cdr (posn-col-row (event-end event)))) + (window (when (windowp (posn-window (event-end event))) + (posn-window (event-end event)))) + (text-height (when window + (window-text-height window))) + ;; Make sure it's possible to scroll both up + ;; and down if the margin is too large for the + ;; window. + (margin (when text-height + (min (/ text-height 3) + mouse-drag-and-drop-region-scroll-margin)))) + (when (windowp window) + ;; At 2 lines, the window becomes too small for any + ;; meaningful scrolling. + (unless (<= text-height 2) + ;; We could end up at the beginning or end of the + ;; buffer. + (ignore-errors + (cond + ;; Inside the bottom scroll margin, scroll up. + ((> row (- text-height margin)) + (with-selected-window window + (scroll-up 1))) + ;; Inside the top scroll margin, scroll down. + ((< row margin) + (with-selected-window window + (scroll-down 1))))))))) + + ;; Obtain the dragged text in region. When the loop was + ;; skipped, value-selection remains nil. + (unless value-selection + (setq value-selection (funcall region-extract-function nil)) + (when mouse-drag-and-drop-region-show-tooltip + (let ((text-size mouse-drag-and-drop-region-show-tooltip)) + (setq text-tooltip + (if (and (integerp text-size) + (> (length value-selection) text-size)) + (concat + (substring value-selection 0 (/ text-size 2)) + "\n...\n" + (substring value-selection (- (/ text-size 2)) -1)) + value-selection)))) + + ;; Check if selected text is read-only. + (setq text-from-read-only + (or text-from-read-only + (catch 'loop + (dolist (bound (region-bounds)) + (when (text-property-not-all + (car bound) (cdr bound) 'read-only nil) + (throw 'loop t))))))) + + (when (and mouse-drag-and-drop-region-cross-program + (display-graphic-p) + (fboundp 'x-begin-drag) + (or (and (framep (posn-window (event-end event))) + (let ((location (posn-x-y (event-end event))) + (frame (posn-window (event-end event)))) + (or (< (car location) 0) + (< (cdr location) 0) + (> (car location) + (frame-pixel-width frame)) + (> (cdr location) + (frame-pixel-height frame))))) + (and (or (not drag-again-mouse-position) + (let ((mouse-position (mouse-absolute-pixel-position))) + (or (< 5 (abs (- (car drag-again-mouse-position) + (car mouse-position)))) + (< 5 (abs (- (cdr drag-again-mouse-position) + (cdr mouse-position))))))) + (not (posn-window (event-end event)))))) + (setq drag-again-mouse-position nil) + (mouse-drag-and-drop-region-hide-tooltip) + (gui-set-selection 'XdndSelection value-selection) + (let ((drag-action-or-frame + (condition-case nil + (x-begin-drag '("UTF8_STRING" "text/plain" + "text/plain;charset=utf-8" + "STRING" "TEXT" "COMPOUND_TEXT") + (if mouse-drag-and-drop-region-cut-when-buffers-differ + 'XdndActionMove + 'XdndActionCopy) + (posn-window (event-end event)) 'now + ;; On platforms where we know + ;; `return-frame' doesn't + ;; work, allow dropping on + ;; the drop frame. + (eq window-system 'haiku)) + (quit nil)))) + (when (framep drag-action-or-frame) + ;; With some window managers `x-begin-drag' + ;; returns a frame sooner than `mouse-position' + ;; will return one, due to over-wide frame windows + ;; being drawn by the window manager. To avoid + ;; that, we just require the mouse move a few + ;; pixels before beginning another cross-program + ;; drag. + (setq drag-again-mouse-position + (mouse-absolute-pixel-position)) + (throw 'drag-again nil)) + + (let ((min-char (point))) + (when (eq drag-action-or-frame 'XdndActionMove) + ;; Remove the dragged text from source buffer like + ;; operation `cut'. + (dolist (overlay mouse-drag-and-drop-overlays) + (when (< min-char (min (overlay-start overlay) + (overlay-end overlay))) + (setq min-char (min (overlay-start overlay) + (overlay-end overlay)))) + (delete-region (overlay-start overlay) + (overlay-end overlay))) + (goto-char min-char) + (setq deactivate-mark t) + (setq drag-was-cross-program t))) + + (when (eq drag-action-or-frame 'XdndActionCopy) + ;; Set back the dragged text as region on source buffer + ;; like operation `copy'. + (activate-mark))) + (throw 'cross-program-drag nil)) + + (setq window-to-paste (posn-window (event-end event))) + (setq point-to-paste (posn-point (event-end event))) + ;; Set nil when target buffer is minibuffer. + (setq buffer-to-paste (let (buf) + (when (windowp window-to-paste) + (setq buf (window-buffer window-to-paste)) + (when (not (minibufferp buf)) + buf)))) + (setq cursor-in-text-area (and window-to-paste + point-to-paste + buffer-to-paste)) + + (when cursor-in-text-area + ;; Check if point under mouse is read-only. + (save-window-excursion + (select-window window-to-paste) + (setq point-to-paste-read-only + (or buffer-read-only + (get-text-property point-to-paste 'read-only)))) + + ;; Check if "drag but negligible". Operation "drag but + ;; negligible" is defined as drag-and-drop the text to + ;; the original region. When modifier is pressed, the + ;; text will be inserted to inside of the original + ;; region. + ;; + ;; If the region is rectangular, check if the newly inserted + ;; rectangular text would intersect the already selected + ;; region. If it would, then set "drag-but-negligible" to t. + ;; As a special case, allow dragging the region freely anywhere + ;; to the left, as this will never trigger its contents to be + ;; inserted into the overlays tracking it. + (setq drag-but-negligible + (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) + buffer-to-paste) + (if region-noncontiguous + (let ((dimensions (rectangle-dimensions start end)) + (start-coordinates + (rectangle-position-as-coordinates start)) + (point-to-paste-coordinates + (rectangle-position-as-coordinates + point-to-paste))) + (and (rectangle-intersect-p + start-coordinates dimensions + point-to-paste-coordinates dimensions) + (not (< (car point-to-paste-coordinates) + (car start-coordinates))))) + (and (<= (overlay-start + (car mouse-drag-and-drop-overlays)) + point-to-paste) + (<= point-to-paste + (overlay-end + (car mouse-drag-and-drop-overlays)))))))) + + ;; Show a tooltip. + (if mouse-drag-and-drop-region-show-tooltip + ;; Don't use tooltip-show since it has side effects + ;; which change the text properties, and + ;; `text-tooltip' can potentially be the text which + ;; will be pasted. + (mouse-drag-and-drop-region-display-tooltip text-tooltip) + (mouse-drag-and-drop-region-hide-tooltip)) + + ;; Show cursor and highlight the original region. + (when mouse-drag-and-drop-region-show-cursor + ;; Modify cursor even when point is out of frame. + (setq cursor-type (cond + ((not cursor-in-text-area) + nil) + ((or point-to-paste-read-only + drag-but-negligible) + 'hollow) + (t + 'bar))) + (when cursor-in-text-area + (dolist (overlay mouse-drag-and-drop-overlays) + (overlay-put overlay + 'face 'mouse-drag-and-drop-region)) + (deactivate-mark) ; Maintain region in other window. + (mouse-set-point event))))))) + + ;; Hide a tooltip. + (when mouse-drag-and-drop-region-show-tooltip (x-hide-tip)) + + ;; Check if modifier was pressed on drop. + (setq no-modifier-on-drop + (not (member mouse-drag-and-drop-region (event-modifiers event)))) + + ;; Check if event was "click". + (setq clicked (not value-selection)) + + ;; Restore status on drag to outside of text-area or non-mouse input. + (when (or (not cursor-in-text-area) + (not (equal (event-basic-type event) mouse-button))) + (setq drag-but-negligible t + no-modifier-on-drop t)) + + ;; Do not modify any buffers when event is "click", + ;; "drag but negligible", or "drag to read-only". + (unless drag-was-cross-program + (let* ((mouse-drag-and-drop-region-cut-when-buffers-differ + (if no-modifier-on-drop + mouse-drag-and-drop-region-cut-when-buffers-differ + (not mouse-drag-and-drop-region-cut-when-buffers-differ))) + (wanna-paste-to-same-buffer (equal buffer-to-paste buffer)) + (wanna-cut-on-same-buffer (and wanna-paste-to-same-buffer + no-modifier-on-drop)) + (wanna-cut-on-other-buffer + (and (not wanna-paste-to-same-buffer) + mouse-drag-and-drop-region-cut-when-buffers-differ)) + (cannot-paste (or point-to-paste-read-only + (when (or wanna-cut-on-same-buffer + wanna-cut-on-other-buffer) + text-from-read-only)))) + + (cond + ;; Move point within region. + (clicked + (deactivate-mark) + (mouse-set-point event)) + ;; Undo operation. Set back the original text as region. + ((or (and drag-but-negligible + no-modifier-on-drop) + cannot-paste) + ;; Inform user either source or destination buffer cannot be modified. + (when (and (not drag-but-negligible) + cannot-paste) + (message "Buffer is read-only")) + + ;; Select source window back and restore region. + ;; (set-window-point window point) + (select-window window) + (goto-char point) + (setq deactivate-mark nil) + (activate-mark) + (when region-noncontiguous + (rectangle-mark-mode))) + ;; Modify buffers. + (t + ;; * DESTINATION BUFFER:: + ;; Insert the text to destination buffer under mouse. (select-window window-to-paste) - (setq point-to-paste-read-only - (or buffer-read-only - (get-text-property point-to-paste 'read-only)))) - - ;; Check if "drag but negligible". Operation "drag but - ;; negligible" is defined as drag-and-drop the text to - ;; the original region. When modifier is pressed, the - ;; text will be inserted to inside of the original - ;; region. - ;; - ;; If the region is rectangular, check if the newly inserted - ;; rectangular text would intersect the already selected - ;; region. If it would, then set "drag-but-negligible" to t. - ;; As a special case, allow dragging the region freely anywhere - ;; to the left, as this will never trigger its contents to be - ;; inserted into the overlays tracking it. - (setq drag-but-negligible - (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) - buffer-to-paste) - (if region-noncontiguous - (let ((dimensions (rectangle-dimensions start end)) - (start-coordinates - (rectangle-position-as-coordinates start)) - (point-to-paste-coordinates - (rectangle-position-as-coordinates - point-to-paste))) - (and (rectangle-intersect-p - start-coordinates dimensions - point-to-paste-coordinates dimensions) - (not (< (car point-to-paste-coordinates) - (car start-coordinates))))) - (and (<= (overlay-start - (car mouse-drag-and-drop-overlays)) - point-to-paste) - (<= point-to-paste - (overlay-end - (car mouse-drag-and-drop-overlays)))))))) - - ;; Show a tooltip. - (if mouse-drag-and-drop-region-show-tooltip - ;; Don't use tooltip-show since it has side effects - ;; which change the text properties, and - ;; `text-tooltip' can potentially be the text which - ;; will be pasted. - (mouse-drag-and-drop-region-display-tooltip text-tooltip) - (mouse-drag-and-drop-region-hide-tooltip)) - - ;; Show cursor and highlight the original region. - (when mouse-drag-and-drop-region-show-cursor - ;; Modify cursor even when point is out of frame. - (setq cursor-type (cond - ((not cursor-in-text-area) - nil) - ((or point-to-paste-read-only - drag-but-negligible) - 'hollow) - (t - 'bar))) - (when cursor-in-text-area - (dolist (overlay mouse-drag-and-drop-overlays) - (overlay-put overlay - 'face 'mouse-drag-and-drop-region)) - (deactivate-mark) ; Maintain region in other window. - (mouse-set-point event))))))) - - ;; Hide a tooltip. - (when mouse-drag-and-drop-region-show-tooltip (x-hide-tip)) - - ;; Check if modifier was pressed on drop. - (setq no-modifier-on-drop - (not (member mouse-drag-and-drop-region (event-modifiers event)))) - - ;; Check if event was "click". - (setq clicked (not value-selection)) - - ;; Restore status on drag to outside of text-area or non-mouse input. - (when (or (not cursor-in-text-area) - (not (equal (event-basic-type event) mouse-button))) - (setq drag-but-negligible t - no-modifier-on-drop t)) - - ;; Do not modify any buffers when event is "click", - ;; "drag but negligible", or "drag to read-only". - (unless drag-was-cross-program - (let* ((mouse-drag-and-drop-region-cut-when-buffers-differ - (if no-modifier-on-drop - mouse-drag-and-drop-region-cut-when-buffers-differ - (not mouse-drag-and-drop-region-cut-when-buffers-differ))) - (wanna-paste-to-same-buffer (equal buffer-to-paste buffer)) - (wanna-cut-on-same-buffer (and wanna-paste-to-same-buffer - no-modifier-on-drop)) - (wanna-cut-on-other-buffer - (and (not wanna-paste-to-same-buffer) - mouse-drag-and-drop-region-cut-when-buffers-differ)) - (cannot-paste (or point-to-paste-read-only - (when (or wanna-cut-on-same-buffer - wanna-cut-on-other-buffer) - text-from-read-only)))) - - (cond - ;; Move point within region. - (clicked - (deactivate-mark) - (mouse-set-point event)) - ;; Undo operation. Set back the original text as region. - ((or (and drag-but-negligible - no-modifier-on-drop) - cannot-paste) - ;; Inform user either source or destination buffer cannot be modified. - (when (and (not drag-but-negligible) - cannot-paste) - (message "Buffer is read-only")) - - ;; Select source window back and restore region. - ;; (set-window-point window point) - (select-window window) - (goto-char point) - (setq deactivate-mark nil) - (activate-mark) - (when region-noncontiguous - (rectangle-mark-mode))) - ;; Modify buffers. - (t - ;; * DESTINATION BUFFER:: - ;; Insert the text to destination buffer under mouse. - (select-window window-to-paste) - (setq window-exempt window-to-paste) - (goto-char point-to-paste) - (push-mark) - (insert-for-yank value-selection) - - ;; On success, set the text as region on destination buffer. - (when (not (equal (mark) (point))) - (setq deactivate-mark nil) - (activate-mark) - (when region-noncontiguous - (rectangle-mark-mode))) - - ;; * SOURCE BUFFER:: - ;; Set back the original text as region or delete the original - ;; text, on source buffer. - (if wanna-paste-to-same-buffer - ;; When source buffer and destination buffer are the same, - ;; remove the original text. - (when no-modifier-on-drop - (let (deactivate-mark) - (dolist (overlay mouse-drag-and-drop-overlays) - (delete-region (overlay-start overlay) - (overlay-end overlay))))) - ;; When source buffer and destination buffer are different, - ;; keep (set back the original text as region) or remove the - ;; original text. - (select-window window) ; Select window with source buffer. - (goto-char point) ; Move point to the original text on source buffer. - - (if mouse-drag-and-drop-region-cut-when-buffers-differ - ;; Remove the dragged text from source buffer like - ;; operation `cut'. - (dolist (overlay mouse-drag-and-drop-overlays) - (delete-region (overlay-start overlay) - (overlay-end overlay))) - ;; Set back the dragged text as region on source buffer - ;; like operation `copy'. - (activate-mark)) - (select-window window-to-paste))))))) - - ;; Clean up. - (dolist (overlay mouse-drag-and-drop-overlays) - (delete-overlay overlay)) - - ;; Restore old states but for the window where the drop - ;; occurred. Restore cursor types for all windows. - (dolist (state states) - (let ((window (car state))) - (when (and window-exempt - (not (eq window window-exempt))) - (set-window-start window (nth 1 state) 'noforce) - (set-marker (nth 1 state) nil) - ;; If window is selected, the following automatically sets - ;; point for that window's buffer. - (set-window-point window (nth 2 state)) - (set-marker (nth 2 state) nil)) - (with-current-buffer (window-buffer window) - (setq cursor-type (nth 3 state))))))) + (setq window-exempt window-to-paste) + (goto-char point-to-paste) + (push-mark) + (insert-for-yank value-selection) + + ;; On success, set the text as region on destination buffer. + (when (not (equal (mark) (point))) + (setq deactivate-mark nil) + (activate-mark) + (when region-noncontiguous + (rectangle-mark-mode))) + + ;; * SOURCE BUFFER:: + ;; Set back the original text as region or delete the original + ;; text, on source buffer. + (if wanna-paste-to-same-buffer + ;; When source buffer and destination buffer are the same, + ;; remove the original text. + (when no-modifier-on-drop + (let (deactivate-mark) + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-region (overlay-start overlay) + (overlay-end overlay))))) + ;; When source buffer and destination buffer are different, + ;; keep (set back the original text as region) or remove the + ;; original text. + (select-window window) ; Select window with source buffer. + (goto-char point) ; Move point to the original text on source buffer. + + (if mouse-drag-and-drop-region-cut-when-buffers-differ + ;; Remove the dragged text from source buffer like + ;; operation `cut'. + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-region (overlay-start overlay) + (overlay-end overlay))) + ;; Set back the dragged text as region on source buffer + ;; like operation `copy'. + (activate-mark)) + (select-window window-to-paste)))))))) + + (when was-tooltip-mode + (tooltip-mode 1)) + + ;; Clean up. + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-overlay overlay)) + + ;; Restore old states but for the window where the drop + ;; occurred. Restore cursor types for all windows. + (dolist (state states) + (let ((window (car state))) + (when (and window-exempt + (not (eq window window-exempt))) + (set-window-start window (nth 1 state) 'noforce) + (set-marker (nth 1 state) nil) + ;; If window is selected, the following automatically sets + ;; point for that window's buffer. + (set-window-point window (nth 2 state)) + (set-marker (nth 2 state) nil)) + (with-current-buffer (window-buffer window) + (setq cursor-type (nth 3 state)))))))) ;;; Bindings for mouse commands. commit ce513544327de17e6c485cb6aa886cc9f08c82b3 Author: Po Lu Date: Thu Jun 2 05:44:46 2022 +0000 Fix flicker during mouse DND on Haiku as well * src/haikuterm.c (haiku_read_socket): Don't clear tooltips on crossing if track-mouse is drag-source and the display is grabbed. diff --git a/src/haikuterm.c b/src/haikuterm.c index 7f0bc1a8cf..d3a02ff6e5 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3289,7 +3289,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) tooltip frame. FIXME: for some reason we don't get leave notification events for this. */ - if (any_help_event_p) + if (any_help_event_p + && !(EQ (track_mouse, Qdrag_source) + && gui_mouse_grabbed (x_display_list))) do_help = -1; break; } @@ -3336,7 +3338,9 @@ 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) + if (any_help_event_p + && !(EQ (track_mouse, Qdrag_source) + && gui_mouse_grabbed (x_display_list))) do_help = -1; } else commit 1b9aca0ea8c8a70541e3ced0a21afa16e15a15cd Author: Po Lu Date: Thu Jun 2 13:37:52 2022 +0800 Fix typos in last change * src/xterm.c (handle_one_xevent): Fix typos. diff --git a/src/xterm.c b/src/xterm.c index e5f0ec703c..cd6b6af58f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16822,8 +16822,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) - && gui_mouse_grabbed (dpyinfo))) + && !(EQ (track_mouse, Qdrag_source) + && gui_mouse_grabbed (dpyinfo))) do_help = -1; } #ifdef USE_GTK @@ -18163,8 +18163,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) - && gui_mouse_grabbed (dpyinfo))) + && !(EQ (track_mouse, Qdrag_source) + && gui_mouse_grabbed (dpyinfo))) do_help = -1; } #ifdef USE_GTK commit 2a40fa3d85893d13898aa49400acb506de1ef3da Author: Po Lu Date: Thu Jun 2 13:33:17 2022 +0800 Fix tooltips flickering on X during `mouse-drag-and-drop-region' * src/xterm.c (x_get_window_below): New function. (XTmouse_position): If track-mouse is drag-source and a window is a tooltip, look below it. (handle_one_xevent): Don't generate a nil help-echo event on LeaveNotify if the display is grabbed and track-mouse is drag-source. diff --git a/src/xterm.c b/src/xterm.c index f6b99e7f40..e5f0ec703c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11518,6 +11518,80 @@ x_note_mouse_movement (struct frame *frame, const XMotionEvent *event, return false; } +/* Get a sibling of DPY below WINDOW at PARENT_X and PARENT_Y. */ +static Window +x_get_window_below (Display *dpy, Window window, + int parent_x, int parent_y, + int *inner_x, int *inner_y) +{ + int rc, i, cx, cy; + XWindowAttributes attrs; + unsigned int nchildren; + Window root, parent, *children, value; + bool window_seen; + + /* TODO: rewrite to have less dependencies. */ + + children = NULL; + window_seen = false; + value = None; + + rc = XQueryTree (dpy, window, &root, &parent, + &children, &nchildren); + + if (rc) + { + if (children) + XFree (children); + + rc = XQueryTree (dpy, parent, &root, + &parent, &children, &nchildren); + } + + if (rc) + { + for (i = nchildren - 1; i >= 0; --i) + { + if (children[i] == window) + { + window_seen = true; + continue; + } + + if (!window_seen) + continue; + + rc = XGetWindowAttributes (dpy, children[i], &attrs); + + if (rc && attrs.map_state != IsViewable) + continue; + + if (rc && parent_x >= attrs.x + && parent_y >= attrs.y + && parent_x < attrs.x + attrs.width + && parent_y < attrs.y + attrs.height) + { + value = children[i]; + cx = parent_x - attrs.x; + cy = parent_y - attrs.y; + + break; + } + } + } + + if (children) + XFree (children); + + if (value) + { + *inner_x = cx; + *inner_y = cy; + } + + return value; +} + /* Return the current position of the mouse. *FP should be a frame which indicates which display to ask about. @@ -11543,7 +11617,7 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, Time *timestamp) { - struct frame *f1; + struct frame *f1, *maybe_tooltip; struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (*fp); block_input (); @@ -11599,9 +11673,11 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, Window first_win = 0; #endif int win_x, win_y; - int parent_x = 0, parent_y = 0; + int parent_x, parent_y; win = root; + parent_x = root_x; + parent_y = root_y; /* XTranslateCoordinates can get errors if the window structure is changing at the same time this function @@ -11636,6 +11712,19 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, root_x, root_y, &win_x, &win_y, /* Child of win. */ &child); + + /* If CHILD is a tooltip frame, look below it if + track-mouse is drag-source. */ + if (child != None) + { + maybe_tooltip = x_any_window_to_frame (dpyinfo, child); + + if (maybe_tooltip && FRAME_TOOLTIP_P (maybe_tooltip)) + child = x_get_window_below (dpyinfo->display, child, + parent_x, parent_y, &win_x, + &win_y); + } + if (child == None || child == win) { #ifdef USE_GTK @@ -16729,7 +16818,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, Do it only if there's something to cancel. Otherwise, the startup message is cleared when the mouse leaves the frame. */ - if (any_help_event_p) + if (any_help_event_p + /* 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) + && gui_mouse_grabbed (dpyinfo))) do_help = -1; } #ifdef USE_GTK @@ -18064,7 +18158,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, Do it only if there's something to cancel. Otherwise, the startup message is cleared when the mouse leaves the frame. */ - if (any_help_event_p) + if (any_help_event_p + /* 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) + && gui_mouse_grabbed (dpyinfo))) do_help = -1; } #ifdef USE_GTK commit 804415b8cc1dab0f2f49ad05bb5f47431fcc9e57 Merge: 5255fa452f d9e106c72e Author: Stefan Monnier Date: Wed Jun 1 22:32:03 2022 -0400 Merge remote-tracking branch 'refs/remotes/origin/master' commit 5255fa452f338c2ae97fa1ade70b396513bc6e9b Author: Richard Hansen Date: Sun May 29 18:09:08 2022 -0400 bindat (strz): Fix wrong-type-argument error when unpacking * lisp/emacs-lisp/bindat.el (strz): Fix (wrong-type-argument number-or-marker-p nil) error when unpacking a strz with unspecified (variable) length. * test/lisp/emacs-lisp/bindat-tests.el (strz): Mark test as passing. diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index e597dd6247..0725b677cf 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -165,12 +165,12 @@ (if (stringp s) s (apply #'unibyte-string s)))) -(defun bindat--unpack-strz (len) +(defun bindat--unpack-strz (&optional len) (let ((i 0) s) (while (and (if len (< i len) t) (/= (aref bindat-raw (+ bindat-idx i)) 0)) (setq i (1+ i))) (setq s (substring bindat-raw bindat-idx (+ bindat-idx i))) - (setq bindat-idx (+ bindat-idx len)) + (setq bindat-idx (+ bindat-idx (or len (1+ i)))) (if (stringp s) s (apply #'unibyte-string s)))) diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index cb7b6fe1c2..b3850f14f1 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -199,7 +199,6 @@ (should (equal (bindat-pack spec "abc") "abc\0"))) (ert-deftest bindat-test--strz-varlen-unpack () - :expected-result :failed ;; There is no test for unpacking a string without a null ;; terminator because such packed strings cannot be produced from ;; the spec (packing "a" should produce "a\0", not "a"). commit 30ec4a7347b2944818c6fc469ae871374ce7caa4 Author: Richard Hansen Date: Sat May 28 23:53:51 2022 -0400 ; bindat (strz): Consistent length type check The strz length computation uses `numberp' to switch between fixed-length and variable-length modes, so packing should too. diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index b236e47e5b..e597dd6247 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -693,7 +693,7 @@ is the name of a variable that will hold the value we need to pack.") (t `(or ,len (1+ (length ,val))))))) (`(pack . ,args) (macroexp-let2 nil len len - `(if ,len + `(if (numberp ,len) ;; Same as non-zero terminated strings since we don't actually add ;; the terminating zero anyway (because we rely on the fact that ;; `bindat-raw' was presumably initialized with all-zeroes before commit e66d6b379345063900eb3e99db6367c69a860cdf Author: Richard Hansen Date: Sat May 28 23:10:44 2022 -0400 bindat (strz): Fix off-by-one bug in computed length * lisp/emacs-lisp/bindat.el (strz): Include null terminator when computing packed string length. * test/lisp/emacs-lisp/bindat-tests.el (strz): Mark tests as passing. diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index c6d64975ec..b236e47e5b 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -688,9 +688,9 @@ is the name of a variable that will hold the value we need to pack.") ('unpack `(bindat--unpack-strz ,len)) (`(length ,val) `(cl-incf bindat-idx ,(cond - ((null len) `(length ,val)) + ((null len) `(1+ (length ,val))) ((numberp len) len) - (t `(or ,len (length ,val)))))) + (t `(or ,len (1+ (length ,val))))))) (`(pack . ,args) (macroexp-let2 nil len len `(if ,len diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index c8545a216b..cb7b6fe1c2 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -191,12 +191,10 @@ (let ((spec (bindat-type strz))) (ert-deftest bindat-test--strz-varlen-len () - :expected-result :failed (should (equal (bindat-length spec "") 1)) (should (equal (bindat-length spec "abc") 4))) (ert-deftest bindat-test--strz-varlen-pack () - :expected-result :failed (should (equal (bindat-pack spec "") "\0")) (should (equal (bindat-pack spec "abc") "abc\0"))) commit 916492cb6d531e3ae16f1dc361725d60074af844 Author: Richard Hansen Date: Sun May 29 17:15:04 2022 -0400 ; bindat-tests (strz): Add more tests diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index 7722cf6c02..c8545a216b 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -162,4 +162,73 @@ (bindat-pack bindat-test--LEB128 n)) n))))))) +(let ((spec (bindat-type strz 2))) + (ert-deftest bindat-test--strz-fixedlen-len () + (should (equal (bindat-length spec "") 2)) + (should (equal (bindat-length spec "a") 2))) + + (ert-deftest bindat-test--strz-fixedlen-len-overflow () + (should (equal (bindat-length spec "abc") 2))) + + (ert-deftest bindat-test--strz-fixedlen-pack () + (should (equal (bindat-pack spec "") "\0\0")) + (should (equal (bindat-pack spec "a") "a\0"))) + + (ert-deftest bindat-test--strz-fixedlen-pack-overflow () + ;; This is not the only valid semantic, but it's the one we've + ;; offered historically. + (should (equal (bindat-pack spec "abc") "ab"))) + + (ert-deftest bindat-test--strz-fixedlen-unpack () + ;; There are no tests for unpacking "ab" or "ab\0" because those + ;; packed strings cannot be produced from the spec (packing "ab" + ;; should produce "a\0", not "ab" or "ab\0"). + (should (equal (bindat-unpack spec "\0\0") "")) + (should (equal (bindat-unpack spec "\0X") "")) + (should (equal (bindat-unpack spec "a\0") "a")) + ;; Same comment as for b-t-s-f-pack-overflow. + (should (equal (bindat-unpack spec "ab") "ab")))) + +(let ((spec (bindat-type strz))) + (ert-deftest bindat-test--strz-varlen-len () + :expected-result :failed + (should (equal (bindat-length spec "") 1)) + (should (equal (bindat-length spec "abc") 4))) + + (ert-deftest bindat-test--strz-varlen-pack () + :expected-result :failed + (should (equal (bindat-pack spec "") "\0")) + (should (equal (bindat-pack spec "abc") "abc\0"))) + + (ert-deftest bindat-test--strz-varlen-unpack () + :expected-result :failed + ;; There is no test for unpacking a string without a null + ;; terminator because such packed strings cannot be produced from + ;; the spec (packing "a" should produce "a\0", not "a"). + (should (equal (bindat-unpack spec "\0") "")) + (should (equal (bindat-unpack spec "abc\0") "abc")))) + +(let ((spec '((x strz 2)))) + (ert-deftest bindat-test--strz-legacy-fixedlen-len () + (should (equal (bindat-length spec '((x . ""))) 2)) + (should (equal (bindat-length spec '((x . "a"))) 2))) + + (ert-deftest bindat-test--strz-legacy-fixedlen-len-overflow () + (should (equal (bindat-length spec '((x . "abc"))) 2))) + + (ert-deftest bindat-test--strz-legacy-fixedlen-pack () + (should (equal (bindat-pack spec '((x . ""))) "\0\0")) + (should (equal (bindat-pack spec '((x . "a"))) "a\0"))) + + (ert-deftest bindat-test--strz-legacy-fixedlen-pack-overflow () + ;; Same comment as for b-t-s-f-pack-overflow. + (should (equal (bindat-pack spec '((x . "abc"))) "ab"))) + + (ert-deftest bindat-test--strz-legacy-fixedlen-unpack () + ;; There are no tests for unpacking "ab" or "ab\0" because those + ;; packed strings cannot be produced from the spec (packing "ab" + ;; should produce "a\0", not "ab" or "ab\0"). + (should (equal (bindat-unpack spec "\0\0") '((x . "")))) + (should (equal (bindat-unpack spec "a\0") '((x . "a")))))) + ;;; bindat-tests.el ends here commit d9e106c72ee0cf7110beb6749790231b6dcca304 Author: Po Lu Date: Thu Jun 2 09:02:55 2022 +0800 Clean up Motif drag-and-drop code * src/xterm.c (enum xm_drag_operation, enum xm_drag_action) (enum xm_drag_reason, enum xm_drag_originator, enum xm_drag_style) (enum xm_drop_site_status): Turn macros into enums. (x_next_event_from_any_display): Fix initial value of rc. diff --git a/src/xterm.c b/src/xterm.c index 33b61ba02a..f6b99e7f40 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1367,34 +1367,50 @@ typedef struct xm_top_level_leave_message /* #define XM_DRAG_SIDE_EFFECT_OPERATIONS(effect) (((effect) & 0xf00) >> 8) */ #define XM_DRAG_SIDE_EFFECT_DROP_ACTION(effect) (((effect) & 0xf000) >> 12) -#define XM_DRAG_NOOP 0 -#define XM_DRAG_MOVE (1L << 0) -#define XM_DRAG_COPY (1L << 1) -#define XM_DRAG_LINK (1L << 2) +enum xm_drag_operation + { + XM_DRAG_NOOP = 0, + XM_DRAG_MOVE = (1L << 0), + XM_DRAG_COPY = (1L << 1), + XM_DRAG_LINK = (1L << 2), + }; -#define XM_DROP_ACTION_DROP 0 -#define XM_DROP_ACTION_DROP_HELP 1 -#define XM_DROP_ACTION_DROP_CANCEL 2 +enum xm_drag_action + { + XM_DROP_ACTION_DROP = 0, + XM_DROP_ACTION_DROP_HELP = 1, + XM_DROP_ACTION_DROP_CANCEL = 2, + }; #define XM_DRAG_REASON(originator, code) ((code) | ((originator) << 7)) #define XM_DRAG_REASON_ORIGINATOR(reason) (((reason) & 0x80) ? 1 : 0) #define XM_DRAG_REASON_CODE(reason) ((reason) & 0x7f) -#define XM_DRAG_REASON_DROP_START 5 -#define XM_DRAG_REASON_TOP_LEVEL_ENTER 0 -#define XM_DRAG_REASON_TOP_LEVEL_LEAVE 1 -#define XM_DRAG_REASON_DRAG_MOTION 2 -#define XM_DRAG_ORIGINATOR_INITIATOR 0 -#define XM_DRAG_ORIGINATOR_RECEIVER 1 - -#define XM_DRAG_STYLE_NONE 0 +enum xm_drag_reason + { + XM_DRAG_REASON_DROP_START = 5, + XM_DRAG_REASON_TOP_LEVEL_ENTER = 0, + XM_DRAG_REASON_TOP_LEVEL_LEAVE = 1, + XM_DRAG_REASON_DRAG_MOTION = 2, + }; -#define XM_DRAG_STYLE_DROP_ONLY 1 -#define XM_DRAG_STYLE_DROP_ONLY_REC 3 +enum xm_drag_originator + { + XM_DRAG_ORIGINATOR_INITIATOR = 0, + XM_DRAG_ORIGINATOR_RECEIVER = 1, + }; -#define XM_DRAG_STYLE_DYNAMIC 5 -#define XM_DRAG_STYLE_DYNAMIC_REC 2 -#define XM_DRAG_STYLE_DYNAMIC_REC1 4 +enum xm_drag_style + { + /* The values ending with _REC should be treated as equivalent to + the ones without in messages from the receiver. */ + XM_DRAG_STYLE_NONE = 0, + XM_DRAG_STYLE_DROP_ONLY = 1, + XM_DRAG_STYLE_DROP_ONLY_REC = 3, + XM_DRAG_STYLE_DYNAMIC = 5, + XM_DRAG_STYLE_DYNAMIC_REC = 2, + XM_DRAG_STYLE_DYNAMIC_REC1 = 4, + }; #define XM_DRAG_STYLE_IS_DROP_ONLY(n) ((n) == XM_DRAG_STYLE_DROP_ONLY \ || (n) == XM_DRAG_STYLE_DROP_ONLY_REC) @@ -1402,9 +1418,12 @@ typedef struct xm_top_level_leave_message || (n) == XM_DRAG_STYLE_DYNAMIC_REC \ || (n) == XM_DRAG_STYLE_DYNAMIC_REC1) -#define XM_DROP_SITE_VALID 3 -/* #define XM_DROP_SITE_INVALID 2 */ -#define XM_DROP_SITE_NONE 1 +enum xm_drop_site_status + { + XM_DROP_SITE_VALID = 3, + XM_DROP_SITE_INVALID = 2, + XM_DROP_SITE_NONE = 1, + }; /* The version of the Motif drag-and-drop protocols that Emacs supports. */ @@ -10295,7 +10314,7 @@ x_next_event_from_any_display (XEvent *event) fd_set fds, rfds; int fd, maxfd, rc; - rc = 0; + rc = -1; FD_ZERO (&rfds); while (true) commit 47b8c3f0b97b6e59f475c996bba3cbb7f2e7ddf2 Author: Po Lu Date: Thu Jun 2 08:32:23 2022 +0800 Fix decoding of XdndStatus rectangles on 64-bit systems * src/xterm.c (handle_one_xevent): Make data.l[2] and data.l[3] unsigned. diff --git a/src/xterm.c b/src/xterm.c index 7234e7c758..33b61ba02a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15077,6 +15077,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, && event->xclient.message_type == dpyinfo->Xatom_XdndStatus) { Window target; + unsigned long r1, r2; target = event->xclient.data.l[0]; @@ -15084,11 +15085,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, && target == x_dnd_last_seen_window && event->xclient.data.l[1] & 2) { + r1 = event->xclient.data.l[2]; + r2 = event->xclient.data.l[2]; + x_dnd_mouse_rect_target = target; - x_dnd_mouse_rect.x = (event->xclient.data.l[2] & 0xffff0000) >> 16; - x_dnd_mouse_rect.y = (event->xclient.data.l[2] & 0xffff); - x_dnd_mouse_rect.width = (event->xclient.data.l[3] & 0xffff0000) >> 16; - x_dnd_mouse_rect.height = (event->xclient.data.l[3] & 0xffff); + x_dnd_mouse_rect.x = (r1 & 0xffff0000) >> 16; + x_dnd_mouse_rect.y = (r1 & 0xffff); + x_dnd_mouse_rect.width = (r2 & 0xffff0000) >> 16; + x_dnd_mouse_rect.height = (r2 & 0xffff); } else x_dnd_mouse_rect_target = None; commit f71cfd3084103460d7cdad96bf7f8b88e1d19596 Author: Mattias Engdegård Date: Wed Jun 1 22:49:34 2022 +0200 Revert "Fix reader char escape bugs (bug#55738)" This reverts commit c50718dcfa54293b695f8a3fa5cd4d77848ee084. It may have caused bootstrap problems. Sorry about that. diff --git a/src/lread.c b/src/lread.c index 670413efc0..a1045184d9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2631,88 +2631,93 @@ character_name_to_code (char const *name, ptrdiff_t name_len, enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 }; /* Read a \-escape sequence, assuming we already read the `\'. - When there is a difference between string and character literal \-sequences, - the latter is assumed. If the escape sequence forces unibyte, return eight-bit char. */ static int -read_escape (Lisp_Object readcharfun) +read_escape (Lisp_Object readcharfun, bool stringp) { - int modifiers = 0; - again: ; int c = READCHAR; - int unicode_hex_count; + /* \u allows up to four hex digits, \U up to eight. Default to the + behavior for \u, and change this value in the case that \U is seen. */ + int unicode_hex_count = 4; switch (c) { case -1: end_of_file_error (); - case 'a': c = '\a'; break; - case 'b': c = '\b'; break; - case 'd': c = 127; break; - case 'e': c = 27; break; - case 'f': c = '\f'; break; - case 'n': c = '\n'; break; - case 'r': c = '\r'; break; - case 't': c = '\t'; break; - case 'v': c = '\v'; break; + case 'a': + return '\007'; + case 'b': + return '\b'; + case 'd': + return 0177; + case 'e': + return 033; + case 'f': + return '\f'; + case 'n': + return '\n'; + case 'r': + return '\r'; + case 't': + return '\t'; + case 'v': + return '\v'; + case '\n': + return -1; + case ' ': + if (stringp) + return -1; + return ' '; case 'M': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); - modifiers |= meta_modifier; c = READCHAR; if (c == '\\') - goto again; - break; + c = read_escape (readcharfun, 0); + return c | meta_modifier; case 'S': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); - modifiers |= shift_modifier; c = READCHAR; if (c == '\\') - goto again; - break; + c = read_escape (readcharfun, 0); + return c | shift_modifier; case 'H': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); - modifiers |= hyper_modifier; c = READCHAR; if (c == '\\') - goto again; - break; + c = read_escape (readcharfun, 0); + return c | hyper_modifier; case 'A': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); - modifiers |= alt_modifier; c = READCHAR; if (c == '\\') - goto again; - break; + c = read_escape (readcharfun, 0); + return c | alt_modifier; case 's': c = READCHAR; - if (c == '-') - { - modifiers |= super_modifier; - c = READCHAR; - if (c == '\\') - goto again; - } - else + if (stringp || c != '-') { UNREAD (c); - c = ' '; + return ' '; } - break; + c = READCHAR; + if (c == '\\') + c = read_escape (readcharfun, 0); + return c | super_modifier; case 'C': c = READCHAR; @@ -2720,11 +2725,21 @@ read_escape (Lisp_Object readcharfun) error ("Invalid escape character syntax"); FALLTHROUGH; case '^': - modifiers |= ctrl_modifier; c = READCHAR; if (c == '\\') - goto again; - break; + c = read_escape (readcharfun, 0); + if ((c & ~CHAR_MODIFIER_MASK) == '?') + return 0177 | (c & CHAR_MODIFIER_MASK); + else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) + return c | ctrl_modifier; + /* ASCII control chars are made from letters (both cases), + as well as the non-letters within 0100...0137. */ + else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) + return (c & (037 | ~0177)); + else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) + return (c & (037 | ~0177)); + else + return c | ctrl_modifier; case '0': case '1': @@ -2734,30 +2749,31 @@ read_escape (Lisp_Object readcharfun) case '5': case '6': case '7': - /* 1-3 octal digits. */ + /* An octal escape, as in ANSI C. */ { - int i = c - '0'; - int count = 0; + register int i = c - '0'; + register int count = 0; while (++count < 3) { - c = READCHAR; - if (c < '0' || c > '7') + if ((c = READCHAR) >= '0' && c <= '7') + { + i *= 8; + i += c - '0'; + } + else { UNREAD (c); break; } - i *= 8; - i += c - '0'; } if (i >= 0x80 && i < 0x100) i = BYTE8_TO_CHAR (i); - c = i; - break; + return i; } case 'x': - /* One or more hex digits. */ + /* A hex escape, as in ANSI C. */ { unsigned int i = 0; int count = 0; @@ -2779,18 +2795,16 @@ read_escape (Lisp_Object readcharfun) } if (count < 3 && i >= 0x80) - i = BYTE8_TO_CHAR (i); - c = i; - break; + return BYTE8_TO_CHAR (i); + return i; } - case 'U': /* Eight hex digits. */ + case 'U': + /* Post-Unicode-2.0: Up to eight hex chars. */ unicode_hex_count = 8; - goto unicode; + FALLTHROUGH; + case 'u': - case 'u': /* Four hex digits. */ - unicode_hex_count = 4; - unicode: /* A Unicode escape. We only permit them in strings and characters, not arbitrarily in the source code, as in some other languages. */ { @@ -2801,8 +2815,12 @@ read_escape (Lisp_Object readcharfun) { c = READCHAR; if (c < 0) - error ("Malformed Unicode escape: \\%c%x", - unicode_hex_count == 4 ? 'u' : 'U', i); + { + if (unicode_hex_count > 4) + error ("Malformed Unicode escape: \\U%x", i); + else + error ("Malformed Unicode escape: \\u%x", i); + } /* `isdigit' and `isalpha' may be locale-specific, which we don't want. */ int digit = char_hexdigit (c); @@ -2813,8 +2831,7 @@ read_escape (Lisp_Object readcharfun) } if (i > 0x10FFFF) error ("Non-Unicode character: 0x%x", i); - c = i; - break; + return i; } case 'N': @@ -2863,31 +2880,12 @@ read_escape (Lisp_Object readcharfun) /* character_name_to_code can invoke read0, recursively. This is why read0's buffer is not static. */ - c = character_name_to_code (name, length, readcharfun); - break; + return character_name_to_code (name, length, readcharfun); } - } - c |= modifiers; - if (c & ctrl_modifier) - { - int b = c & ~CHAR_MODIFIER_MASK; - /* If the base char is in the 0x3f..0x5f range or a lower case - letter, drop the ctrl_modifier bit and generate a C0 control - character instead. */ - if ((b >= 0x3f && b <= 0x5f) || (b >= 'a' && b <= 'z')) - { - c &= ~ctrl_modifier; - if (b == '?') - /* Special case: ^? is DEL. */ - b = 127; - else - /* Make a C0 control in 0..31 by clearing bits 5 and 6. */ - b &= 0x1f; - } - c = b | (c & CHAR_MODIFIER_MASK); + default: + return c; } - return c; } /* Return the digit that CHARACTER stands for in the given BASE. @@ -3014,7 +3012,7 @@ read_char_literal (Lisp_Object readcharfun) } if (ch == '\\') - ch = read_escape (readcharfun); + ch = read_escape (readcharfun, 0); int modifiers = ch & CHAR_MODIFIER_MASK; ch &= ~CHAR_MODIFIER_MASK; @@ -3068,21 +3066,14 @@ read_string_literal (char stackbuf[VLA_ELEMS (stackbufsize)], if (ch == '\\') { - ch = READCHAR; - switch (ch) + ch = read_escape (readcharfun, 1); + + /* CH is -1 if \ newline or \ space has just been seen. */ + if (ch == -1) { - case 's': - ch = ' '; - break; - case ' ': - case '\n': if (p == read_buffer) cancel = true; continue; - default: - UNREAD (ch); - ch = read_escape (readcharfun); - break; } int modifiers = ch & CHAR_MODIFIER_MASK; @@ -3094,13 +3085,19 @@ read_string_literal (char stackbuf[VLA_ELEMS (stackbufsize)], force_multibyte = true; else /* I.e. ASCII_CHAR_P (ch). */ { - /* 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 == ' ') + /* Allow `\C- ' and `\C-?'. */ + if (modifiers == CHAR_CTL) { - ch = 0; - modifiers = 0; + if (ch == ' ') + { + ch = 0; + modifiers = 0; + } + else if (ch == '?') + { + ch = 127; + modifiers = 0; + } } if (modifiers & CHAR_SHIFT) { diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 59d5ca076f..47351c1d11 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -317,14 +317,4 @@ literals (Bug#20852)." (should (equal (read-from-string "#_") '(## . 2)))) -(ert-deftest lread-misc-2 () - ;; ?\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))) - ;; The Control modifier constructs should be idempotent. - (should (equal ?\C-\C-x ?\C-x)) - (should (equal ?\^\^x ?\C-x)) - (should (equal ?\C-\^x ?\C-x)) - (should (equal ?\^\C-x ?\C-x))) - ;;; lread-tests.el ends here commit 3fd58ad37e12845fab905c00e87ae1d49755504a Author: Juri Linkov Date: Wed Jun 1 22:12:12 2022 +0300 * lisp/simple.el (completion-setup-function): Use file-name-directory. Replace file-name-as-directory with file-name-directory, because file-name-as-directory returns a nonexistent dir e.g. "/dir/prefix/" when completing "/dir/prefix". OTOH, file-name-directory returns "/dir/" in such cases (bug#55743). diff --git a/lisp/simple.el b/lisp/simple.el index 24c61b5bee..a22df8025b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9802,7 +9802,7 @@ Called from `temp-buffer-show-hook'." ;; - With fancy completion styles, the code below will not always ;; find the right base directory. (if minibuffer-completing-file-name - (file-name-as-directory + (file-name-directory (expand-file-name (buffer-substring (minibuffer-prompt-end) (point))))))) (with-current-buffer standard-output commit 58965d91e7fb5a26a5422357f44d6e841f67db74 Author: Eli Zaretskii Date: Wed Jun 1 21:57:07 2022 +0300 Avoid segfaults on MS-Windows when invoked with --version * src/emacs.c (main): If invoked with --version, call 'init_bignum' before calling 'format-time-string', as that is needed for safe manipulation of bignums in timefns.c. diff --git a/src/emacs.c b/src/emacs.c index 9197a19f36..e4257a66b4 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1428,6 +1428,11 @@ main (int argc, char **argv) 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)) commit c50718dcfa54293b695f8a3fa5cd4d77848ee084 Author: Mattias Engdegård Date: Wed Jun 1 11:39:44 2022 +0200 Fix reader char escape bugs (bug#55738) Make the character literal ?\LF (linefeed) generate 10, not -1. Ensure that Control escape sequences in character literals are idempotent: ?\C-\C-a and ?\^\^a mean the same thing as ?\C-a and ?\^a, generating the control character with value 1. "\C-\C-a" no longer signals an error. * src/lread.c (read_escape): Make nonrecursive and only combine the base char with modifiers at the end, creating control chars if applicable. 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-misc-2): New test. diff --git a/src/lread.c b/src/lread.c index a1045184d9..670413efc0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2631,93 +2631,88 @@ character_name_to_code (char const *name, ptrdiff_t name_len, enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 }; /* Read a \-escape sequence, assuming we already read the `\'. + When there is a difference between string and character literal \-sequences, + the latter is assumed. 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 modifiers = 0; + again: ; int c = READCHAR; - /* \u allows up to four hex digits, \U up to eight. Default to the - behavior for \u, and change this value in the case that \U is seen. */ - int unicode_hex_count = 4; + int unicode_hex_count; switch (c) { case -1: end_of_file_error (); - case 'a': - return '\007'; - case 'b': - return '\b'; - case 'd': - return 0177; - case 'e': - return 033; - case 'f': - return '\f'; - case 'n': - return '\n'; - case 'r': - return '\r'; - case 't': - return '\t'; - case 'v': - return '\v'; - case '\n': - return -1; - case ' ': - if (stringp) - return -1; - return ' '; + case 'a': c = '\a'; break; + case 'b': c = '\b'; break; + case 'd': c = 127; break; + case 'e': c = 27; break; + case 'f': c = '\f'; break; + case 'n': c = '\n'; break; + case 'r': c = '\r'; break; + case 't': c = '\t'; break; + case 'v': c = '\v'; break; case 'M': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); + modifiers |= meta_modifier; c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); - return c | meta_modifier; + goto again; + break; case 'S': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); + modifiers |= shift_modifier; c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); - return c | shift_modifier; + goto again; + break; case 'H': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); + modifiers |= hyper_modifier; c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); - return c | hyper_modifier; + goto again; + break; case 'A': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); + modifiers |= alt_modifier; c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); - return c | alt_modifier; + goto again; + break; case 's': c = READCHAR; - if (stringp || c != '-') + if (c == '-') + { + modifiers |= super_modifier; + c = READCHAR; + if (c == '\\') + goto again; + } + else { UNREAD (c); - return ' '; + c = ' '; } - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun, 0); - return c | super_modifier; + break; case 'C': c = READCHAR; @@ -2725,21 +2720,11 @@ read_escape (Lisp_Object readcharfun, bool stringp) error ("Invalid escape character syntax"); FALLTHROUGH; case '^': + modifiers |= ctrl_modifier; c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); - if ((c & ~CHAR_MODIFIER_MASK) == '?') - return 0177 | (c & CHAR_MODIFIER_MASK); - else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) - return c | ctrl_modifier; - /* ASCII control chars are made from letters (both cases), - as well as the non-letters within 0100...0137. */ - else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) - return (c & (037 | ~0177)); - else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) - return (c & (037 | ~0177)); - else - return c | ctrl_modifier; + goto again; + break; case '0': case '1': @@ -2749,31 +2734,30 @@ read_escape (Lisp_Object readcharfun, bool stringp) case '5': case '6': case '7': - /* An octal escape, as in ANSI C. */ + /* 1-3 octal digits. */ { - register int i = c - '0'; - register int count = 0; + int i = c - '0'; + int count = 0; while (++count < 3) { - if ((c = READCHAR) >= '0' && c <= '7') - { - i *= 8; - i += c - '0'; - } - else + c = READCHAR; + if (c < '0' || c > '7') { UNREAD (c); break; } + i *= 8; + i += c - '0'; } if (i >= 0x80 && i < 0x100) i = BYTE8_TO_CHAR (i); - return i; + c = i; + break; } case 'x': - /* A hex escape, as in ANSI C. */ + /* One or more hex digits. */ { unsigned int i = 0; int count = 0; @@ -2795,16 +2779,18 @@ read_escape (Lisp_Object readcharfun, bool stringp) } if (count < 3 && i >= 0x80) - return BYTE8_TO_CHAR (i); - return i; + i = BYTE8_TO_CHAR (i); + c = i; + break; } - case 'U': - /* Post-Unicode-2.0: Up to eight hex chars. */ + case 'U': /* Eight hex digits. */ unicode_hex_count = 8; - FALLTHROUGH; - case 'u': + goto unicode; + case 'u': /* Four hex digits. */ + unicode_hex_count = 4; + unicode: /* A Unicode escape. We only permit them in strings and characters, not arbitrarily in the source code, as in some other languages. */ { @@ -2815,12 +2801,8 @@ read_escape (Lisp_Object readcharfun, bool stringp) { c = READCHAR; if (c < 0) - { - if (unicode_hex_count > 4) - error ("Malformed Unicode escape: \\U%x", i); - else - error ("Malformed Unicode escape: \\u%x", i); - } + error ("Malformed Unicode escape: \\%c%x", + unicode_hex_count == 4 ? 'u' : 'U', i); /* `isdigit' and `isalpha' may be locale-specific, which we don't want. */ int digit = char_hexdigit (c); @@ -2831,7 +2813,8 @@ read_escape (Lisp_Object readcharfun, bool stringp) } if (i > 0x10FFFF) error ("Non-Unicode character: 0x%x", i); - return i; + c = i; + break; } case 'N': @@ -2880,12 +2863,31 @@ read_escape (Lisp_Object readcharfun, bool stringp) /* character_name_to_code can invoke read0, recursively. This is why read0's buffer is not static. */ - return character_name_to_code (name, length, readcharfun); + c = character_name_to_code (name, length, readcharfun); + break; } + } - default: - return c; + c |= modifiers; + if (c & ctrl_modifier) + { + int b = c & ~CHAR_MODIFIER_MASK; + /* If the base char is in the 0x3f..0x5f range or a lower case + letter, drop the ctrl_modifier bit and generate a C0 control + character instead. */ + if ((b >= 0x3f && b <= 0x5f) || (b >= 'a' && b <= 'z')) + { + c &= ~ctrl_modifier; + if (b == '?') + /* Special case: ^? is DEL. */ + b = 127; + else + /* Make a C0 control in 0..31 by clearing bits 5 and 6. */ + b &= 0x1f; + } + c = b | (c & CHAR_MODIFIER_MASK); } + return c; } /* Return the digit that CHARACTER stands for in the given BASE. @@ -3012,7 +3014,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; @@ -3066,14 +3068,21 @@ 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) + ch = READCHAR; + switch (ch) { + case 's': + ch = ' '; + break; + case ' ': + case '\n': if (p == read_buffer) cancel = true; continue; + default: + UNREAD (ch); + ch = read_escape (readcharfun); + break; } int modifiers = ch & CHAR_MODIFIER_MASK; @@ -3085,19 +3094,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..59d5ca076f 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -317,4 +317,14 @@ literals (Bug#20852)." (should (equal (read-from-string "#_") '(## . 2)))) +(ert-deftest lread-misc-2 () + ;; ?\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))) + ;; The Control modifier constructs should be idempotent. + (should (equal ?\C-\C-x ?\C-x)) + (should (equal ?\^\^x ?\C-x)) + (should (equal ?\C-\^x ?\C-x)) + (should (equal ?\^\C-x ?\C-x))) + ;;; lread-tests.el ends here commit 84e122dc9676f1bcf36db62f313b0343a073982b Author: Michael Albinus Date: Wed Jun 1 18:36:35 2022 +0200 Make files-tests.el more robust * test/lisp/files-tests.el (files-tests--with-temp-non-special) (files-tests--with-temp-non-special-and-file-name-handler): Make it more robust wrt parallel test jobs. (Bug#55706) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 978f96912f..c7ce03cc9b 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -393,6 +393,8 @@ After evaluating BODY, the temporary file or directory is deleted." (cl-check-type name symbol) (cl-check-type non-special-name symbol) `(let* ((temporary-file-directory (file-truename temporary-file-directory)) + (temporary-file-directory + (file-name-as-directory (make-temp-file "files-tests" t))) (,name (make-temp-file "files-tests" ,dir-flag)) (,non-special-name (file-name-quote ,name))) (unwind-protect @@ -402,7 +404,9 @@ After evaluating BODY, the temporary file or directory is deleted." (delete-file ,name))) (when (file-exists-p ,non-special-name) (if ,dir-flag (delete-directory ,non-special-name t) - (delete-file ,non-special-name)))))) + (delete-file ,non-special-name))) + (when (file-exists-p temporary-file-directory) + (delete-directory temporary-file-directory t))))) (defconst files-tests--special-file-name-extension ".special" "Trailing string for test file name handler.") @@ -444,14 +448,16 @@ unquoted file names." (cl-check-type name symbol) (cl-check-type non-special-name symbol) `(let* ((temporary-file-directory (file-truename temporary-file-directory)) + (temporary-file-directory + (file-name-as-directory (make-temp-file "files-tests" t))) (file-name-handler-alist `((,files-tests--special-file-name-regexp . files-tests--special-file-name-handler) . ,file-name-handler-alist)) - (,name (concat + (,name (concat (make-temp-file "files-tests" ,dir-flag) files-tests--special-file-name-extension)) - (,non-special-name (file-name-quote ,name))) + (,non-special-name (file-name-quote ,name))) (unwind-protect (progn ,@body) (when (file-exists-p ,name) @@ -459,7 +465,9 @@ unquoted file names." (delete-file ,name))) (when (file-exists-p ,non-special-name) (if ,dir-flag (delete-directory ,non-special-name t) - (delete-file ,non-special-name)))))) + (delete-file ,non-special-name))) + (when (file-exists-p temporary-file-directory) + (delete-directory temporary-file-directory t))))) (defun files-tests--new-name (name part) (let (file-name-handler-alist) commit db214ae66ceac52ced201e8729a6d026f0518341 Author: Visuwesh Date: Sun May 29 11:45:19 2022 +0530 delete-selection-mode: Add user option to delete temporary regions only * lisp/delsel.el (delete-selection-temporary-region): Add new user option. (delete-selection-pre-hook): Respect it. * doc/emacs/mark.texi (Using Region): Document the new user option. * etc/NEWS: Announce the new user option. (bug#55692) diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 91c44d527b..ad25ed6a8a 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -291,12 +291,23 @@ instead signal an error if the mark is inactive. @cindex Delete Selection mode @cindex mode, Delete Selection @findex delete-selection-mode +@vindex delete-selection-temporary-region By default, text insertion occurs normally even if the mark is active---for example, typing @kbd{a} inserts the character @samp{a}, then deactivates the mark. Delete Selection mode, a minor mode, modifies this behavior: if you enable that mode, then inserting text while the mark is active causes the text in the region to be deleted -first. To toggle Delete Selection mode on or off, type @kbd{M-x +first. However, you can tune this behavior by customizing the +@code{delete-selection-temporary-region} option. Its default value is +@code{nil}, but you can set it to @code{t}, in which case only +temporarily-active regions will be replaced: those which are set by +dragging the mouse (@pxref{Setting Mark}) or by shift-selection +(@pxref{Shift Selection}), as well as by @kbd{C-u C-x C-x} when +Transient Mark Mode is disabled. You can further tune the behavior by +setting @code{delete-selection-temporary-region} to @code{selection}: +then temporary regions by @kbd{C-u C-x C-x} won't be replaced, only +the ones activated by dragging the mouse or shift-selection. To +toggle Delete Selection mode on or off, type @kbd{M-x delete-selection-mode}. @node Mark Ring diff --git a/etc/NEWS b/etc/NEWS index 4d68f066fc..71c19c06b4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -271,6 +271,11 @@ startup. Previously, these functions ignored * Changes in Emacs 29.1 ++++ +** New user option 'delete-selection-temporary-region'. +When non-nil, 'delete-selection-mode' will only delete the temporary +regions (usually set by mouse-dragging or shift-selection). + +++ ** New user option 'switch-to-prev-buffer-skip-regexp'. This should be a regexp or a list of regexps; buffers whose names diff --git a/lisp/delsel.el b/lisp/delsel.el index f5fe7cf793..c9d3cf269b 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -64,6 +64,19 @@ "If non-nil, deleted region text is stored in this register. Value must be the register (key) to use.") +(defcustom delete-selection-temporary-region nil + "Whether to delete only temporary regions. +When non-nil, typed text replaces only the regions set by +mouse-dragging, shift-selection, and \"\\[universal-argument] \\[exchange-point-and-mark]\" when +`transient-mark-mode' is turned off. If the value is the symbol +`selection', then replace only the regions set by mouse-dragging +and shift-selection." + :version "29.1" + :group 'editing-basics + :type '(choice (const :tag "Replace all regions" nil) + (const :tag "Replace region from mouse, shift-selection, and \"C-u C-x C-x\"" t) + (const :tag "Replace region from mouse and shift-selection" selection))) + ;;;###autoload (defalias 'pending-delete-mode 'delete-selection-mode) @@ -251,7 +264,13 @@ property on their symbol; commands which insert text but don't have this property won't delete the selection. See `delete-selection-helper'." (when (and delete-selection-mode (use-region-p) - (not buffer-read-only)) + (not buffer-read-only) + (or (null delete-selection-temporary-region) + (and delete-selection-temporary-region + (consp transient-mark-mode) + (eq (car transient-mark-mode) 'only)) + (and (not (eq delete-selection-temporary-region 'selection)) + (eq transient-mark-mode 'lambda)))) (delete-selection-helper (and (symbolp this-command) (get this-command 'delete-selection))))) commit ce847d3a7e30bc1ee418309f1fafeedd9d269735 Author: Lars Ingebrigtsen Date: Wed Jun 1 17:53:29 2022 +0200 Add a comment to lisp/Makefile.in * lisp/Makefile.in: Add FIXME comment. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 0156b53ac6..040b9a4ca3 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -176,6 +176,9 @@ org-manuals: main-first # gets created before the final emacs is dumped. Having leim # dependencies in ../src as well would create a parallel race condition. # +# FIXME: 2) is no longer correct, so perhaps we could add unidata to +# gen-lisp now? +# # 2) Files that are marked no-update-autoloads still get recorded in loaddefs. # So those files should be generated before we make autoloads, if we # don't want a successive make autoloads to change the output file. commit fccde521585c708a9108517204b3e9a88c25ab2f Author: Manuel Giraud Date: Wed Jun 1 17:32:28 2022 +0200 Place bookmarks without last-modified at the end * lisp/bookmark.el (bookmark-sort-flag): Typo fix in doc string. (bookmark-maybe-sort-alist): Fix sorting when there's no last modified. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 8e251e9de8..849303fac7 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -120,7 +120,7 @@ nil means they will be displayed in LIFO order (that is, most recently created ones come first, oldest ones come last). `last-modified' means that bookmarks will be displayed sorted -from most recently set to last recently set. +from most recently set to least recently set. Other values means that bookmarks will be displayed sorted by bookmark name." @@ -520,8 +520,11 @@ is ordered from most recently created to least recently created bookmark." (sort copy (lambda (x y) (string-lessp (car x) (car y))))) ((eq bookmark-sort-flag 'last-modified) (sort copy (lambda (x y) - (time-less-p (bookmark-get-last-modified y) - (bookmark-get-last-modified x))))) + (let ((tx (bookmark-get-last-modified x)) + (ty (bookmark-get-last-modified y))) + (cond ((null tx) nil) + ((null ty) t) + (t (time-less-p ty tx))))))) (t copy)))) (defun bookmark-completing-read (prompt &optional default) commit 88b88c08a2ab23ac666bec8c9063cc75a9ed43a9 Author: Po Lu Date: Wed Jun 1 22:00:44 2022 +0800 Improve documentation of Lisp-level drag-and-drop features * doc/lispref/frames.texi (Drag and Drop): Don't conflate X Windows specific implementation details with general drag-and-drop functionality, document what `dnd-protocol-alist' actually means, and improve documentation on DND data types. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 13bd144115..a2a74f8148 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4036,16 +4036,46 @@ amount of different data types on the clipboard. @section Drag and Drop @cindex drag and drop + When the user drops something from another application over Emacs, +Emacs will try to insert any text and open any URL that was dropped. +If text was dropped, then it will always be inserted at the location +of the mouse pointer when the drop happened, or saved in the kill ring +if insertion failed (which can happen if the buffer is read-only). If +it was an URL, then Emacs tries to call an appropriate handler +function by first matching the URL against regexps defined in +@code{dnd-protocol-alist}, and then against @code{browse-url-handlers} +and @code{browse-url-default-handlers}, and failing that, inserting +the URL as plain text. + +@defvar dnd-protocol-alist + This variable is a list of cons cells of the form +@w{@code{(@var{pattern} . @var{action})}}. @var{pattern} is a regexp +that URLs are matched against after being dropped. @var{action} is a +function that is called with two arguments should a URL being dropped +match @var{pattern}: the URL being dropped, and the action being +performed for the drop (one of the symbols @code{copy}, @code{move}, +@code{link}, @code{private} or @code{ask}). +@end defvar + +@cindex drag and drop, X +@cindex drag and drop, other formats + Emacs implements drag-and-drop for text and URLs individually for +each window system, and does not by default support the dropping of +anything else. Code that wishes to support the dropping of content +types not supported by Emacs can utilize the X-specific interface +described below: + @vindex x-dnd-test-function @vindex x-dnd-known-types - When a user drags something from another application over Emacs, that other -application expects Emacs to tell it if Emacs can handle the data that is -dragged. The variable @code{x-dnd-test-function} is used by Emacs to determine -what to reply. The default value is @code{x-dnd-default-test-function} -which accepts drops if the type of the data to be dropped is present in -@code{x-dnd-known-types}. You can customize @code{x-dnd-test-function} and/or -@code{x-dnd-known-types} if you want Emacs to accept or reject drops based -on some other criteria. + When a user drags something from another application over Emacs on +the X Window System, that other application expects Emacs to tell it +if Emacs can handle the data that was dragged. The variable +@code{x-dnd-test-function} is used by Emacs to determine what to +reply. The default value is @code{x-dnd-default-test-function} which +accepts drops if the type of the data to be dropped is present in +@code{x-dnd-known-types}. You can customize +@code{x-dnd-test-function} and/or @code{x-dnd-known-types} if you want +Emacs to accept or reject drops based on some other criteria. @vindex x-dnd-types-alist If you want to change the way Emacs handles drop of different types @@ -4053,16 +4083,12 @@ or add a new type, customize @code{x-dnd-types-alist}. This requires detailed knowledge of what types other applications use for drag and drop. -@vindex dnd-protocol-alist -@vindex browse-url-handlers -@vindex browse-url-default-handlers - When an URL is dropped on Emacs it may be a file, but it may also be -another URL type (https, etc.). Emacs first checks -@code{dnd-protocol-alist} to determine what to do with the URL@. If -there is no match there, Emacs looks for a match in -@code{browse-url-handlers} and @code{browse-url-default-handlers}. If -still no match has been found, the text for the URL is inserted. If -you want to alter Emacs behavior, you can customize these variables. + Those data types are typically implemented as special data types an +X selection provided by the other application can be converted to. +They can either be the same data types that are typically accepted by +@code{gui-set-selection}, or they can be MIME types, depending on the +specific drag-n-drop protocol being used. Plain text may be +@code{"STRING"} or @code{"text/plain"}, for example. @cindex initiating drag-and-drop On capable window systems, Emacs also supports dragging contents commit 59910c320a8e786ccb53b2dff6dac47caaff3527 Author: Stefan Kangas Date: Tue May 31 15:20:44 2022 +0200 Make XEmacs compat code in gamegrid.el obsolete * lisp/play/gamegrid.el (gamegrid-make-glyph): Warn on using obsolete XEmacs style glyph. (This is currently unused in the Emacs tree.) (gamegrid-make-image-from-vector): Make obsolete. diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 256b4e19ce..55c9244f2e 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -343,11 +343,17 @@ format." (gamegrid-colorize-glyph color)) ((listp data) (find-image data)) ;untested! - ((vectorp data) - (gamegrid-make-image-from-vector data))))) + ;; Remove when `gamegrid-make-image-from-vector' is removed: + ((vectorp data) + (lwarn 'gamegrid :warning + "Using obsolete XEmacs style \"glyph\"; \ +convert to an Emacs image-spec instead") + (with-suppressed-warnings ((obsolete gamegrid-make-image-from-vector)) + (gamegrid-make-image-from-vector data)))))) (defun gamegrid-make-image-from-vector (vect) "Convert an XEmacs style \"glyph\" to an image-spec." + (declare (obsolete nil "29.1")) (let ((l (list 'image :type))) (dotimes (n (length vect)) (setf l (nconc l (list (aref vect n))))) commit 65ffb115b4ad42fc5881a0f2fdcba5b8a3561b28 Author: Po Lu Date: Wed Jun 1 21:28:26 2022 +0800 ; * src/xterm.c (x_wait_for_cell_change): Don't call ConnectionNumber twice. diff --git a/src/xterm.c b/src/xterm.c index 214419a336..7234e7c758 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14912,7 +14912,7 @@ x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) maxfd = fd; eassert (fd < FD_SETSIZE); - FD_SET (XConnectionNumber (dpyinfo->display), &fds); + FD_SET (fd, &fds); } /* Prevent events from being lost (from GTK's point of view) by commit 67ce5fdcc86fd1a5cdd5cfc859d0bce9c3af24ee Author: Lars Ingebrigtsen Date: Wed Jun 1 14:55:31 2022 +0200 Ensure that loaddefs-gen.elc is build before loaddefs.el is generated * lisp/Makefile.in ($(lisp)/loaddefs.el): Make loaddefs.el depend on loaddefs-gen.elc to ensure that it's built. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index f1ca92ab9a..0156b53ac6 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -198,7 +198,7 @@ org-manuals: main-first # loaddefs-generate-batch. autoloads .PHONY: $(lisp)/loaddefs.el -$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) +$(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} commit 873bcd6d5d1d571caa3aa355fef2c9a987ebb4ca Author: Po Lu Date: Wed Jun 1 20:52:00 2022 +0800 Minor fixes to x_next_event_from_any_display * src/xterm.c (x_next_event_from_any_display): Don't call XPending unless there is input to be read on the connection, and don't call ConnectionNumber twice. diff --git a/src/xterm.c b/src/xterm.c index 484637807a..214419a336 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10292,8 +10292,11 @@ static void x_next_event_from_any_display (XEvent *event) { struct x_display_info *dpyinfo; - fd_set fds; - int fd, maxfd; + fd_set fds, rfds; + int fd, maxfd, rc; + + rc = 0; + FD_ZERO (&rfds); while (true) { @@ -10303,27 +10306,31 @@ x_next_event_from_any_display (XEvent *event) for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) { - if (XPending (dpyinfo->display)) + fd = ConnectionNumber (dpyinfo->display); + + if ((rc < 0 || FD_ISSET (fd, &rfds)) + && XPending (dpyinfo->display)) { XNextEvent (dpyinfo->display, event); return; } - fd = XConnectionNumber (dpyinfo->display); - if (fd > maxfd) maxfd = fd; eassert (fd < FD_SETSIZE); - FD_SET (XConnectionNumber (dpyinfo->display), &fds); + FD_SET (fd, &fds); } eassert (maxfd >= 0); - /* We don't have to check the return of pselect, because if an + /* Continue to read input even if pselect fails, because if an error occurs XPending will call the IO error handler, which then brings us out of this loop. */ - pselect (maxfd + 1, &fds, NULL, NULL, NULL, NULL); + rc = pselect (maxfd + 1, &fds, NULL, NULL, NULL, NULL); + + if (rc >= 0) + rfds = fds; } } commit c791a3e9f3d48376e0c1d50e9e2648def494d635 Author: Lars Ingebrigtsen Date: Wed Jun 1 14:50:16 2022 +0200 Fix up the loaddefs-gen updating logic * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Only do the updating logic if we're really updating. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index d6504f798a..e5a5c21d23 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -543,7 +543,7 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (dolist (fdefs (seq-group-by #'car defs)) (let ((loaddefs-file (car fdefs))) (with-temp-buffer - (if (file-exists-p loaddefs-file) + (if (and updating (file-exists-p loaddefs-file)) (insert-file-contents loaddefs-file) (insert (loaddefs-generate--rubric loaddefs-file nil t)) (search-backward "\f") commit 45e65c7d92e195102a203cb738707d12581c3c2e Author: Lars Ingebrigtsen Date: Wed Jun 1 14:14:02 2022 +0200 Revert "Fix loaddefs generation" This reverts commit 28358db93007456a1e0a6d9118823d4ddea4ba39. This has been fixed in a different way. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 63b3fd13d7..d6504f798a 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -575,7 +575,7 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (search-backward "\f\n")) ;; Delete the old version of the section. (delete-region (match-beginning 0) - (and (search-forward "\n\f\n;;;" nil t) + (and (search-forward "\n\f\n;;;") (match-beginning 0))) (forward-line -2))) (insert head) commit c95827c69888440df5e25ae77aed103203f2fb27 Author: समीर सिंह Sameer Singh Date: Tue May 31 19:37:34 2022 +0530 Add support for the Hanifi Rohingya script (bug#55745) * lisp/language/misc-lang.el ("Hanifi Rohingya"): New language environment. Add composition rules for Hanifi Rohingya. Add sample text and input method. * lisp/international/fontset.el (script-representative-chars) (setup-default-fontset): Support Hanifi Rohingya. * lisp/leim/quail/misc-lang.el ("hanifi-rohingya"): New input method. * etc/HELLO: Add a Hanifi Rohingya greeting. * etc/NEWS: Announce the new language environment. diff --git a/etc/HELLO b/etc/HELLO index f63f65ff7d..4148183949 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -60,6 +60,7 @@ Greek (ελληνικά) Γειά σας Greek, ancient (ἑλληνική) Οὖλέ τε καὶ μέγα χαῖρε Gujarati (ગુજરાતી) નમસ્તે Gurmukhi (ਗੁਰਮੁਖੀ) ਸਤ ਸ੍ਰੀ ਅਕਾਲ +Hanifi Rohingya (𐴌𐴟𐴇𐴥𐴝𐴚𐴒𐴙𐴝 𐴇𐴝𐴕𐴞𐴉𐴞 𐴓𐴠𐴑𐴤𐴝) 𐴀𐴝𐴏𐴓𐴝𐴀𐴡𐴤𐴛𐴝𐴓𐴝𐴙𐴑𐴟𐴔 Hanunoo (ᜱᜨᜳᜨᜳᜢ) ᜫᜬᜧ᜴ ᜣᜭᜯᜥ᜴ ᜰᜲᜭᜥ᜴ Hebrew (עִבְרִית) שָׁלוֹם Hindi (हिन्दी) प्रणाम / पाय लागू diff --git a/etc/NEWS b/etc/NEWS index 1233e245a0..4d68f066fc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -840,6 +840,7 @@ corresponding language environments are: **** Rejang script and language environment **** Makasar script and language environment **** Lontara script and language environment +**** Hanifi Rohingya script and language environment --- *** The "Oriya" language environment was renamed to "Odia". diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 425e9dcb41..2c54c86ab7 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -237,7 +237,7 @@ (lydian #x10920) (kharoshthi #x10A00) (manichaean #x10AC0) - (hanifi-rohingya #x10D00) + (hanifi-rohingya #x10D00 #x10D24 #x10D39) (yezidi #x10E80) (old-sogdian #x10F00) (sogdian #x10F30) @@ -791,6 +791,7 @@ cypriot-syllabary phoenician lydian + hanifi-rohingya yezidi kharoshthi manichaean diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index c8a4821abf..46429a4380 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -212,6 +212,28 @@ thin (i.e. 1-dot width) space." (list (vector "[\U00013000-\U0001342E]+" 0 #'font-shape-gstring)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hanifi Rohingya +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(set-language-info-alist + "Hanifi Rohingya" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "hanifi-rohingya") + (sample-text . "Hanifi Rohingya (𐴌𐴟𐴇𐴥𐴝𐴚𐴒𐴙𐴝 𐴇𐴝𐴕𐴞𐴉𐴞 𐴓𐴠𐴑𐴤𐴝) 𐴀𐴝𐴏𐴓𐴝𐴀𐴡𐴤𐴛𐴝𐴓𐴝𐴙𐴑𐴟𐴔") + (documentation . "\ +Rohingya language and its script Hanifi Rohingya are supported +in this language environment."))) + +;; Hanifi Rohingya composition rules +(set-char-table-range + composition-function-table + '(#x10D1D . #x10D27) + (list (vector + "[\x10D00-\x10D27]+" + 1 'font-shape-gstring))) + (provide 'misc-lang) ;;; misc-lang.el ends here diff --git a/lisp/leim/quail/misc-lang.el b/lisp/leim/quail/misc-lang.el new file mode 100644 index 0000000000..bdb86ab528 --- /dev/null +++ b/lisp/leim/quail/misc-lang.el @@ -0,0 +1,101 @@ +;;; misc-lang.el --- Quail package for inputting Miscellaneous characters -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: समीर सिंह Sameer Singh +;; Keywords: multilingual, input method, i18n, Miscellaneous + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Input methods for Miscellaneous languages. + +;;; Code: + +(require 'quail) + +(quail-define-package + "hanifi-rohingya" "Hanifi Rohingya" "𐴌𐴟" t "Hanifi Rohingya phonetic input method. + + `\\=`' is used to switch levels instead of Alt-Gr. +" nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("1" ?𐴱) + ("`1" ?1) + ("2" ?𐴲) + ("`2" ?2) + ("3" ?𐴳) + ("`3" ?3) + ("4" ?𐴴) + ("`4" ?4) + ("5" ?𐴵) + ("`5" ?5) + ("6" ?𐴶) + ("`6" ?6) + ("7" ?𐴷) + ("`7" ?7) + ("8" ?𐴸) + ("`8" ?8) + ("9" ?𐴹) + ("`9" ?9) + ("0" ?𐴰) + ("`0" ?0) + ("q" ?𐴄) + ("w" ?𐴋) + ("W" ?𐴍) + ("e" ?𐴠) + ("E" ?𐴤) + ("r" ?𐴌) + ("R" ?𐴥) + ("t" ?𐴃) + ("T" ?𐴦) + ("y" ?𐴘) + ("Y" ?𐴙) + ("u" ?𐴟) + ("U" ?𐴧) + ("i" ?𐴞) + ("o" ?𐴡) + ("p" ?𐴂) + ("a" ?𐴀) + ("A" ?𐴝) + ("s" ?𐴏) + ("S" ?𐴐) + ("d" ?𐴊) + ("f" ?𐴉) + ("F" ?𐴢) + ("g" ?𐴒) + ("h" ?𐴇) + ("j" ?𐴅) + ("k" ?𐴑) + ("K" ?𐴈) + ("l" ?𐴓) + ("z" ?𐴎) + ("c" ?𐴆) + ("C" #x200C) ; ZWNJ + ("v" ?𐴖) + ("V" ?𐴗) + ("`v" ?𐴜) + ("b" ?𐴁) + ("n" ?𐴕) + ("N" ?𐴚) + ("`n" ?𐴛) + ("`N" ?𐴣) + ("m" ?𐴔)) + +(provide 'misc-lang) +;;; misc-lang.el ends here commit 21dba5b36439b493652f7ac7d5a7d2d713ad9947 Author: Lars Ingebrigtsen Date: Wed Jun 1 13:10:30 2022 +0200 Start the org -> texi conversion while doing byte compilation * lisp/Makefile.in (MAIN_FIRST): Compile stuff needed for org -> texi generation. (all): Add org-manuals. (org-manuals): Start org -> texi conversion while we're doing byte compilation to make things more parallel. This shaves off about ten seconds of a "make -j8" build. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 5f9ca01694..f1ca92ab9a 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -95,10 +95,13 @@ COMPILE_FIRST += $(lisp)/emacs-lisp/radix-tree.elc # Files to compile early in compile-main. Works around bug#25556. # Also compile the ja-dic file used to convert the Japanese dictionary -# to speed things up. +# to speed things up. The org files are used to convert org files to +# texi files. MAIN_FIRST = ./emacs-lisp/eieio.el ./emacs-lisp/eieio-base.el \ ./cedet/semantic/db.el ./emacs-lisp/cconv.el \ - ./international/ja-dic-cnv.el + ./international/ja-dic-cnv.el \ + ./org/ox.el ./org/ox-texinfo.el ./org/org-macro.el ./org/org-element.el \ + ./org/oc.el ./org/ol.el ./emacs-lisp/cl-lib.el # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH @@ -121,11 +124,12 @@ SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS}) # cus-load and finder-inf are not explicitly requested by anything, so # we add them here to make sure they get built. -all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el generate-ja-dic +all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el generate-ja-dic \ + org-manuals PHONY_EXTRAS = .PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) \ - generate-ja-dic + generate-ja-dic org-manuals # custom-deps and finder-data both used to scan _all_ the *.el files. # This could lead to problems in parallel builds if automatically @@ -161,6 +165,9 @@ generate-ja-dic: main-first $(AM_V_at)$(MAKE) -C ../leim generate-ja-dic EMACS="$(EMACS)" $(AM_V_at)$(MAKE) compile-targets TARGETS="./leim/ja-dic/ja-dic.elc" +org-manuals: main-first + $(AM_V_at)$(MAKE) -C ../doc/misc org.texi modus-themes.texi + ## Comments on loaddefs generation: # loaddefs depends on gen-lisp for two reasons: commit e3ec91232fcdd4d7fe2c48fcdb78b4ac7c6356d5 Author: Protesilaos Stavrou Date: Wed Jun 1 14:05:49 2022 +0300 Update modus-themes to their latest version * admin/MAINTAINERS: Update link to the Git repository of the modus-themes; point to the new mailing list; include command for sending a bug report. * doc/misc/modus-themes.org (Install from the archives): Minor rewording. (Dealing with byte compilation errors): Clarify that occasional bugs are not always a fault of the themes. (Custom hl-todo colors): Add note about package.:(Full support for packages or face groups, Indirectly covered packages): Update lists of supported packages. (Note on avy hints): Remove obsolete node. (Note on git-gutter in Doom Emacs): Note problem with custom bitmaps, which is not the fault of the themes. (Note on display-fill-column-indicator-mode): Show how to use a thicker indicator.:(Why are colors mostly variants of blue, magenta, cyan?): Minor rewording. (Sources of the themes): Update official theme sources. (Issues you can help with) (Patches require copyright assignment to the FSF): Update the information on potential contributions. (Acknowledgements): Update list of contributors in the form of code or ideas/feedback. (Meta, Other notes about the project): Rename section and include more links to development-related blog posts. * etc/themes/modus-themes.el (seq): Stop requiring 'seq'. (modus-themes--version): Use internal variable for the themes' version. (modus-themes-operandi-colors, modus-themes-vivendi-colors): Make minor tweaks to the color palettes. (modus-themes-variable-pitch): Remove obsolete symbol from doc string. (modus-themes--alist-or-seq): Update function to not rely on 'seq'. (modus-themes--current-theme): Make stylistic tweaks. (modus-themes--markup): Use correct order of inheritance for faces. (modus-themes--paren, modus-themes--heading) (modus-themes--agenda-structure, modus-themes--agenda-date) (modus-themes--agenda-habit, modus-themes--mode-line-attrs) (modus-themes--mode-line-padded-box, modus-themes--button): Update to use 'modus-themes--property-lookup' instead of the previous function that depended on 'seq'. (modus-themes--diff): Make it combine as expected with the user option 'modus-themes-deuteranopia'. (modus-themes-faces): Update list of faces. (modus-themes-custom-variables): Expand support for face rotation in 'highlight-changes'. * etc/themes/modus-operandi-theme.el: * etc/themes/modus-vivendi-theme.el: Bump version number to 2.4.1. Release notes: . diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 2760a9a42b..f0239db008 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -305,7 +305,9 @@ Tramp Modus themes Maintainer: Protesilaos Stavrou - Repository and issue tracker: https://gitlab.com/protesilaos/modus-themes + Repository: https://git.sr.ht/~protesilaos + Mailing list: https://lists.sr.ht/~protesilaos/modus-themes + Bug Reports: M-x modus-themes-report-bug doc/misc/modus-themes.org etc/themes/modus*.el diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 42ad3ee35f..7b566f51c2 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -5,9 +5,9 @@ #+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 2.3.0 -#+macro: release-date 2022-04-01 -#+macro: development-version 2.4.0-dev +#+macro: stable-version 2.4.0 +#+macro: release-date 2022-06-01 +#+macro: development-version 2.5.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -34,6 +34,10 @@ explicitly marked as such. Current development target is {{{development-version}}}. ++ Homepage: https://protesilaos.com/emacs/modus-themes. ++ Git repository: https://git.sr.ht/~protesilaos/modus-themes. ++ Mailing list: https://lists.sr.ht/~protesilaos/modus-themes. + #+toc: headlines 8 insert TOC here, with eight headline levels * COPYING @@ -165,14 +169,10 @@ The themes are now ready to be used: [[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][ The ~modus-themes~ package is available from the GNU ELPA archive, which is configured by default. -Prior to querying any package archive, make sure to have updated the -index, with {{{kbd(M-x package-refresh-contents)}}}. Then all you need to do +Prior to querying any package archive, make sure to update the index, +with {{{kbd(M-x package-refresh-contents)}}}. Then all you need to do is type {{{kbd(M-x package-install)}}} and specify the ~modus-themes~. -Note that older versions of the themes used to be distributed as -standalone packages. This practice has been discontinued starting with -version 1.0.0 of this project. - Once installed, the themes are ready to be used: [[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]. ** Install on GNU/Linux @@ -211,6 +211,34 @@ guix package -i emacs-modus-themes They are now ready to be used: [[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]. +** Dealing with byte compilation errors +:properties: +:custom_id: h:e6268471-e847-4c9d-998f-49a83257b7f1 +:end: + +From time to time, we receive bug reports pertaining to errors with byte +compilation. These seldom have to do with faulty code in the themes: it +might be a shortcoming of =package.el=, some regression in the current +development target of Emacs, a misconfiguration in an otherwise exotic +setup, and the like. + +The common solution with a stable version of Emacs is to: + +1. Delete the =modus-themes= package. +2. Close the current Emacs session. +3. Install the =modus-themes= again. + +For those building Emacs directly from source, the solution may involve +reverting to an earlier commit in emacs.git. + +At any rate, if you encounter such an issue please report it: we will +either fix the bug on our end if it is truly ours, or help forward it to +the relevant upstream maintainer. Whatever you do, please understand +that a build failure does not mean we are necessarily doing something +wrong. + +[[#h:6536c8d5-3f98-43ab-a787-b94120e735e8][Issues you can help with]]. + * Enable and load :properties: :custom_id: h:3f3c3728-1b34-437d-9d0c-b110f5b161a9 @@ -4053,6 +4081,44 @@ comments are gray. Regexp constructs are adapted accordingly. (set-face-attribute 'font-lock-warning-face nil :inherit 'modus-themes-bold :foreground red-nuanced-fg))) #+end_src +** Custom hl-todo colors +:PROPERTIES: +:CUSTOM_ID: h:2ef83a21-2f0a-441e-9634-473feb940743 +:END: + +The =hl-todo= package provides the user option ~hl-todo-keyword-faces~: +it specifies a pair of keyword and corresponding color value. The Modus +themes configure that option in the interest of legibility. While this +works for our purposes, users may still prefer to apply their custom +values, in which case the following approach is necessary: + +#+begin_src emacs-lisp +(defun my-modus-themes-hl-todo-faces () + (setq hl-todo-keyword-faces '(("TODO" . "#ff0000") + ("HACK" . "#ffff00") + ("XXX" . "#00ffff") + ("NOTE" . "#ff00ff")))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces) +#+end_src + +Or include a ~let~ form, if needed: + +#+begin_src emacs-lisp +(defun my-modus-themes-hl-todo-faces () + (let ((red "#ff0000") + (blue "#0000ff")) + (setq hl-todo-keyword-faces `(("TODO" . ,blue) + ("HACK" . ,red) + ("XXX" . ,red) + ("NOTE" . ,blue))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces) +#+end_src + +Normally, we do not touch user options, though this is an exception: +otherwise the defaults are not always legible. + * Face coverage :properties: :custom_id: h:a9c8f29d-7f72-4b54-b74b-ddefe15d6a19 @@ -4098,6 +4164,7 @@ have lots of extensions, so the "full support" may not be 100% true… + breakpoint (provided by the built-in {{{file(gdb-mi.el)}}} library) + calendar and diary + calfw ++ calibredb + centaur-tabs + cfrs + change-log and log-view (such as ~vc-print-log~, ~vc-print-root-log~) @@ -4112,6 +4179,7 @@ have lots of extensions, so the "full support" may not be 100% true… + completions + consult + corfu ++ corfu-quick + counsel* + counsel-css + cov @@ -4146,6 +4214,7 @@ have lots of extensions, so the "full support" may not be 100% true… + easy-jekyll + ebdb + ediff ++ ein (Emacs IPython Notebook) + eglot + el-search + eldoc-box @@ -4344,6 +4413,7 @@ have lots of extensions, so the "full support" may not be 100% true… + tomatinho + transient (pop-up windows such as Magit's) + trashed ++ tree-sitter + treemacs + tty-menu + tuareg @@ -4357,6 +4427,7 @@ have lots of extensions, so the "full support" may not be 100% true… + visible-mark + visual-regexp + vterm ++ vundo + wcheck-mode + web-mode + wgrep @@ -4398,6 +4469,7 @@ supported by the themes. + dtache + easy-kill + edit-indirect ++ egerrit + elfeed-summary + evil-owl + flyspell-correct @@ -4432,40 +4504,6 @@ supported by the themes. This section covers information that may be of interest to users of individual packages. -** Note on avy hints -:properties: -:custom_id: h:2fdce705-6de7-44e6-ab7f-18f59af99e01 -:end: - -Hints can appear everywhere, in wildly varying contexts, hence, their -appearance, by necessity, is a compromise. However, there are various -options for making them stand out. First is dimming the surroundings: - -#+begin_src emacs-lisp -(setq avy-background t) -#+end_src - -Dimming works well when you find it difficult to spot hints, any hint. -Second is limiting the number of faces used by hints: - -#+begin_src emacs-lisp -(setq avy-lead-faces - '(avy-lead-face - avy-lead-face-1 - avy-lead-face-1 - avy-lead-face-1 - avy-lead-face-1)) -#+end_src - -Limiting the number of faces works well with longer hints when you find -it difficult to identify individual hints, especially with hints -touching each other. The first character of the hint will have an -intense color, the remaining ones the same neutral color. - -Third is preferring commands that produce fewer candidates. Fewer hints -is less noise: ~avy-goto-char-timer~ is an excellent alternative to -~avy-goto-char~. - ** Note on calendar.el weekday and weekend colors :properties: :custom_id: h:b2db46fb-32f4-44fd-8e11-d2b261cf51ae @@ -4495,6 +4533,72 @@ weekends uniformly. For changes to take effect, the Calendar buffer needs to be generated anew. +** Note on git-gutter in Doom Emacs +:PROPERTIES: +:CUSTOM_ID: h:a195e37c-e58c-4148-b254-8ba1ed8a731a +:END: + +The =git-gutter= and =git-gutter-fr= packages default to drawing bitmaps +for the indicators they display (e.g. bitmap of a plus sign for added +lines). In Doom Emacs, these bitmaps are replaced with contiguous lines +which may look nicer, but require a change to the foreground of the +relevant faces to yield the desired colour combinations. + +Since this is Doom-specific, we urge users to apply changes in their +local setup. Below is some sample code, based on what we cover at +length elsewhere in this manual: + +[[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]. + +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (modus-themes-with-colors + (custom-set-faces + ;; Replace green with blue if you use `modus-themes-deuteranopia'. + `(git-gutter-fr:added ((,class :foreground ,green-fringe-bg))) + `(git-gutter-fr:deleted ((,class :foreground ,red-fringe-bg))) + `(git-gutter-fr:modified ((,class :foreground ,yellow-fringe-bg)))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +#+end_src + +If the above does not work, try this instead: + +#+begin_src emacs-lisp +(after! modus-themes + (modus-themes-with-colors + (custom-set-faces + ;; Replace green with blue if you use `modus-themes-deuteranopia'. + `(git-gutter-fr:added ((,class :foreground ,green-fringe-bg))) + `(git-gutter-fr:deleted ((,class :foreground ,red-fringe-bg))) + `(git-gutter-fr:modified ((,class :foreground ,yellow-fringe-bg)))))) +#+end_src + +Replace ~green-fringe-bg~ with ~blue-fringe-bg~ if you want to optimize +for red-green color deficiency. + +[[#h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe][Option for red-green color deficiency or deuteranopia]]. + +** Note on php-mode multiline comments +:PROPERTIES: +:CUSTOM_ID: h:d0a3157b-9c04-46e8-8742-5fb2a7ae8798 +:END: + +Depending on your build of Emacs and/or the environment it runs in, +multiline comments in PHP with the =php-mode= package use the +~font-lock-doc-face~ instead of ~font-lock-comment-face~. + +This seems to make all comments use the appropriate face: + +#+begin_src emacs-lisp +(defun my-multine-comments () + (setq-local c-doc-face-name 'font-lock-comment-face)) + +(add-hook 'php-mode-hook #'my-multine-comments) +#+end_src + ** Note on underlines in compilation buffers :properties: :custom_id: h:420f5a33-c7a9-4112-9b04-eaf2cbad96bd @@ -4594,6 +4698,17 @@ elsewhere in this document. For example: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +To make the line thicker, set the height to be equal to the base font +size instead of the one pixel we use. This is done by specifying a rate +instead of an absolute number, as in =:height 1.0= versus =:height 1=. +For example: + +#+begin_src emacs-lisp +(modus-themes-with-colors + (custom-set-faces + `(fill-column-indicator ((,class :height 1.0 :background ,bg-inactive :foreground ,bg-inactive))))) +#+end_src + ** Note on highlight-parentheses.el :PROPERTIES: :CUSTOM_ID: h:24bab397-dcb2-421d-aa6e-ec5bd622b913 @@ -5271,8 +5386,8 @@ and hints of green give us suitable shades of purple. Due to the need of maintaining some difference in hueness between adjacent colors, it is not possible to make red, green, and yellow the -primary colors, because blue could not be used to control their -luminance and, thus the relevant space would shrink considerably. +main colors, because blue cannot be used to control their luminance and, +thus the relevant space will shrink considerably. [[#h:5ce7ae2e-9348-4e55-b4cf-9302345b1826][Is the contrast ratio about adjacent colors?]] @@ -5508,8 +5623,8 @@ in which you can contribute to their ongoing development. The ~modus-operandi~ and ~modus-vivendi~ themes are built into Emacs 28. -The source code of the themes is [[https://gitlab.com/protesilaos/modus-themes/][available on GitLab]], for the time -being. A [[https://github.com/protesilaos/modus-themes/][mirror on GitHub]] is also on offer. +The source code of the themes is [[https://git.sr.ht/~protesilaos/modus-themes][available on SourceHut]]. Or check the +[[https://gitlab.com/protesilaos/modus-themes/][GitLab mirror (former main source)]] and the [[https://github.com/protesilaos/modus-themes/][GitHub mirror]]. An HTML version of this manual is provided as an extension of the [[https://protesilaos.com/emacs/modus-themes/][author's personal website]] (does not rely on any non-free code). @@ -5520,7 +5635,10 @@ An HTML version of this manual is provided as an extension of the :end: #+cindex: Contributing -A few tasks you can help with: +#+findex: modus-themes-report-bug +A few tasks you can help with by sending an email to the general +[[https://lists.sr.ht/~protesilaos/modus-themes][modus-themes public mailing list]] (or use the command +~modus-themes-report-bug~). + Suggest refinements to packages that are covered. + Report packages not covered thus far. @@ -5528,7 +5646,8 @@ A few tasks you can help with: + Help expand the documentation of covered-but-not-styled packages. + Suggest refinements to the color palette. + Help expand this document or any other piece of documentation. -+ Merge requests for code refinements. ++ Send patches for code refinements (if you need, ask me for help with + Git---we all start out as beginners). [[#h:111773e2-f26f-4b68-8c4f-9794ca6b9633][Patches require copyright assignment to the FSF]]. @@ -5536,6 +5655,10 @@ It is preferable that your feedback includes some screenshots, GIFs, or short videos, as well as further instructions to reproduce a given setup. Though this is not a requirement. +#+findex: modus-themes-version +Also consider mentioning the version of the themes you are using, such +as by invoking the command ~modus-themes-version~. + Whatever you do, bear in mind the overarching objective of the Modus themes: to keep a contrast ratio that is greater or equal to 7:1 between background and foreground colors. If a compromise is ever necessary @@ -5567,7 +5690,7 @@ will send you the assignment form for your past and future changes. Please use your full legal name (in ASCII characters) as the subject line of the message. ----------------------------------------------------------------------- + REQUEST: SEND FORM FOR PAST AND FUTURE CHANGES [What is the name of the program or package you're contributing to?] @@ -5619,41 +5742,44 @@ The Modus themes are a collective effort. Every bit of work matters. Johansson, Basil L.{{{space()}}} Contovounesios, Björn Lindström, Carlo Zancanaro, Christian Tietze, Daniel Mendler, Eli Zaretskii, Fritz Grabo, Illia Ostapyshyn, Kévin Le Gouguec, Kostadin Ninev, - Madhavan Krishnan, Markus Beppler, Matthew Stevenson, Mauro Aranda, - Nicolas De Jaeghere, Philip Kaludercic, Pierre Téchoueyres, Rudolf - Adamkovič, Stephen Gildea, Shreyas Ragavan, Stefan Kangas, Utkarsh - Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie. + Madhavan Krishnan, Manuel Giraud, Markus Beppler, Matthew Stevenson, + Mauro Aranda, Nicolas De Jaeghere, Philip Kaludercic, Pierre + Téchoueyres, Rudolf Adamkovič, Stephen Gildea, Shreyas Ragavan, Stefan + Kangas, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie. + Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers, Adrian Manea, Alex Griffin, Alex Koen, Alex Peitsinis, Alexey Shmalko, - Alok Singh, Anders Johansson, André Alexandre Gomes, Antonio Hernández - Blas, Arif Rezai, Augusto Stoffel, Basil L.{{{space()}}} - Contovounesios, Burgess Chang, Christian Tietze, Christopher Dimech, - Damien Cassou, Daniel Mendler, Dario Gjorgjevski, David Edmondson, - Davor Rotim, Divan Santana, Eliraz Kedmi, Emanuele Michele Alberto - Monterosso, Farasha Euker, Feng Shu, Gautier Ponsinet, Gerry Agbobada, - Gianluca Recchia, Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, - Ilja Kocken, Iris Garcia, Jeremy Friesen, Jerry Zhang, Johannes - Grødem, John Haman, Jorge Morais, Joshua O'Connor, Julio - C. Villasante, Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kostadin - Ninev, Len Trigg, Lennart C. Karssen, Magne Hov, Manuel Uberti, Mark - Bestley, Mark Burton, Markus Beppler, Mauro Aranda, Michael + Alok Singh, Anders Johansson, André Alexandre Gomes, Andrew Tropin, + Antonio Hernández Blas, Arif Rezai, Augusto Stoffel, Basil + L.{{{space()}}} Contovounesios, Burgess Chang, Christian Tietze, + Christopher Dimech, Christopher League, Damien Cassou, Daniel Mendler, + Dario Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Eliraz + Kedmi, Emanuele Michele Alberto Monterosso, Farasha Euker, Feng Shu, + Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia, Gonçalo Marrafa, + Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Iris + Garcia, Ivan Popovych, Jeremy Friesen, Jerry Zhang, Johannes Grødem, + John Haman, Jorge Morais, Joshua O'Connor, Julio C. Villasante, Kenta + Usami, Kevin Fleming, Kévin Le Gouguec, Kostadin Ninev, Len Trigg, + Lennart C. Karssen, Magne Hov, Manuel Uberti, Mark Bestley, Mark + Burton, Markus Beppler, Mauro Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan Willcock, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Paul Poloskov, Pengji Zhang, Pete - Kazmier, Peter Wu, Philip Kaludercic, Pierre Téchoueyres, Robert - Hepple, Roman Rudakov, Ryan Phillips, Rytis Paškauskas, Rudolf - Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška, Shreyas - Ragavan, Simon Pugnet, Tassilo Horn, Thibaut Verron, Thomas Heartman, - Togan Muftuoglu, Tony Zorman, Trey Merkley, Tomasz Hołubowicz, Toon - Claes, Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: - Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, - Moesasji, Nick, TheBlob42, Trey, bepolymathe, bit9tream, derek-upham, - doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn, pRot0ta1p. - -+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn - Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core Emacs), - Stefan Monnier (GNU Elpa), André Alexandre Gomes, Dimakakos Dimos, - Morgan Smith, Nicolas Goaziou (Guix), Dhavan Vaidya (Debian). + Kazmier, Peter Wu, Philip Kaludercic, Pierre Téchoueyres, Przemysław + Kryger, Robert Hepple, Roman Rudakov, Ryan Phillips, Rytis Paškauskas, + Rudolf Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška, + Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut Verron, Thomas + Heartman, Togan Muftuoglu, Tony Zorman, Trey Merkley, Tomasz + Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh, Vincent Foley. As + well as users: Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, + Fredrik, Moesasji, Nick, TheBlob42, Trey, bepolymathe, bit9tream, + derek-upham, doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn, + pRot0ta1p. + ++ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, + Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core + Emacs), Stefan Monnier (GNU Elpa), André Alexandre Gomes, Andrew + Tropin, Dimakakos Dimos, Morgan Smith, Nicolas Goaziou (Guix), Dhavan + Vaidya (Debian). + Inspiration for certain features :: Bozhidar Batsov (zenburn-theme), Fabrice Niessen (leuven-theme). @@ -5663,7 +5789,7 @@ Jaeghere, and Omar Antolín Camarena for their long time contributions and insightful commentary on key aspects of the themes' design and/or aspects of their functionality. -* Meta +* Other notes about the project :properties: :custom_id: h:13752581-4378-478c-af17-165b6e76bc1b :end: @@ -5688,12 +5814,16 @@ of this sort): + [[https://protesilaos.com/codelog/2021-06-02-modus-themes-org-agenda/][Introducing the variable modus-themes-org-agenda]] (2021-06-02) + [[https://protesilaos.com/codelog/2022-01-02-review-modus-themes-org-habit-colours/][Modus themes: review of the org-habit graph colours]] (2022-01-02) + [[https://protesilaos.com/codelog/2022-01-03-modus-themes-port-faq/][Re: VSCode or Vim ports of the Emacs modus-themes?]] (2022-01-03) ++ [[https://protesilaos.com/codelog/2022-04-20-modus-themes-case-study-avy/][Modus themes: case study on Avy faces and colour combinations]] (2022-04-20) ++ [[https://protesilaos.com/codelog/2022-04-21-modus-themes-colour-theory/][Emacs: colour theory and techniques used in the Modus themes]] (2022-04-21) -And here are the canonical sources of this project's documentation: +And here are the canonical sources of this project: + Manual :: + Change Log :: + Screenshots :: ++ Git repository :: https://git.sr.ht/~protesilaos/modus-themes ++ Mailing list :: https://lists.sr.ht/~protesilaos/modus-themes * GNU Free Documentation License :properties: diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index be80b39410..646504636f 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -3,8 +3,8 @@ ;; Copyright (C) 2019-2022 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.3.0 +;; URL: https://git.sr.ht/~protesilaos/modus-themes +;; Version: 2.4.1 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 1c52223950..f068e4a214 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -3,9 +3,9 @@ ;; Copyright (C) 2019-2022 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.3.0 -;; Last-Modified: <2022-04-01 12:33:34 +0300> +;; URL: https://git.sr.ht/~protesilaos/modus-themes +;; Mailing list: https://lists.sr.ht/~protesilaos/modus-themes +;; Version: 2.4.1 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -68,306 +68,8 @@ ;; modus-themes-operandi-color-overrides (alist) ;; modus-themes-vivendi-color-overrides (alist) ;; -;; Below is the list of explicitly supported packages or face groups -;; (there are implicitly supported packages as well, which inherit from -;; font-lock or some basic group). You are encouraged to report any -;; missing package or change you would like to see. -;; -;; ace-window -;; alert -;; all-the-icons -;; all-the-icons-dired -;; all-the-icons-ibuffer -;; annotate -;; ansi-color -;; anzu -;; apropos -;; artbollocks-mode -;; auctex and TeX -;; auto-dim-other-buffers -;; avy -;; awesome-tray -;; bbdb -;; binder -;; bm -;; bongo -;; boon -;; bookmark -;; breakpoint (provided by built-in gdb-mi.el) -;; calendar and diary -;; calfw -;; centaur-tabs -;; cfrs -;; change-log and log-view (`vc-print-log' and `vc-print-root-log') -;; cider -;; circe -;; citar -;; color-rg -;; column-enforce-mode -;; company-mode -;; company-posframe -;; compilation-mode -;; completions -;; consult -;; corfu -;; counsel -;; counsel-css -;; cov -;; cperl-mode -;; css-mode -;; csv-mode -;; ctrlf -;; cursor-flash -;; custom (M-x customize) -;; dap-mode -;; dashboard (emacs-dashboard) -;; deadgrep -;; debbugs -;; deft -;; devdocs -;; dictionary -;; diff-hl -;; diff-mode -;; dim-autoload -;; dir-treeview -;; Dired -;; dired-async -;; dired-git -;; dired-git-info -;; dired-narrow -;; dired-subtree -;; diredfl -;; diredp (dired+) -;; display-fill-column-indicator-mode -;; doom-modeline -;; dynamic-ruler -;; easy-jekyll -;; ebdb -;; ediff -;; eglot -;; el-search -;; eldoc -;; eldoc-box -;; elfeed -;; elfeed-score -;; elpher -;; embark -;; ement (ement.el) -;; emms -;; enh-ruby-mode (enhanced-ruby-mode) -;; epa -;; equake -;; erc -;; eros -;; ert -;; eshell -;; eshell-fringe-status -;; eshell-git-prompt -;; eshell-prompt-extras (epe) -;; eshell-syntax-highlighting -;; evil (evil-mode) -;; evil-goggles -;; evil-snipe -;; evil-visual-mark-mode -;; eww -;; exwm -;; eyebrowse -;; fancy-dabbrev -;; flycheck -;; flycheck-color-mode-line -;; flycheck-indicator -;; flycheck-posframe -;; flymake -;; flyspell -;; flx -;; freeze-it -;; frog-menu -;; focus -;; fold-this -;; font-lock (generic syntax highlighting) -;; forge -;; fountain (fountain-mode) -;; geiser -;; git-commit -;; git-gutter (and variants) -;; git-rebase -;; git-timemachine -;; gnus -;; gotest -;; golden-ratio-scroll-screen -;; helm -;; helm-ls-git -;; helm-switch-shell -;; helm-xref -;; helpful -;; highlight-indentation -;; highlight-numbers -;; highlight-thing -;; hl-defined -;; hl-fill-column -;; hl-line-mode -;; hl-todo -;; hydra -;; ibuffer -;; icomplete -;; ido-mode -;; iedit -;; iflipb -;; image-dired -;; imenu-list -;; indium -;; info -;; info-colors -;; interaction-log -;; ioccur -;; isearch, occur, etc. -;; ivy -;; ivy-posframe -;; jira (org-jira) -;; journalctl-mode -;; js2-mode -;; julia -;; jupyter -;; kaocha-runner -;; keycast -;; ledger-mode -;; line numbers (`display-line-numbers-mode' and global variant) -;; lsp-mode -;; lsp-ui -;; macrostep -;; magit -;; magit-imerge -;; make-mode -;; man -;; marginalia -;; markdown-mode -;; markup-faces (`adoc-mode') -;; mct -;; mentor -;; messages -;; mini-modeline -;; minimap -;; mmm-mode -;; mode-line -;; mood-line -;; mpdel -;; mu4e -;; multiple-cursors -;; nano-modeline -;; neotree -;; notmuch -;; num3-mode -;; nxml-mode -;; orderless -;; org -;; org-journal -;; org-noter -;; org-pomodoro -;; org-recur -;; org-roam -;; org-superstar -;; org-table-sticky-header -;; org-tree-slide -;; org-treescope -;; origami -;; outline-mode -;; outline-minor-faces -;; package (M-x list-packages) -;; page-break-lines -;; pandoc-mode -;; paradox -;; paren-face -;; pass -;; pdf-tools -;; persp-mode -;; perspective -;; phi-grep -;; pomidor -;; popup -;; powerline -;; powerline-evil -;; prism (see "Note for prism.el" in the manual) -;; proced -;; prodigy -;; pulse -;; pyim -;; quick-peek -;; racket-mode -;; rainbow-blocks -;; rainbow-delimiters -;; rcirc -;; recursion-indicator -;; regexp-builder (also known as `re-builder') -;; rg -;; ripgrep -;; rmail -;; ruler-mode -;; selectrum -;; selectrum-prescient -;; semantic -;; sesman -;; shell-script-mode -;; shortdoc -;; show-paren-mode -;; shr -;; side-notes -;; sieve-mode -;; skewer-mode -;; slime (sldb) -;; sly -;; smart-mode-line -;; smartparens -;; smerge -;; spaceline -;; speedbar -;; stripes -;; suggest -;; switch-window -;; swiper -;; sx -;; symbol-overlay -;; syslog-mode -;; tab-bar-groups -;; tab-bar-mode -;; tab-line-mode -;; table (built-in table.el) -;; telega -;; telephone-line -;; terraform-mode -;; term -;; textsec -;; tomatinho -;; transient (pop-up windows like Magit's) -;; trashed -;; treemacs -;; tty-menu -;; tuareg -;; typescript -;; undo-tree -;; vc (vc-dir.el, vc-hooks.el) -;; vc-annotate (C-x v g) -;; vertico -;; vertico-quick -;; vimish-fold -;; visible-mark -;; visual-regexp -;; vterm -;; wcheck-mode -;; web-mode -;; wgrep -;; which-function-mode -;; which-key -;; whitespace-mode -;; window-divider-mode -;; winum -;; writegood-mode -;; woman -;; xah-elisp-mode -;; xref -;; xterm-color (and ansi-colors) -;; yaml-mode -;; yasnippet -;; ztree +;; Check the manual for all supported packages (there are hundreds of +;; them). ;; ;; For a complete view of the project, also refer to the following files ;; (should be distributed in the same repository/directory as the @@ -383,7 +85,6 @@ (eval-when-compile (require 'cl-lib) (require 'subr-x)) -(require 'seq) (defgroup modus-themes () "Options for `modus-operandi', `modus-vivendi'. @@ -407,6 +108,36 @@ cover the blue-cyan-magenta side of the spectrum." :prefix "modus-themes-" :tag "Modus Themes Faces") +(defvar modus-themes--version "2.5.0-dev" + "Current version of the Modus themes. + +The version either is the last tagged release, such as '2.4.0', +or an in-development version like '2.5.0-dev'. As we use +semantic versioning, tags of the '2.4.1' sort are not reported: +those would count as part of '2.5.0-dev'.") + +;;;###autoload +(defun modus-themes-version (&optional insert) + "Print `modus-themes--version' in the echo area. +If optional INSERT argument is provided from Lisp or as a prefix +argument, insert the `modus-themes--version' at point." + (interactive "P") + (if-let ((version modus-themes--version) + ((or insert current-prefix-arg))) + (insert version) + (message version))) + +;;;###autoload +(defun modus-themes-report-bug () + "Submit a bug report or issue to the Modus themes developers." + (interactive) + (reporter-submit-bug-report + "~protesilaos/modus-themes@lists.sr.ht" + (format "modus-themes (%s)\n" modus-themes--version) + ;; I am just getting started with this. Let's first see what people + ;; think about it. + nil nil nil nil)) + ;;; Variables for each theme variant ;;;; Modus Operandi @@ -561,7 +292,8 @@ cover the blue-cyan-magenta side of the spectrum." ;; while bg-tab-inactive should be combined with fg-dim, whereas ;; bg-tab-inactive-alt goes together with fg-main ;; - ;; bg-completion-* variants are meant to be combined with fg-main + ;; bg-completion-* and bg-char-* variants are meant to be combined + ;; with fg-main ;; ;; fg-escape-char-construct and fg-escape-char-backslash can ;; be combined bg-main, bg-dim, bg-alt @@ -595,6 +327,10 @@ cover the blue-cyan-magenta side of the spectrum." (bg-completion . "#b7dbff") (bg-completion-subtle . "#def3ff") + (bg-char-0 . "#7feaff") + (bg-char-1 . "#ffaaff") + (bg-char-2 . "#dff000") + (bg-tab-active . "#f6f6f6") (bg-tab-inactive . "#b7b7b7") (bg-tab-inactive-accent . "#a9b4f6") @@ -807,7 +543,8 @@ symbol and the latter as a string.") ;; while bg-tab-inactive should be combined with fg-dim, whereas ;; bg-tab-inactive-alt goes together with fg-main ;; - ;; bg-completion-* variants are meant to be combined with fg-main + ;; bg-completion-* and bg-char-* variants are meant to be combined + ;; with fg-main ;; ;; fg-escape-char-construct and fg-escape-char-backslash can ;; be combined bg-main, bg-dim, bg-alt @@ -841,6 +578,10 @@ symbol and the latter as a string.") (bg-completion . "#142f69") (bg-completion-subtle . "#0e194b") + (bg-char-0 . "#0050af") + (bg-char-1 . "#7f1f7f") + (bg-char-2 . "#625a00") + (bg-tab-active . "#0e0e0e") (bg-tab-inactive . "#424242") (bg-tab-inactive-accent . "#35398f") @@ -1449,9 +1190,8 @@ The actual styling of the face is done by `modus-themes-faces'." (defface modus-themes-variable-pitch nil "Generic face for applying a conditional `variable-pitch'. -This behaves in accordance with `modus-themes-mixed-fonts', -`modus-themes-variable-pitch-headings' for all heading levels, -and `modus-themes-variable-pitch-ui'. +This behaves in accordance with `modus-themes-mixed-fonts' and/or +`modus-themes-variable-pitch-ui'. The actual styling of the face is done by `modus-themes-faces'." :group 'modus-themes-faces) @@ -3142,13 +2882,15 @@ In user configuration files the form may look like this: value (modus-themes--warn option)))) -(defun modus-themes--alist-or-seq (properties alist-key seq-pred seq-default) - "Return value from alist or sequence. +(defun modus-themes--property-lookup (properties alist-key list-pred default) + "Return value from property alist or list. Check PROPERTIES for an alist value that corresponds to ALIST-KEY. If no alist is present, search the PROPERTIES -sequence given SEQ-PRED, using SEQ-DEFAULT as a fallback." +list given LIST-PRED, using DEFAULT as a fallback." (if-let* ((val (or (alist-get alist-key properties) - (seq-find seq-pred properties seq-default))) + (cl-loop for x in properties + if (funcall list-pred x) return x) + default)) ((listp val))) (car val) val)) @@ -3192,8 +2934,11 @@ Those are stored in `modus-themes-faces' and (defun modus-themes--current-theme () "Return current modus theme." - (car (seq-filter (lambda (arg) (string-match-p "^modus" (symbol-name arg))) - custom-enabled-themes))) + (car + (seq-filter + (lambda (theme) + (string-match-p "^modus" (symbol-name theme))) + custom-enabled-themes))) ;; Helper functions that are meant to ease the implementation of the ;; above customization variables. @@ -3245,11 +2990,11 @@ foreground. INTENSEFG is an alternative to the default." (cond ((and (memq 'bold properties) (memq 'italic properties)) - (list 'modus-themes-fixed-pitch 'bold-italic)) + (list 'bold-italic 'modus-themes-fixed-pitch)) ((memq 'italic properties) - (list 'modus-themes-fixed-pitch 'italic)) + (list 'italic 'modus-themes-fixed-pitch)) ((memq 'bold properties) - (list 'modus-themes-fixed-pitch 'bold)) + (list 'bold 'modus-themes-fixed-pitch)) (t 'modus-themes-fixed-pitch)) :background (cond @@ -3368,10 +3113,10 @@ theme's fallback text color." (defun modus-themes--paren (normalbg intensebg) "Conditional use of intense colors for matching parentheses. -NORMALBG should be the special palette color `bg-paren-match' or +NORMALBG should be the special palette color 'bg-paren-match' or something similar. INTENSEBG must be easier to discern next to other backgrounds, such as the special palette color -`bg-paren-match-intense'." +'bg-paren-match-intense'." (let ((properties (modus-themes--list-or-warn 'modus-themes-paren-match))) (list :inherit (if (memq 'bold properties) @@ -3521,7 +3266,7 @@ that combines well with the background and foreground." fg-alt) (fg)) :height - (modus-themes--alist-or-seq properties 'height #'floatp 'unspecified) + (modus-themes--property-lookup properties 'height #'floatp 'unspecified) :weight (or weight 'unspecified) :overline @@ -3546,7 +3291,7 @@ FG is the foreground color to use." (or weight 'unspecified) :height (cond ((memq 'no-scale properties) 'unspecified) - ((modus-themes--alist-or-seq properties 'height #'floatp 1.15))) + ((modus-themes--property-lookup properties 'height #'floatp 1.15))) :foreground fg))) (defun modus-themes--agenda-date (defaultfg grayscalefg &optional workaholicfg grayscaleworkaholicfg bg bold ul) @@ -3581,7 +3326,7 @@ weight. Optional UL applies an underline." (t defaultfg)) :height - (modus-themes--alist-or-seq properties 'height #'floatp 'unspecified) + (modus-themes--property-lookup properties 'height #'floatp 'unspecified) :underline (if (and ul (memq 'underline-today properties)) t @@ -3637,8 +3382,8 @@ clearly distinguishes past, present, future tasks." (defun modus-themes--agenda-habit (default traffic simple &optional default-d traffic-d simple-d) "Specify background values for `modus-themes-org-agenda' habits. DEFAULT is the original foregrounc color. TRAFFIC is to be used -when the `traffic-light' style is applied, while SIMPLE -corresponds to the \"simplified style\". +when the 'traffic-light' style is applied, while SIMPLE +corresponds to the 'simplified style'. Optional DEFAULT-D, TRAFFIC-D, SIMPLE-D are alternatives to the main colors, meant for dopia when `modus-themes-deuteranopia' is @@ -3712,8 +3457,8 @@ Optional FG-DISTANT should be close to the main background values. It is intended to be used as a distant-foreground property." (let* ((properties (modus-themes--list-or-warn 'modus-themes-mode-line)) - (padding (modus-themes--alist-or-seq properties 'padding #'natnump 1)) - (height (modus-themes--alist-or-seq properties 'height #'floatp 'unspecified)) + (padding (modus-themes--property-lookup properties 'padding #'natnump 1)) + (height (modus-themes--property-lookup properties 'height #'floatp 'unspecified)) (padded (> padding 1)) (base (cond ((memq 'accented properties) (cons fg-accent bg-accent)) @@ -3778,10 +3523,14 @@ property." ;; Basically this is just for the keycast key indicator. (defun modus-themes--mode-line-padded-box (color) "Set padding of mode line box attribute with given COLOR." - (let ((padding (seq-find #'natnump modus-themes-mode-line 1))) - (list :box (list :line-width padding :color color)))) - -(defun modus-themes--diff (mainbg mainfg altbg altfg &optional deuteranbg deuteranfg bg-only-fg) + (list :box (list :color color + :line-width + (or (cl-loop + for x in modus-themes-mode-line + if (natnump x) return x) + 1)))) + +(defun modus-themes--diff (mainbg mainfg altbg altfg &optional deubg deufg deualtbg deualtfg bg-only-fg) "Color combinations for `modus-themes-diffs'. MAINBG must be one of the dedicated backgrounds for diffs while @@ -3791,13 +3540,20 @@ ALTBG needs to be a slightly accented background that is meant to be combined with ALTFG. Both must be less intense than MAINBG and MAINFG respectively. -DEUTERANBG and DEUTERANFG must be combinations of colors that account -for red-green color defficiency (deuteranopia). +DEUBG and DEUFG must be combinations of colors that account for +red-green color defficiency (deuteranopia). They are the +equivalent of MAINBG and MAINFG. + +DEUALTBG and DEUALTFG are the equivalent of ALTBG and ALTFG for +deuteranopia. -Optional BG-ONLY-FG applies ALTFG else leaves the foreground -unspecified." +Optional non-nil BG-ONLY-FG applies ALTFG else leaves the +foreground unspecified." (if modus-themes-deuteranopia - (list :background (or deuteranbg mainbg) :foreground (or deuteranfg mainfg)) + (pcase modus-themes-diffs + ('desaturated (list :background (or deualtbg altbg) :foreground (or deualtfg altfg))) + ('bg-only (list :background (or deualtbg altbg) :foreground (if bg-only-fg (or deualtfg altfg) 'unspecified))) + (_ (list :background (or deubg mainbg) :foreground (or deufg mainfg)))) (pcase modus-themes-diffs ('desaturated (list :background altbg :foreground altfg)) ('bg-only (list :background altbg :foreground (if bg-only-fg altfg 'unspecified))) @@ -4114,7 +3870,7 @@ pressed button style, else the released button." (weight weight) ('unspecified)) :height - (modus-themes--alist-or-seq properties 'height #'floatp 'unspecified) + (modus-themes--property-lookup properties 'height #'floatp 'unspecified) :underline (if (memq 'underline properties) t @@ -4379,7 +4135,8 @@ by virtue of calling either of `modus-themes-load-operandi' and ((,class ,@(modus-themes--diff bg-diff-focus-added fg-diff-focus-added green-nuanced-bg fg-diff-added - bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran)))) + bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran + blue-nuanced-bg fg-diff-added-deuteran)))) `(modus-themes-diff-changed ((,class ,@(modus-themes--diff bg-diff-focus-changed fg-diff-focus-changed @@ -4392,7 +4149,8 @@ by virtue of calling either of `modus-themes-load-operandi' and ((,class ,@(modus-themes--diff bg-diff-refine-added fg-diff-refine-added bg-diff-focus-added fg-diff-focus-added - bg-diff-refine-added-deuteran fg-diff-refine-added-deuteran)))) + bg-diff-refine-added-deuteran fg-diff-refine-added-deuteran + bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran)))) `(modus-themes-diff-refine-changed ((,class ,@(modus-themes--diff bg-diff-refine-changed fg-diff-refine-changed @@ -4405,7 +4163,8 @@ by virtue of calling either of `modus-themes-load-operandi' and ((,class ,@(modus-themes--diff bg-diff-focus-added fg-diff-focus-added bg-diff-added fg-diff-added - bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran)))) + bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran + bg-diff-added-deuteran fg-diff-added-deuteran)))) `(modus-themes-diff-focus-changed ((,class ,@(modus-themes--diff bg-diff-focus-changed fg-diff-focus-changed @@ -4419,6 +4178,7 @@ by virtue of calling either of `modus-themes-load-operandi' and bg-diff-heading fg-diff-heading cyan-nuanced-bg cyan-nuanced-fg bg-header fg-main + bg-header fg-main t)))) ;;;;; deuteranopia-specific `(modus-themes-grue ((,class :foreground ,@(modus-themes--deuteran blue green)))) @@ -4564,7 +4324,8 @@ by virtue of calling either of `modus-themes-load-operandi' and bg-region blue-intense-bg fg-alt blue-intense) :extend t))) - `(modus-themes-key-binding ((,class :inherit bold :foreground ,blue-alt-other))) + `(modus-themes-key-binding ((,class :inherit (bold modus-themes-fixed-pitch) + :foreground ,blue-alt-other))) `(modus-themes-prompt ((,class ,@(modus-themes--prompt cyan-alt-other blue-alt-other fg-alt cyan-nuanced-bg blue-refine-bg fg-main @@ -4592,7 +4353,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(elisp-shorthand-font-lock-face ((,class :inherit font-lock-variable-name-face))) `(error ((,class :inherit bold :foreground ,red))) `(escape-glyph ((,class :foreground ,fg-escape-char-construct))) - `(file-name-shadow ((,class :inherit (shadow italic)))) + `(file-name-shadow ((,class :inherit shadow))) `(header-line ((,class :inherit modus-themes-ui-variable-pitch :background ,bg-header :foreground ,fg-header))) `(header-line-highlight ((,class :inherit highlight))) @@ -4759,10 +4520,10 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; avy `(avy-background-face ((,class :background ,bg-dim :foreground ,fg-dim :extend t))) `(avy-goto-char-timer-face ((,class :inherit (modus-themes-intense-neutral bold)))) - `(avy-lead-face ((,class :inherit (modus-themes-intense-blue bold modus-themes-reset-soft)))) - `(avy-lead-face-0 ((,class :inherit (modus-themes-refine-magenta bold modus-themes-reset-soft)))) + `(avy-lead-face ((,class :inherit (bold modus-themes-reset-soft) :background ,bg-char-0))) + `(avy-lead-face-0 ((,class :inherit (bold modus-themes-reset-soft) :background ,bg-char-1))) `(avy-lead-face-1 ((,class :inherit (modus-themes-special-warm modus-themes-reset-soft)))) - `(avy-lead-face-2 ((,class :inherit (modus-themes-refine-green bold modus-themes-reset-soft)))) + `(avy-lead-face-2 ((,class :inherit (bold modus-themes-reset-soft) :background ,bg-char-2))) ;;;;; aw (ace-window) `(aw-background-face ((,class :foreground ,fg-unfocused))) `(aw-key-face ((,class :inherit modus-themes-key-binding))) @@ -4849,6 +4610,27 @@ by virtue of calling either of `modus-themes-load-operandi' and `(cfw:face-toolbar-button-off ((,class :inherit shadow))) `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,blue-nuanced-bg :foreground ,blue-alt))) +;;;;; calibredb + `(calibredb-archive-face ((,class :foreground ,magenta-alt-faint))) + `(calibredb-author-face ((,class :foreground ,blue-faint))) + `(calibredb-comment-face ((,class :inherit shadow))) + `(calibredb-date-face ((,class :foreground ,cyan))) + `(calibredb-edit-annotation-header-title-face ((,class :inherit bold))) + `(calibredb-favorite-face ((,class :foreground ,red-alt))) + `(calibredb-file-face (( ))) + `(calibredb-format-face ((,class :foreground ,cyan-faint))) + `(calibredb-highlight-face ((,class :inherit success))) + `(calibredb-id-face (( ))) + `(calibredb-ids-face (( ))) + `(calibredb-search-header-highlight-face ((,class :inherit modus-themes-hl-line))) + `(calibredb-search-header-library-name-face ((,class :foreground ,blue-active))) + `(calibredb-search-header-library-path-face ((,class :inherit bold))) + `(calibredb-search-header-sort-face ((,class :inherit bold :foreground ,magenta-active))) + `(calibredb-search-header-total-face ((,class :inherit bold :foreground ,cyan-active))) + `(calibredb-search-header-filter-face ((,class :inherit bold))) + `(calibredb-mark-face ((,class :inherit modus-themes-mark-sel))) + `(calibredb-size-face (( ))) + `(calibredb-tag-face ((,class :foreground ,magenta-alt-faint))) ;;;;; centaur-tabs `(centaur-tabs-active-bar-face ((,class :background ,blue-active))) `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground ,red-active :underline t))) @@ -4992,6 +4774,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(corfu-bar ((,class :background ,fg-alt))) `(corfu-border ((,class :background ,bg-active))) `(corfu-default ((,class :background ,bg-alt))) +;;;;; corfu-quick + `(corfu-quick1 ((,class :inherit bold :background ,bg-char-0))) + `(corfu-quick2 ((,class :inherit bold :background ,bg-char-1))) ;;;;; counsel `(counsel-active-mode ((,class :foreground ,magenta-alt-other))) `(counsel-application-name ((,class :foreground ,red-alt-other))) @@ -5323,6 +5108,13 @@ by virtue of calling either of `modus-themes-load-operandi' and `(ediff-odd-diff-Ancestor ((,class :inherit ediff-even-diff-Ancestor))) `(ediff-odd-diff-B ((,class :inherit ediff-even-diff-B))) `(ediff-odd-diff-C ((,class :inherit ediff-even-diff-C))) +;;;;; ein (Emacs IPython Notebook) + `(ein:basecell-input-area-face ((,class :background ,bg-dim :extend t))) + `(ein:cell-output-area (( ))) + `(ein:cell-output-area-error ((,class :background ,red-nuanced-bg :extend t))) + `(ein:cell-output-stderr ((,class :background ,red-nuanced-bg :extend t))) + `(ein:markdowncell-input-area-face (( ))) + `(ein:notification-tab-normal ((,class :underline t))) ;;;;; eglot `(eglot-mode-line ((,class :inherit modus-themes-bold :foreground ,magenta-active))) ;;;;; el-search @@ -5637,7 +5429,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(font-lock-doc-face ((,class :inherit modus-themes-slant ,@(modus-themes--syntax-string fg-docstring fg-special-cold - fg-special-mild magenta-nuanced-fg + fg-special-mild fg-special-calm fg-special-mild magenta-nuanced-fg)))) `(font-lock-function-name-face ((,class ,@(modus-themes--syntax-extra magenta magenta-faint @@ -5651,30 +5443,31 @@ by virtue of calling either of `modus-themes-load-operandi' and yellow yellow-faint)))) `(font-lock-preprocessor-face ((,class ,@(modus-themes--syntax-extra red-alt-other red-alt-other-faint - blue-alt blue-alt-faint)))) - `(font-lock-regexp-grouping-backslash ((,class :inherit bold + cyan-alt-other cyan-alt-faint)))) + `(font-lock-regexp-grouping-backslash ((,class :inherit modus-themes-bold ,@(modus-themes--syntax-string fg-escape-char-backslash yellow-alt-faint yellow-alt magenta-alt red-faint green-alt-other-faint)))) - `(font-lock-regexp-grouping-construct ((,class :inherit bold + `(font-lock-regexp-grouping-construct ((,class :inherit modus-themes-bold ,@(modus-themes--syntax-string fg-escape-char-construct red-alt-other-faint red-alt-other blue-alt-other blue-faint blue-alt-other-faint)))) `(font-lock-string-face ((,class ,@(modus-themes--syntax-string blue-alt blue-alt-faint - green-alt-other red-alt + green-alt-other red-alt-other green-alt-faint red-alt-faint)))) `(font-lock-type-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-foreground - cyan-alt-other cyan-alt-faint)))) + ,@(modus-themes--syntax-extra + cyan-alt-other cyan-alt-faint + magenta-alt-other magenta-alt-other-faint)))) `(font-lock-variable-name-face ((,class ,@(modus-themes--syntax-extra cyan cyan-faint - blue-alt-other blue-alt-other-faint)))) + blue-alt blue-alt-faint)))) `(font-lock-warning-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-comment - yellow-active red-active red-faint yellow-faint)))) + ,@(modus-themes--syntax-foreground + yellow-active yellow-alt-faint)))) ;;;;; forge `(forge-post-author ((,class :inherit bold :foreground ,fg-main))) `(forge-post-date ((,class :foreground ,fg-special-cold))) @@ -5685,7 +5478,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(forge-topic-unread ((,class :inherit bold :foreground ,fg-main))) ;;;;; fountain-mode `(fountain-character ((,class :foreground ,blue-alt-other))) - `(fountain-comment ((,class :inherit modus-themes-slant :foreground ,fg-alt))) + `(fountain-comment ((,class :inherit font-lock-comment-face))) `(fountain-dialog ((,class :foreground ,blue-alt))) `(fountain-metadata-key ((,class :foreground ,green-alt-other))) `(fountain-metadata-value ((,class :foreground ,blue))) @@ -5719,11 +5512,11 @@ by virtue of calling either of `modus-themes-load-operandi' and `(geiser-font-lock-xref-link ((,class :inherit button))) ;;;;; git-commit `(git-commit-comment-action ((,class :inherit font-lock-comment-face))) - `(git-commit-comment-branch-local ((,class :inherit modus-themes-slant :foreground ,blue-alt))) - `(git-commit-comment-branch-remote ((,class :inherit modus-themes-slant :foreground ,magenta-alt))) - `(git-commit-comment-detached ((,class :inherit modus-themes-slant :foreground ,cyan-alt))) - `(git-commit-comment-file ((,class :inherit modus-themes-slant :foreground ,cyan))) - `(git-commit-comment-heading ((,class :inherit (bold modus-themes-slant)))) + `(git-commit-comment-branch-local ((,class :inherit font-lock-comment-face :foreground ,blue-alt))) + `(git-commit-comment-branch-remote ((,class :inherit font-lock-comment-face :foreground ,magenta-alt))) + `(git-commit-comment-detached ((,class :inherit font-lock-comment-face :foreground ,cyan-alt))) + `(git-commit-comment-file ((,class :inherit font-lock-comment-face :foreground ,cyan))) + `(git-commit-comment-heading ((,class :inherit (bold font-lock-comment-face)))) `(git-commit-keyword ((,class :foreground ,magenta))) `(git-commit-known-pseudo-header ((,class :foreground ,cyan-alt-other))) `(git-commit-nonempty-second-line ((,class :inherit error))) @@ -5741,8 +5534,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(git-gutter-fr:deleted ((,class :inherit modus-themes-fringe-red))) `(git-gutter-fr:modified ((,class :inherit modus-themes-fringe-yellow))) ;;;;; git-rebase - `(git-rebase-comment-hash ((,class :inherit modus-themes-slant :foreground ,cyan))) - `(git-rebase-comment-heading ((,class :inherit (bold modus-themes-slant)))) + `(git-rebase-comment-hash ((,class :inherit font-lock-comment-face :foreground ,cyan))) + `(git-rebase-comment-heading ((,class :inherit (bold font-lock-comment-face)))) `(git-rebase-description ((,class :foreground ,fg-main))) `(git-rebase-hash ((,class :foreground ,cyan-alt-other))) ;;;;; git-timemachine @@ -6114,7 +5907,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(kaocha-runner-warning-face ((,class :inherit warning))) ;;;;; keycast `(keycast-command ((,class :inherit bold :foreground ,blue-active))) - `(keycast-key ((,class ,@(modus-themes--mode-line-padded-box blue-active) + ;; FIXME 2022-05-03: The padding breaks `keycast-tab-bar-mode' + `(keycast-key ((,class ;; ,@(modus-themes--mode-line-padded-box blue-active) :background ,blue-active :foreground ,bg-main))) ;;;;; ledger-mode `(ledger-font-auto-xact-face ((,class :foreground ,magenta))) @@ -6128,23 +5922,26 @@ by virtue of calling either of `modus-themes-load-operandi' and `(ledger-font-payee-uncleared-face ((,class :foreground ,red-alt-other))) `(ledger-font-xact-highlight-face ((,class :background ,bg-hl-alt))) ;;;;; line numbers (display-line-numbers-mode and global variant) + ;; Here we cannot inherit `modus-themes-fixed-pitch'. We need to + ;; fall back to `default' otherwise line numbers do not scale when + ;; using `text-scale-adjust'. `(line-number - ((,class :inherit default + ((,class :inherit ,(if modus-themes-mixed-fonts 'fixed-pitch 'default) ,@(modus-themes--line-numbers fg-alt bg-dim fg-unfocused)))) `(line-number-current-line - ((,class :inherit (bold default) + ((,class :inherit (bold line-number) ,@(modus-themes--line-numbers fg-main bg-active blue-alt-other)))) `(line-number-major-tick - ((,class :inherit (bold default) + ((,class :inherit (bold line-number) ,@(modus-themes--line-numbers yellow-nuanced-fg yellow-nuanced-bg red-alt)))) `(line-number-minor-tick - ((,class :inherit (bold default) + ((,class :inherit (bold line-number) ,@(modus-themes--line-numbers fg-alt bg-inactive fg-inactive)))) @@ -6228,7 +6025,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(magit-diff-added ((,class ,@(modus-themes--diff bg-diff-added fg-diff-added green-nuanced-bg fg-diff-added - bg-diff-added-deuteran fg-diff-added-deuteran)))) + bg-diff-added-deuteran fg-diff-added-deuteran + blue-nuanced-bg fg-diff-added-deuteran)))) `(magit-diff-added-highlight ((,class :inherit modus-themes-diff-focus-added))) `(magit-diff-base ((,class ,@(modus-themes--diff bg-diff-changed fg-diff-changed @@ -6249,6 +6047,7 @@ by virtue of calling either of `modus-themes-load-operandi' and bg-active fg-inactive bg-inactive fg-inactive bg-inactive fg-inactive + nil nil t)))) ;; NOTE: we do not follow the pattern of inheriting from ;; modus-themes-grue-* faces, as this is a special case. @@ -6687,9 +6486,7 @@ by virtue of calling either of `modus-themes-load-operandi' and :background ,bg-alt))) `(org-column-title ((,class :inherit (bold modus-themes-fixed-pitch default) :underline t :background ,bg-alt))) - `(org-date ((,class :inherit ,(if modus-themes-mixed-fonts - '(fixed-pitch modus-themes-link-symlink) - 'modus-themes-link-symlink)))) + `(org-date ((,class :inherit (modus-themes-link-symlink modus-themes-fixed-pitch)))) `(org-date-selected ((,class :foreground ,blue-alt :inverse-video t))) `(org-dispatcher-highlight ((,class :inherit (bold modus-themes-mark-alt)))) `(org-document-info ((,class :foreground ,fg-special-cold))) @@ -6906,7 +6703,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(popup-summary-face ((,class :background ,bg-active :foreground ,fg-inactive))) `(popup-tip-face ((,class :inherit modus-themes-refine-yellow))) ;;;;; powerline - `(powerline-active0 ((,class :background ,bg-main :foreground ,blue-faint :inverse-video t))) + `(powerline-active0 ((,class :background ,blue-faint :foreground ,bg-main))) `(powerline-active1 ((,class :background ,blue-nuanced-bg :foreground ,blue-nuanced-fg))) `(powerline-active2 ((,class :background ,bg-active :foreground ,fg-active))) `(powerline-inactive0 ((,class :background ,bg-special-cold :foreground ,fg-special-cold))) @@ -7355,7 +7152,9 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; transient `(transient-active-infix ((,class :inherit modus-themes-special-mild))) `(transient-amaranth ((,class :inherit bold :foreground ,yellow-alt))) - `(transient-argument ((,class :inherit bold :background ,cyan-nuanced-bg :foreground ,cyan))) + ;; Placate the compiler for what is a spurious warning. We also + ;; have to do this with `eldoc-highlight-function-argument'. + (list 'transient-argument `((,class :inherit bold :background ,cyan-nuanced-bg :foreground ,cyan))) `(transient-blue ((,class :inherit bold :foreground ,blue))) `(transient-disabled-suffix ((,class :inherit modus-themes-intense-red))) `(transient-enabled-suffix ((,class :inherit modus-themes-grue-background-subtle))) @@ -7379,6 +7178,24 @@ by virtue of calling either of `modus-themes-load-operandi' and `(trashed-marked ((,class :inherit modus-themes-mark-alt))) `(trashed-restored ((,class :inherit modus-themes-mark-sel))) `(trashed-symlink ((,class :inherit modus-themes-link-symlink))) +;;;;; tree-sitter + `(tree-sitter-hl-face:attribute ((,class :inherit font-lock-variable-name-face))) + `(tree-sitter-hl-face:constant.builtin ((,class :inherit tree-sitter-hl-face:constant))) + `(tree-sitter-hl-face:escape ((,class :inherit font-lock-regexp-grouping-backslash))) + `(tree-sitter-hl-face:function ((,class :inherit font-lock-function-name-face))) + `(tree-sitter-hl-face:function.call ((,class :inherit tree-sitter-hl-face:function))) + `(tree-sitter-hl-face:label (( ))) + `(tree-sitter-hl-face:method.call (( ))) + `(tree-sitter-hl-face:operator ((,class :inherit modus-themes-bold))) + `(tree-sitter-hl-face:property (( ))) + `(tree-sitter-hl-face:property.definition ((,class :inherit font-lock-variable-name-face))) + `(tree-sitter-hl-face:punctuation (( ))) + `(tree-sitter-hl-face:punctuation.bracket (( ))) + `(tree-sitter-hl-face:punctuation.delimiter (( ))) + `(tree-sitter-hl-face:punctuation.special ((,class :inherit font-lock-regexp-grouping-construct))) + `(tree-sitter-hl-face:string.special ((,class :inherit tree-sitter-hl-face:string))) + `(tree-sitter-hl-face:tag ((,class :inherit font-lock-function-name-face))) + `(tree-sitter-hl-face:type.argument (( ))) ;;;;; treemacs `(treemacs-directory-collapsed-face ((,class :foreground ,magenta-alt))) `(treemacs-directory-face ((,class :inherit dired-directory))) @@ -7460,8 +7277,8 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; vertico `(vertico-current ((,class :inherit modus-themes-completion-selected))) ;;;;; vertico-quick - `(vertico-quick1 ((,class :inherit (modus-themes-intense-blue bold)))) - `(vertico-quick2 ((,class :inherit (modus-themes-refine-magenta bold)))) + `(vertico-quick1 ((,class :inherit bold :background ,bg-char-0))) + `(vertico-quick2 ((,class :inherit bold :background ,bg-char-1))) ;;;;; vimish-fold `(vimish-fold-fringe ((,class :foreground ,cyan-active))) `(vimish-fold-mouse-face ((,class :inherit modus-themes-intense-blue))) @@ -7491,6 +7308,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(vterm-color-underline ((,class :foreground ,fg-special-warm :underline t))) `(vterm-color-white ((,class :background "gray65" :foreground "gray65"))) `(vterm-color-yellow ((,class :background ,yellow :foreground ,yellow))) +;;;;; vundo + `(vundo-highlight ((,class :inherit (bold vundo-node) :foreground ,red-intense))) ;;;;; wcheck-mode `(wcheck-default-face ((,class :foreground ,red :underline t))) ;;;;; web-mode @@ -7652,6 +7471,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-themes-fringe-red)) `(flymake-warning-bitmap '(exclamation-mark modus-themes-fringe-yellow)) `(flymake-note-bitmap '(exclamation-mark modus-themes-fringe-cyan)) +;;;; highlight-changes + `(highlight-changes-colors nil) + `(highlight-changes-face-list '(success warning error bold bold-italic)) ;;;; ibuffer `(ibuffer-deletion-face 'modus-themes-mark-del) `(ibuffer-filter-group-name-face 'modus-themes-pseudo-header) @@ -7753,9 +7575,4 @@ by virtue of calling either of `modus-themes-load-operandi' and (add-to-list 'custom-theme-load-path dir)))) (provide 'modus-themes) - -;; Local Variables: -;; time-stamp-pattern: "Last-Modified: <%Y-%02m-%02d %02H:%02M:%02S %5z>" -;; End: - ;;; modus-themes.el ends here diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index fb95772654..fe52aefc84 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -3,8 +3,8 @@ ;; Copyright (C) 2019-2022 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.3.0 +;; URL: https://git.sr.ht/~protesilaos/modus-themes +;; Version: 2.4.1 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility commit a6322e7f134fa3fc4627bb36dcbbe0b78bb00091 Author: Lars Ingebrigtsen Date: Wed Jun 1 12:55:06 2022 +0200 Tweak how loaddefs-gen decides whether to do a full update * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Do a complete build more often to avoid problems with going from old loaddefs.el files to new ones. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 8dcb55d82d..63b3fd13d7 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -508,6 +508,13 @@ 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")))) (defs nil)) ;; Collect all the autoload data. @@ -518,7 +525,7 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (file-count 0)) (dolist (file files) (progress-reporter-update progress (setq file-count (1+ file-count))) - (when (or (not (file-exists-p output-file)) + (when (or (not updating) (file-newer-than-file-p file output-file)) (setq defs (nconc (loaddefs-generate--parse-file commit e9bb2d7f4ec47bd3a19df8ceaa43d0ad36dbf9b3 Author: Po Lu Date: Wed Jun 1 18:24:05 2022 +0800 Fix Motif DND return value upon transfer failure * src/xterm.c (handle_one_xevent): Make XmTRANSFER_FAILURE clear DND action. diff --git a/src/xterm.c b/src/xterm.c index 8533961993..484637807a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15502,7 +15502,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, && eventp->selection == dpyinfo->Xatom_XdndSelection && (eventp->target == dpyinfo->Xatom_XmTRANSFER_SUCCESS || eventp->target == dpyinfo->Xatom_XmTRANSFER_FAILURE)) - x_dnd_waiting_for_finish = false; + { + x_dnd_waiting_for_finish = false; + + /* If the transfer failed, then return nil from + `x-begin-drag'. */ + if (eventp->target == dpyinfo->Xatom_XmTRANSFER_FAILURE) + x_dnd_action = None; + } } break; commit 28358db93007456a1e0a6d9118823d4ddea4ba39 Author: Po Lu Date: Wed Jun 1 18:21:36 2022 +0800 Fix loaddefs generation * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Prevent one kind of string match error. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 02f584d0af..8dcb55d82d 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -568,7 +568,7 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (search-backward "\f\n")) ;; Delete the old version of the section. (delete-region (match-beginning 0) - (and (search-forward "\n\f\n;;;") + (and (search-forward "\n\f\n;;;" nil t) (match-beginning 0))) (forward-line -2))) (insert head) commit 495c93d015534d6c8b6940623c5cbb0b2b493b2e Author: Po Lu Date: Wed Jun 1 08:39:26 2022 +0000 Adjust last change to Haiku as well * lisp/term/haiku-win.el (haiku-dnd-selection-converters): Add text/uri-list. (haiku-dnd-convert-text-uri-list): New function. (x-begin-drag): Handle alternative data specified in selection local values. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index a8cc1da731..2a31dd38c8 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -52,7 +52,8 @@ "The local value of the special `XdndSelection' selection.") (defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string) - (FILE_NAME . haiku-dnd-convert-file-name)) + (FILE_NAME . haiku-dnd-convert-file-name) + (text/uri-list . haiku-dnd-convert-text-uri-list)) "Alist of X selection types to functions that act as selection converters. The functions should accept a single argument VALUE, describing the value of the drag-and-drop selection, and return a list of @@ -148,6 +149,19 @@ VALUE as a unibyte string, or nil if VALUE was not a string." (file-exists-p value)) (list "refs" (propertize (expand-file-name value) 'type 'ref)))) +(defun haiku-dnd-convert-text-uri-list (value) + "Convert VALUE to a list of URLs." + (cond + ((stringp value) (list "text/uri-list" + (concat (url-encode-url value) "\n"))) + ((vectorp value) (list "text/uri-list" + (with-temp-buffer + (cl-loop for tem across value + do (progn + (insert (url-encode-url tem)) + (insert "\n"))) + (buffer-string)))))) + (declare-function x-open-connection "haikufns.c") (declare-function x-handle-args "common-win") (declare-function haiku-selection-data "haikuselect.c") @@ -341,12 +355,17 @@ take effect on menu items until the menu bar is updated again." (mouse-highlight nil) (haiku-signal-invalid-refs nil)) (dolist (target targets) - (let ((selection-converter (cdr (assoc (intern target) - haiku-dnd-selection-converters)))) + (let* ((target-atom (intern target)) + (selection-converter (cdr (assoc target-atom + haiku-dnd-selection-converters)))) (when selection-converter (let ((selection-result (funcall selection-converter - haiku-dnd-selection-value))) + (if (stringp haiku-dnd-selection-value) + (or (get-text-property 0 target-atom + haiku-dnd-selection-value) + haiku-dnd-selection-value) + haiku-dnd-selection-value)))) (when selection-result (let ((field (cdr (assoc (car selection-result) message)))) (unless (cadr field) commit f5fadbbfec8c8f5d66fe0169c92096743102990e Author: Po Lu Date: Wed Jun 1 16:25:53 2022 +0800 Clean up text/uri-list mess inside the Dired drag-and-drop code * doc/lispref/frames.texi (Window System Selections): * etc/NEWS: Document new changes to `gui-get-selection'. * lisp/dired.el (dired-mouse-drag): Specify text/uri-list value explicitly. * lisp/select.el (gui-set-selection): Update doc string. (xselect-convert-to-text-uri-list): Update to handle either a single URL (as a string) or a vector of URLs, instead of file names. (xselect-uri-list-available-p): Likewise. * src/xselect.c (x_get_local_selection): Look in tem's text properties (if it is a string) for a local value before using tem itself. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 20e9c17f1f..13bd144115 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3943,6 +3943,13 @@ overlay or a pair of markers stands for text in the overlay or between the markers. The argument @var{data} may also be a vector of valid non-vector selection values. +If @var{data} is a string, then its text properties can specify values +used for individual data types. For example, if @var{data} has a +property named @code{text/uri-list}, then a call to +@code{gui-get-selection} with the data type @code{text/uri-list} will +result in the value of that property being used instead of @var{data} +itself. + This function returns @var{data}. @end deffn diff --git a/etc/NEWS b/etc/NEWS index 87cd41ec01..1233e245a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1909,6 +1909,11 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** 'gui-set-selection' can now specify different values for different data types. +If DATA is a string, then its text properties are searched for values +for each specific data type while the selection is being converted. + --- ** New eldoc function: 'elisp-eldoc-var-docstring-with-value'. This function includes the current value of the variable in eldoc display diff --git a/lisp/dired.el b/lisp/dired.el index 3f2e52e629..5a1fce860e 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1764,7 +1764,15 @@ when Emacs exits or the user drags another file.") (setq dired-last-dragged-remote-file filename) (add-hook 'kill-emacs-hook #'dired-remove-last-dragged-local-file)) - (gui-backend-set-selection 'XdndSelection filename) + (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) diff --git a/lisp/select.el b/lisp/select.el index dbe9633517..01e002db70 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -401,11 +401,16 @@ also be a string, which stands for the symbol with that name, but this is considered obsolete.) DATA may be a string, a symbol, or an integer. -The selection may also be a cons of two markers pointing to the same buffer, -or an overlay. In these cases, the selection is considered to be the text -between the markers *at whatever time the selection is examined*. -Thus, editing done in the buffer after you specify the selection -can alter the effective value of the selection. +The selection may also be a cons of two markers pointing to the +same buffer, or an overlay. In these cases, the selection is +considered to be the text between the markers *at whatever time +the selection is examined*. Thus, editing done in the buffer +after you specify the selection can alter the effective value of +the selection. If DATA is a string, then its text properties can +specify alternative values for different data types. For +example, the value of any property named `text/uri-list' will be +used instead of DATA itself when another program converts TYPE to +the target `text/uri-list'. The data may also be a vector of valid non-vector selection values. @@ -692,18 +697,15 @@ This function returns the string \"emacs\"." (user-real-login-name)) (defun xselect-convert-to-text-uri-list (_selection _type value) - (when (and (stringp value) - (file-exists-p value)) - (concat (url-encode-url - ;; Uncomment the following code code in a better world where - ;; people write correct code that adds the hostname to the URI. - ;; Since most programs don't implement this properly, we omit the - ;; hostname so that copying files actually works. Most properly - ;; written programs will look at WM_CLIENT_MACHINE to determine - ;; the hostname anyway. (format "file://%s%s\n" (system-name) - ;; (expand-file-name value)) - (concat "file://" (expand-file-name value))) - "\n"))) + (if (stringp value) + (concat (url-encode-url value) "\n") + (when (vectorp value) + (with-temp-buffer + (cl-loop for tem across value + do (progn + (insert (url-encode-url tem)) + (insert "\n"))) + (buffer-string))))) (defun xselect-convert-to-xm-file (selection _type value) (when (and (stringp value) @@ -716,8 +718,8 @@ This function returns the string \"emacs\"." "Return whether or not `text/uri-list' is a valid target for SELECTION. VALUE is the local selection value of SELECTION." (and (eq selection 'XdndSelection) - (stringp value) - (file-exists-p value))) + (or (stringp value) + (vectorp value)))) (defun xselect-convert-xm-special (_selection _type _value) "") diff --git a/src/xselect.c b/src/xselect.c index a414873594..5f2a0cf56d 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -399,7 +399,7 @@ static Lisp_Object x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, bool local_request, struct x_display_info *dpyinfo) { - Lisp_Object local_value; + Lisp_Object local_value, tem; Lisp_Object handler_fn, value, check; local_value = LOCAL_SELECTION (selection_symbol, dpyinfo); @@ -426,10 +426,21 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, if (CONSP (handler_fn)) handler_fn = XCDR (handler_fn); + tem = XCAR (XCDR (local_value)); + + if (STRINGP (tem)) + { + local_value = Fget_text_property (make_fixnum (0), + target_type, tem); + + if (!NILP (local_value)) + tem = local_value; + } + if (!NILP (handler_fn)) - value = call3 (handler_fn, - selection_symbol, (local_request ? Qnil : target_type), - XCAR (XCDR (local_value))); + value = call3 (handler_fn, selection_symbol, + (local_request ? Qnil : target_type), + tem); else value = Qnil; value = unbind_to (count, value);