From c564bc93d68696dd6b1dc44933e23c1d24656e94 Mon Sep 17 00:00:00 2001 From: David Aspinall Date: Sun, 24 Sep 2006 15:05:35 +0000 Subject: Add buffer history browsing --- lib/bufhist.el | 302 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 302 insertions(+) create mode 100644 lib/bufhist.el (limited to 'lib/bufhist.el') diff --git a/lib/bufhist.el b/lib/bufhist.el new file mode 100644 index 00000000..83981251 --- /dev/null +++ b/lib/bufhist.el @@ -0,0 +1,302 @@ +;; bufhist.el --- keep read-only history of buffer contents for browsing + +;; Copyright (C) 2006 David Aspinall / University of Edinburgh + +;; Author: David Aspinall +;; License: GPL (GNU GENERAL PUBLIC LICENSE) +;; Keywords: tools +;; +;; $Id$ +;; +;; This file is distributed under the terms of the GNU General Public +;; License, Version 2. Find a copy of the GPL with your version of +;; GNU Emacs or Texinfo. +;; +;; This library implements a minor mode for which keeps a ring history of +;; buffer contents. Intended to be used for small buffers which are +;; intermittently updated (e.g. status panels/displays), for which history +;; browsing is useful. +;; + +;; TODO: a more PG-specific and efficient approach would be to keep +;; regions within a single buffer rather than copying strings in and out. +;; That way we could use cloned (indirect) buffers which allow independent +;; browsing of the history. +;; +;; FIXME: autoloading this doesn't work too well. +;; Advice on erase-buffer doesn't work. + +;;; First a function which ought to be in ring.el + +(defun bufhist-ring-update (ring index newitem) + "Update RING at position INDEX with NEWITEM." + (if (ring-empty-p ring) + (error "Accessing an empty ring") + (let* ((hd (car ring)) (ln (car (cdr ring))) (vec (cdr (cdr ring)))) + (aset vec (ring-index index hd ln (length vec)) newitem)))) + +;;; Now our code + +(defgroup bufhist nil + "In-memory history of buffer contents" + :group 'tools) + +(defcustom bufhist-ring-size 10 + "*Default size of buffer history ring." + :group 'bufhist + :type 'integer) + +(defvar bufhist-ring nil + "Ring history of buffer. Always non-empty.") + +(defvar bufhist-ring-pos nil + "Current position in ring history of buffer.") + +(defvar bufhist-lastswitch-modified-tick nil + "Value of (buffer-modified-tick) at last switch buffer.") + +(defvar bufhist-read-only-history t + "Whether history is editable.") + +(defvar bufhist-saved-mode-line-format nil + "Ordinary value of mode-line-format for this buffer.") + +(defconst bufhist-mode-line-format-entry + '(" [hist:" + (:eval (int-to-string (- (ring-length bufhist-ring) + bufhist-ring-pos))) "/" + (:eval (int-to-string (ring-length bufhist-ring))) "]")) + +(make-variable-buffer-local 'bufhist-ring) +(make-variable-buffer-local 'bufhist-ring-pos) +(make-variable-buffer-local 'bufhist-lastswitch-modified-tick) +(make-variable-buffer-local 'bufhist-read-only-history) + +(defun bufhist-get-buffer-contents () + "Return the stored representation of the current buffer contents." + ;; First: make all extents in the buffer duplicable to recreate them + (if (fboundp 'mapcar-extents) + (mapcar-extents (lambda (ext) + (set-extent-property ext 'duplicable t)))) + (cons (point) + (buffer-substring (point-max) (point-min)))) + +(fset 'bufhist-ordinary-erase-buffer (symbol-function 'erase-buffer)) +;(defalias 'bufhist-ordinary-erase-buffer 'erase-buffer) + +(defun bufhist-restore-buffer-contents (buf) + "Restore BUF as the contents of the current buffer." + (bufhist-ordinary-erase-buffer) + (insert (cdr buf)) + ;; don't count this as a buffer update + (setq bufhist-lastswitch-modified-tick (buffer-modified-tick)) + (goto-char (car buf))) + +(defun bufhist-checkpoint () + "Add buffer contents to the ring history. No action if not in bufhist mode." + (interactive) + (if bufhist-mode ;; safety + (ring-insert bufhist-ring (bufhist-get-buffer-contents)))) + +(defun bufhist-erase-buffer () + "Erase buffer contents, maybe running bufhist-before-change-function first." + ;; Unfortunately on XEmacs, erase-buffer doesn't call + ;; before-change-functions (it does on GNU Emacs) + ;; This would be easier with advice + (if (and + bufhist-mode + (string-match "XEmacs" emacs-version) + (memq 'bufhist-before-change-function before-change-functions)) + (let ((before-change-functions nil) + (after-change-functions nil)) + (bufhist-before-change-function))) + (erase-buffer)) + +(defun bufhist-checkpoint-and-erase () + "Add buffer contents to history then erase. Only erase if not in bufhist mode" + (interactive) + (bufhist-checkpoint) + (bufhist-erase-buffer)) + +(defun bufhist-switch-to-index (n &optional nosave browsing) + "Switch to position N in buffer history, maybe updating history. +If optional NOSAVE is non-nil, do not try to save current contents." + (if browsing + (message "History position %d of %d" + (- (ring-length bufhist-ring) n) + (ring-length bufhist-ring))) + (unless (equal n bufhist-ring-pos) + ;; we're moving to different position + (let ((tick (buffer-modified-tick))) + ;; Save changes back to history for most recent contents or for + ;; older contents if we have read-write history + (unless (or nosave + (and bufhist-read-only-history (not (eq bufhist-ring-pos 0))) + (equal tick bufhist-lastswitch-modified-tick)) + ;; If we're browsing away from position 0, checkpoint instead + ;; of updating. + ;; NB: logic here should ideally keep flag to say whether + ;; changes are "during" a browse or not. This is going + ;; to result in too many checkpoints if we have manual + ;; editing. + (if (and browsing (eq bufhist-ring-pos 0)) + ;(progn + (bufhist-checkpoint) + ; (setq n (1+ n))) + ;; Otherwise update in-position + (bufhist-ring-update bufhist-ring bufhist-ring-pos + (bufhist-get-buffer-contents)))) + (setq bufhist-lastswitch-modified-tick tick) + (let ((before-change-functions nil) + (buffer-read-only nil)) + (bufhist-restore-buffer-contents (ring-ref bufhist-ring n))) + (if bufhist-read-only-history + (setq buffer-read-only + (if (eq n 0) bufhist-normal-read-only t))) + (setq bufhist-ring-pos n) + (force-mode-line-update)))) + +(defun bufhist-first () + "Switch to most oldest buffer contents." + (interactive) + (bufhist-switch-to-index (1- (ring-length bufhist-ring)) nil 'browsing)) + +(defun bufhist-last () + "Switch to last (most recent; current) buffer contents." + (interactive) + (bufhist-switch-to-index 0 nil 'browsing)) + +(defun bufhist-prev (&optional n) + "Browse backward in the history of buffer contents." + (interactive "p") + (bufhist-switch-to-index + (mod (+ bufhist-ring-pos (or n 1)) + (ring-length bufhist-ring)) + nil 'browsing)) + +(defun bufhist-next (&optional n) + "Browse forward in the history of buffer contents." + (interactive "p") + (bufhist-prev (- (or n 1)))) + +(defun bufhist-delete () + "Delete the current item in the buffer history." + (interactive) + (unless (eq 0 bufhist-ring-pos) + (ring-remove bufhist-ring bufhist-ring-pos) + (bufhist-switch-to-index (1- bufhist-ring-pos) 'nosave))) + +;; FIXME: bug here, we get duplicated first item after clear +(defun bufhist-clear () + "Clear history." + (interactive) + (bufhist-switch-to-index 0 'nosave) + (setq bufhist-ring (make-ring (ring-size bufhist-ring))) + (setq bufhist-ring-pos 0) + (bufhist-checkpoint) + (setq bufhist-lastswitch-modified-tick (buffer-modified-tick))) + + +;; Setup functions + +(defun bufhist-init (&optional readwrite ringsize) + "Initialise a ring history for the current buffer. +The history will be read-only unless READWRITE is non-nil. +For read-only histories, edits to the buffer switch to the latest version. +The size defaults to `bufhist-ring-size'." + (interactive) + (setq bufhist-ring (make-ring (or ringsize bufhist-ring-size))) + (setq bufhist-normal-read-only buffer-read-only) + (setq bufhist-read-only-history (not readwrite)) + (setq bufhist-ring-pos 0) + (setq bufhist-saved-mode-line-format mode-line-format) + (bufhist-checkpoint) + (setq mode-line-format + (cons (cons 'bufhist-mode (list bufhist-mode-line-format-entry)) + ;; surely it's always a list, but in case not + (if (listp mode-line-format) + mode-line-format + (list mode-line-format)))) + (force-mode-line-update) + (make-local-variable 'before-change-functions) + (bufhist-set-readwrite readwrite)) + + +(defun bufhist-exit () + "Stop keeping ring history for current buffer." + (interactive) + (bufhist-switch-to-index 0) + (bufhist-set-readwrite t) + (setq mode-line-format bufhist-saved-mode-line-format) + (force-mode-line-update)) + + + + +(defun bufhist-set-readwrite (readwrite) + "Set `before-change-functions' for read-only history." + (if readwrite + ;; edit directly + (progn + (setq before-change-functions + (remq 'bufhist-before-change-function before-change-functions))) +; (if (string-match "XEmacs" emacs-version) +; (ad-disable-advice 'erase-buffer 'before 'bufhist-last-advice))) + ;; readonly history: switch to latest contents + (setq before-change-functions + (cons 'bufhist-before-change-function before-change-functions)))) +; (if (string-match "XEmacs" emacs-version) +; (ad-enable-advice 'erase-buffer 'before 'bufhist-last-advice)))) + +;; Restore the latest buffer contents before changes from elsewhere. + +(defun bufhist-before-change-function (&rest args) + "Restore the most recent contents of the buffer before changes." + (bufhist-switch-to-index 0)) + +;; On XEmacs, erase-buffer does not call before-change-function +;(if (string-match "XEmacs" emacs-version) +; (progn +; (defadvice erase-buffer (before bufhist-last-advice activate) +; (if (and bufhist-mode bufhist-read-only-history) +; (bufhist-last))) +; (ad-activate-on 'erase-buffer))) + + +;;; Minor mode + +;;;###autoload +(autoload 'bufhist-mode "bufhist" + "Minor mode retaining an in-memory history of the buffer contents.") + +(defconst bufhist-minor-mode-map + (let ((map (make-sparse-keymap))) + ;; (define-key map [mouse-2] 'bufhist-popup-menu) + (define-key map [(meta left)] 'bufhist-prev) + (define-key map [(meta right)] 'bufhist-next) + (define-key map [(meta up)] 'bufhist-first) + (define-key map [(meta down)] 'bufhist-last) + (define-key map [(meta c)] 'bufhist-clear) + (define-key map [(meta d)] 'bufhist-delete) + map) + "Keymap for `bufhist-minor-mode'.") + +(define-minor-mode bufhist-mode + "Minor mode retaining an in-memory history of the buffer contents. + +Commands:\\ +\\[bufhist-prev] bufhist-prev go back in history +\\[bufhist-next] bufhist-next go forward in history +\\[bufhist-first] bufhist-first go to first item in history +\\[bufhist-last] bufhist-last go to last (current) item in history. +\\[bufhist-clear] bufhist-clear clear history. +\\[bufhist-delete] bufhist-clear delete current item from history." + nil "" bufhist-minor-mode-map + :group 'bufhist + (if bufhist-mode + (bufhist-init) + (bufhist-exit))) + + + +(provide 'bufhist) -- cgit v1.2.3