countvajhula / buffer-ring / 73

;;; buffer-ring.el --- Rings and tori for buffer navigation -*- lexical-binding: t -*-

;; Author: Mike Mattie <codermattie@gmail.com>

;;         Sid Kasivajhula <sid@countvajhula.com>

;; Maintainer: Sid Kasivajhula <sid@countvajhula.com>

;; URL: https://github.com/countvajhula/buffer-ring

;; Created: 2009-4-16

;; Version: 0.3.4

;; Package-Requires: ((emacs "25.1") (dynaring "0.3"))

;; This file is NOT a part of Gnu Emacs.

;; This work is "part of the world."  You are free to do whatever you

;; like with it and it isn't owned by anybody, not even the

;; creators.  Attribution would be appreciated and is a valuable

;; contribution in itself, but it is not strictly necessary nor

;; required.  If you'd like to learn more about this way of doing

;; things and how it could lead to a peaceful, efficient, and creative

;; world, and how you can help, visit https://drym.org.

;;

;; This paradigm transcends traditional legal and economic systems, but

;; for the purposes of any such systems within which you may need to

;; operate:

;;

;; This is free and unencumbered software released into the public domain.

;; The authors relinquish any copyright claims on this work.

;;; Commentary:

;; Rings of buffers and tori of buffer rings.

;;; Code:

(defconst buffer-ring-version "0.3.4")

