;; tether.el --- Tether -*- lexical-binding: t -*- ;; Copyright (C) 2025 Tyler Triplett ;; License: GNU GPL 3.0 or later <https://www.gnu.org/licenses/gpl-3.0.html> ;; This 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. ;; This program 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. ;;; Commentary: ;; Unilaterally 'tether' a buffers life to a frame, really only useful with ;; emacsclient. ;;; Rational: ;; I wanted to use Emacs as a terminal emulator. ;;; Usage: ;; Call M-x tether! to tether the current buffer to the current frame, or ;; (tether! 'buffer-name') to tether any buffer to the current frame. A buffer ;; may only be tethered to one frame. ;; Tethers can be broken with M-x tether-break!, or can be broken with ;; (tether-break! 'buffer-name'). This requires the current frame owns the ;; tether. ;;; Code: (defvar tether-name "!" "The suffix used.") (defvar tether-no-confirm nil "No confirmation when killing buffer.") (defvar tether--global-buffers nil "Used to track currently tethered buffers. Prevents a buffer from being tethered to multiple buffers.") (defmacro tether--thread-last (x &rest forms) "Thread last X into FORMS." (if (null forms) x `(tether--thread-last ,(if (listp (car forms)) `(,@(car forms) ,x) `(,(car forms) ,x)) ,@(cdr forms)))) (defun tether--local () "Return \='tether--local." (frame-parameter nil 'tether--local)) (defun tether--erase (v l) "Make a new list from L that does not contain any V." (cond ((null l) '()) ((equal v (car l)) (tether--erase v (cdr l))) (t (cons (car l) (tether--erase v (cdr l)))))) (defun tether--contains? (v l) "Return t when V in L." (cond ((null l) nil) ((equal v (car l)) t) (t (tether--contains? v (cdr l))))) (defun tether--local-push! (v) "Push V onto \='teather-buffers." (tether--thread-last (tether--local) (cons v) (set-frame-parameter nil 'tether--local))) (defun tether--local-erase! (v) "Erase buffer V to frame list." (tether--thread-last (tether--local) (tether--erase v) (set-frame-parameter nil 'tether--local))) (defun tether--global-push! (n) "Add buffer N to global list." (tether--thread-last tether--global-buffers (cons n) (setq tether--global-buffers))) (defun tether--global-erase! (n) "Erase buffer N to global list." (tether--thread-last tether--global-buffers (tether--erase n) (setq tether--global-buffers))) (defun tether--drop-<NUM> (s) "Drops <NUM> from S." (if (string-match "\\(.*\\)<[0-9]+>$" s) (match-string 1 s) s)) (defun tether--drop-tether-name (s) "Drops tether-name from S." (let ((pattern (concat (regexp-quote tether-name) "$"))) (if (string-match pattern s) (replace-match "" t t s) s))) (defun tether--drop-name (s) "Create non-tethered buffer name from S." (tether--thread-last s tether--drop-<NUM> tether--drop-tether-name generate-new-buffer-name)) (defun tether--cleanup-on-delete (_frame) "Kill all tethered buffers when a frame is deleted." (let ((buffs (tether--local))) (when buffs (let ((kill-buffer-query-functions (unless tether-no-confirm kill-buffer-query-functions))) (mapc (lambda (b) (when (get-buffer b) (kill-buffer b)) (tether--global-erase! b)) buffs))))) (defgroup tether nil "Tether buffers to frames." :group 'convenience :prefix "tether-") ;;;###autoload (define-minor-mode tether-mode "Minor mode that enables buffer tethering to frames." :global t :lighter " #\\! " :group 'tether (if tether-mode (add-hook 'delete-frame-functions #'tether--cleanup-on-delete) (progn (mapc (lambda (frame) (with-selected-frame frame (mapc #'tether-break! (copy-sequence (tether--local))))) (frame-list)) (remove-hook 'delete-frame-functions #'tether--cleanup-on-delete)))) ;;;###autoload (defun tether! (&optional n) "Tether current buffer or N." (interactive) (if tether-mode (let* ((name (or n (buffer-name))) (new-name (generate-new-buffer-name (concat (tether--drop-<NUM> name) tether-name)))) (if (not (tether--contains? name tether--global-buffers)) (with-current-buffer name (rename-buffer new-name) (tether--global-push! new-name) (tether--local-push! new-name) (message "Tethered!") new-name) (message "Already tethered"))) (message "Tether mode disabled"))) ;;;###autoload (defun tether-break! (&optional n) "Break tether for current buffer or N." (interactive) (let* ((name (or n (buffer-name))) (local (tether--local))) (cond ((tether--contains? name local) (progn (tether--global-erase! name) (tether--local-erase! name) (with-current-buffer name (rename-buffer (tether--drop-name name)) (message "Broke tether")))) ((tether--contains? name tether--global-buffers) (message "Tethered to a different frame")) (t (message "Not tethered"))))) (provide 'tether) ;;; tether.el ends here