102 lines
4.5 KiB
EmacsLisp
102 lines
4.5 KiB
EmacsLisp
;;; system.el --- System integration functions -*- lexical-binding: t; -*-
|
|
(defun my/system-cut (beg end)
|
|
"Cut region directly to system clipboard, bypassing the kill ring."
|
|
(interactive "r")
|
|
(my/system-copy beg end)
|
|
;; delete-region deletes without adding to the kill ring
|
|
(delete-region beg end))
|
|
|
|
(defun my/system-copy (beg end)
|
|
"Pure copy: Sends the active region directly to the system clipboard.
|
|
Absolutely zero interaction with the Emacs kill ring."
|
|
(interactive "r")
|
|
(unless (region-active-p)
|
|
(user-error "No active region to copy"))
|
|
(let ((text (buffer-substring-no-properties beg end)))
|
|
(if (display-graphic-p)
|
|
;; Low-level GUI primitive: talks directly to the OS clipboard manager
|
|
(gui-backend-set-selection 'CLIPBOARD text)
|
|
;; TUI Fallback via Clipetty
|
|
(if (fboundp 'clipetty-set-selection)
|
|
(clipetty-set-selection text)
|
|
(error "Clipetty not loaded")))
|
|
(deactivate-mark)
|
|
(message "Copied to system clipboard (pure)")))
|
|
|
|
(defun my/system-paste ()
|
|
"Pure paste: Inserts text directly from the system clipboard.
|
|
Never falls back to or checks the Emacs kill ring."
|
|
(interactive)
|
|
(if (display-graphic-p)
|
|
(let ((text (or (gui-get-selection 'CLIPBOARD)
|
|
(gui-get-selection 'PRIMARY)
|
|
(when (executable-find "wl-paste")
|
|
(let ((val (shell-command-to-string "wl-paste -n -t text/plain")))
|
|
(unless (string-empty-p val) val))))))
|
|
(if text
|
|
(insert text)
|
|
(user-error "System clipboard is empty")))
|
|
;; TUI Fallback
|
|
(message "In a terminal, use your terminal emulator's native paste shortcut (e.g., Ctrl-Shift-V).")))
|
|
|
|
(defun my/system-paste-via-yank ()
|
|
"Pure paste: Overwrites the kill ring with clipboard data and triggers local yank."
|
|
(interactive)
|
|
(let ((text (or (gui-get-selection 'CLIPBOARD)
|
|
(gui-get-selection 'PRIMARY)
|
|
(when (executable-find "wl-paste")
|
|
(when (executable-find "wl-paste")
|
|
(let ((val (shell-command-to-string "wl-paste -n -t text/plain")))
|
|
(unless (string-empty-p val) val))))
|
|
nil)))
|
|
(if text
|
|
(progn
|
|
;; Forcibly stage to the kill ring. With kill-ring-max=1, this replaces everything.
|
|
(kill-new text)
|
|
;; Resolve the context-aware yank command (handles terminal wrappers automatically)
|
|
(let ((local-yank (key-binding (kbd "C-y"))))
|
|
(if (commandp local-yank)
|
|
(call-interactively local-yank)
|
|
(call-interactively 'yank))))
|
|
(user-error "System clipboard is empty"))))
|
|
|
|
(defun my/sync-clipboard-to-kill-ring ()
|
|
"Explicitly pull the system clipboard into the Emacs kill ring without pasting."
|
|
(interactive)
|
|
(let ((text (or (gui-get-selection 'CLIPBOARD)
|
|
(gui-get-selection 'PRIMARY)
|
|
(when (executable-find "wl-paste")
|
|
(when (executable-find "wl-paste")
|
|
(let ((val (shell-command-to-string "wl-paste -n -t text/plain")))
|
|
(unless (string-empty-p val) val))))
|
|
nil)))
|
|
(if text
|
|
(progn
|
|
(kill-new text)
|
|
(message "System clipboard staged to kill ring."))
|
|
(user-error "System clipboard is empty"))))
|
|
|
|
(defun my/mc-copy-regions-as-block ()
|
|
"Copy all active multiple-cursors regions joined by newlines into the kill ring."
|
|
(interactive)
|
|
(if (and (bound-and-true-p multiple-cursors-mode)
|
|
(use-region-p))
|
|
(let ((strings (mapcar (lambda (cursor)
|
|
(let ((beg (mc/cursor-beg cursor))
|
|
(end (mc/cursor-end cursor)))
|
|
(buffer-substring-no-properties beg end)))
|
|
(mc/all-fake-cursors))))
|
|
;; Add the main cursor's region as well
|
|
(push (buffer-substring-no-properties (region-beginning) (region-end)) strings)
|
|
;; Sort by position so they match document order
|
|
(setq strings (mapcar #'cdr
|
|
(sort (cl-mapcar #'cons
|
|
(cons (point) (mapcar #'mc/cursor-beg (mc/all-fake-cursors)))
|
|
strings)
|
|
(lambda (a b) (< (car a) (car b))))))
|
|
(kill-new (string-join strings "\n"))
|
|
(message "Copied %d cursor regions as a block." (length strings)))
|
|
(message "No active multiple-cursors regions to copy.")))
|
|
|
|
(provide 'system)
|