(require 'seq)     ; for `seq-*' on older Emacs

(require 'subr-x)  ; for `string-join' on older Emacs

(require 'dynaring)

(defconst buffer-ring-default-ring-name "default")

;;

;; default keymap

;;

;;;###autoload

(define-minor-mode buffer-ring-mode

  "Minor mode to modulate keybindings in buffer-ring mode."

  :lighter " buffer-ring"

  :global t

  :group 'buffer-ring

  :keymap

  (let ((buffer-ring-map (make-sparse-keymap)))

    (define-key buffer-ring-map (kbd "C-c C-b l") #'buffer-ring-list-buffers)

    (define-key buffer-ring-map (kbd "C-c C-b r") #'buffer-ring-torus-list-rings)

    (define-key buffer-ring-map (kbd "C-c C-b w") #'buffer-ring-show-name)

    (define-key buffer-ring-map (kbd "C-c C-b a") #'buffer-ring-add)

    (define-key buffer-ring-map (kbd "C-c C-b d") #'buffer-ring-delete)

    (define-key buffer-ring-map (kbd "C-c C-b c") #'buffer-ring-drop-buffer)

    (define-key buffer-ring-map (kbd "C-c C-b f") #'buffer-ring-next-buffer)

    (define-key buffer-ring-map (kbd "C-c C-b b") #'buffer-ring-prev-buffer)

    (define-key buffer-ring-map (kbd "C-c C-b n") #'buffer-ring-torus-next-ring)

    (define-key buffer-ring-map (kbd "C-c C-b p") #'buffer-ring-torus-prev-ring)

    (define-key buffer-ring-map (kbd "C-c C-b e") #'buffer-ring-torus-delete-ring)

    buffer-ring-map)

(defvar buffer-ring-torus (dynaring-make)

  "A global ring of all the buffer rings.  A torus I believe.")

(defun buffer-ring-initialize ()

  "Set up any hooks needed for buffer rings."

  (interactive)

  ;; TODO: if we want to automatically maintain a "primary"

  ;; ring, we may also need to hook into buffer-list-changed-hook

  ;; or maybe find-file-hook in addition here

  ;; TODO: should this be buffer-local? in that case it can

  ;; be added at the time that the buffer is adding to a ring

  ;; after we bury a buffer, we may arrive at some arbitrary buffer.

  ;; as this happens "out of band" wrt the buffer ring interfaces,

  ;; we need to explicitly synchronize this arrival buffer with its

  ;; buffer rings, just like in the case of a direct visit to that

  ;; buffer via switch-to-buffer.

(defun buffer-ring-disable ()

  "Remove hooks, etc."

  (interactive)

;;

;;  buffer ring structure

;;

(defun buffer-ring-make-ring (name)

  "Construct a buffer ring with the name NAME.

A buffer ring is simply a labeled dynamic ring data structure

whose members are expected to be buffers."

(defun buffer-ring-ring-name (buffer-ring)

  "An accessor to get the name of a BUFFER-RING."

(defun buffer-ring-ring-ring (buffer-ring)

  "... Hello?

An accessor for the dynamic ring component of the BUFFER-RING."

;;

;; buffer rings registry

;;

;; TODO: use buffer local variables instead?

(defvar buffer-ring-rings

  (make-hash-table)

  "Buffer to rings hash.")

(defun buffer-ring-registry-get-key (buffer)

  "Key to use for BUFFER in the buffer registry."

(defun buffer-ring--parse-buffer (buffer)

  "Extract the buffer object indicated by BUFFER.

BUFFER could be either be the name of the buffer (a string)

or a buffer object, or nil.  In the last case, this evaluates to

the current buffer."

(defun buffer-ring-get-rings (&optional buffer)

  "All rings that BUFFER is part of."

(defun buffer-ring-register-ring (buffer bfr-ring)

  "Register that BUFFER has been added to BFR-RING."

(defun buffer-ring-registry-delete-ring (buffer bfr-ring)

  "Delete BFR-RING from the list of rings for BUFFER.

This does NOT delete the buffer from the ring, only the ring

identifier from the buffer.  It should only be called either

as part of doing the former or when deleting the ring entirely."

(defun buffer-ring-registry-drop-ring (bfr-ring)

  "Drop BFR-RING from the registry of rings.

This should only be called when deleting the ring entirely."

;;

;; buffer ring interface

;;

(defun buffer-ring-size (&optional bfr-ring)

  "Return the number of buffers in BFR-RING.

If no buffer ring is specified, this defaults to the current ring.  If

there is no active buffer ring, it returns -1 so that you can always

use a numeric operator."

(defun buffer-ring--add (buffer bfr-ring)

  "Add BUFFER to BFR-RING."

(defun buffer-ring-add (ring-name &optional buffer)

  "Add the BUFFER to the ring with name RING-NAME.

It will prompt for the ring to add the buffer to.  If no BUFFER

is provided it assumes the current buffer."

  (interactive

                   nil

                   nil

                  nil)

      ;; if we are attempting to add the _current_ buffer to

      ;; a ring, switch to the ring in any case, for consistency

(defun buffer-ring-delete (&optional buffer)

  "Delete BUFFER from the current ring.

If no buffer is specified, it assumes the current buffer.

This modifies the ring, it does not kill the buffer."

  (interactive)

(defun buffer-ring-drop-buffer ()

  "Drop buffer from all rings.

Not to be confused with the little-known evil cousin

to the koala buffer."

  (interactive)

        ;; TODO: this may muddle torus recency

    ;; remove the buffer from the buffer ring registry

(defun buffer-ring-list-buffers ()

  "List the buffers in the current buffer ring."

  (interactive)

(defun buffer-ring--rotate (direction)

  "Rotate the buffer ring.

DIRECTION must be a function, either `dynaring-rotate-left` (to rotate

left) or `dynaring-rotate-right` (to rotate right)."

(defun buffer-ring-prev-buffer ()

  "Switch to the previous buffer in the buffer ring."

  (interactive)

(defun buffer-ring-next-buffer ()

  "Switch to the previous buffer in the buffer ring."

  (interactive)

(defun buffer-ring-rotate-to-buffer (buffer)

  "Rotate the buffer ring until BUFFER is at head.

This differs from simply switching to the buffer in that the latter

results in a change in ordering while the present action preserves the

current ordering of buffers in the ring."

  (interactive)

(defun buffer-ring--bury-window-buffer (&optional _kill window)

  "An advice function to move a buffer to the back of the ring.

This simply adapts the `buffer-ring-bury-buffer` advice function to

the `quit-window` interface, so that quiting a WINDOW buries the

associated buffer."

(defun buffer-ring-bury-buffer (&optional buffer)

  "An advice function to move a buffer to the back of the ring.

When BUFFER is buried (e.g. via `q` on a popup window), this ensures

that all rings containing it move it to the \"back\" of the ring, in

terms of recency."

    ;; if it isn't part of any rings, we don't need

    ;; to do anything

(defun buffer-ring-synchronize-buffer (&rest _args)

  "Keep buffer rings updated when buffers are visited.

When a buffer is visited directly without rotating to it, this advice

function switches to the most recent ring (if any) containing the buffer,

promoting both the ring as well as the buffer to the head position in

their containing rings, while accounting for recency.

_ARGS are the arguments that the advised function was invoked with."

    ;; if it's already at the head of the current ring,

    ;; we probably arrived here via a buffer-ring interface

    ;; and don't need to do anything in that case

        ;; if it isn't part of any rings, we don't need

        ;; to do anything

            ;; switch to the most recent ring containing the buffer

(defun buffer-ring-surface-ring (&optional bfr-ring)

  "Make BFR-RING the most recent ring in all member buffers.

We'd want to do this each time the ring becomes current, so that

ring recency is consistent across the board."

(defun buffer-ring-surface-buffer (&optional buffer)

  "Ensure the buffer is at head position in all rings of which it is a member.

We'd want to do this each time the BUFFER becomes current, so that

buffer recency is consistent across the board."

    ;; if the buffer isn't on any rings, this is a no-op

      ;; re(break)insert the buffer

      ;; in all of its associated rings

      ;; note that if the buffer is already at the head,

      ;; this will have no effect on the structure of the ring

;;

;; buffer torus interface

;;

(defun buffer-ring-torus--create-ring (name)

  "Create ring with name NAME."

(defun buffer-ring-torus--find-ring (name)

  "Find a ring with name NAME."

                                         (lambda (r)

(defun buffer-ring-torus-get-ring (name)

  "Find or create a buffer ring with name NAME.

The buffer-ring is returned."

(defun buffer-ring-torus-switch-to-ring (name)

  "Switch to ring NAME.

Inserts the ring at the head of the torus and \"surfaces\" it

in all of its member buffers so it reflects as the most recent.

This doesn't perform any tangible actions in connection with

the change of ring (that should be done alongside)."

  (interactive "sSwitch to ring ? ")

                                         (lambda (r)

        ;; insert the ring at the head of the torus

        ;; take accompanying actions, e.g. switch to the head

        ;; buffer and surface the ring in all buffers

(defun buffer-ring-current-ring ()

  "Get the current (active) buffer ring."

(defun buffer-ring-current-ring-name ()

  "Get the name of the current buffer ring."

(defun buffer-ring-show-name ()

  "Display name of current ring."

  (interactive)

(defun buffer-ring-current-buffer (&optional bfr-ring)

  "Current buffer in BFR-RING."

(defun buffer-ring-switch-to-buffer (buffer)

  "Switch to BUFFER while keeping rings consistent."

(defun buffer-ring-synchronize-ring (bfr-ring)

  "Perform any actions in connection with switching to a new ring.

At the moment, this switches to the head buffer in BFR-RING

\(the new ring), and surfaces that ring in all of its member

buffers."

  ;; Switch to the head buffer in the new ring.

      ;; If the new ring is empty, don't switch buffer.

      ;; Note that if the original buffer is in the new ring,

      ;; it would typically already be at the head due to buffer ↔ ring

      ;; synchrony and this would have no effect. But in the case

      ;; where (a) we visit a buffer "out of band," i.e. not via a

      ;; buffer ring interface, or (b) when the buffer ring is first

      ;; created, the rings may not already be synchronized with the

      ;; actual buffer state, i.e. the current buffer may not be at

      ;; head position in its rings. In such cases, we reorient around

      ;; the actual current buffer rather than switch to the ring's

      ;; current head buffer.

  ;; surface the ring in all of its member buffers

  ;; so it reflects as most recent

(defun buffer-ring-torus--rotate (direction)

  "Rotate the buffer ring torus.

DIRECTION must be a function, either `dynaring-rotate-left` (to rotate

left) or `dynaring-rotate-right` (to rotate right)."

           nil)

           t)

          (t

           ;; rotate past any empties

                                      (lambda (bfr-ring)

                                        ;; we want to rotate at least once

(defun buffer-ring-torus-next-ring ()

  "Switch to the previous buffer in the buffer ring."

  (interactive)

(defun buffer-ring-torus-prev-ring ()

  "Switch to the previous buffer in the buffer ring."

  (interactive)

(defun buffer-ring-torus-list-rings ()

  "List the buffer rings in the buffer torus."

  (interactive)

(defun buffer-ring-torus-delete-ring (&optional ring-name)

  "Delete the buffer ring with name RING-NAME.

If no name is specified, this deletes the current ring."

  (interactive

                 nil

                 nil

(provide 'buffer-ring)

;;; buffer-ring.el ends here