;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
(eval-when-compile (require 'cl))
-;; The doubly linked list is implemented as a circular list
-;; with a dummy node first and last. The dummy node is used as
-;; "the dll" (or rather the dynamically bound `ewoc--current-dll').
-
-(defvar ewoc--current-dll)
-
+;; The doubly linked list is implemented as a circular list with a dummy
+;; node first and last. The dummy node is used as "the dll".
(defstruct (ewoc--node
(:type vector) ;ewoc--node-nth needs this
(:constructor nil)
(:constructor ewoc--node-create (start-marker data)))
left right data start-marker)
-(defun ewoc--node-next (node)
+(defun ewoc--node-next (dll node)
"Return the node after NODE, or nil if NODE is the last node."
(let ((R (ewoc--node-right node)))
- (unless (eq ewoc--current-dll R) R)))
+ (unless (eq dll R) R)))
-(defun ewoc--node-prev (node)
+(defun ewoc--node-prev (dll node)
"Return the node before NODE, or nil if NODE is the first node."
(let ((L (ewoc--node-left node)))
- (unless (eq ewoc--current-dll L) L)))
+ (unless (eq dll L) L)))
-(defun ewoc--node-nth (n)
- "Return the Nth node from the doubly linked list `ewoc--current-dll'.
+(defun ewoc--node-nth (dll n)
+ "Return the Nth node from the doubly linked list `dll'.
N counts from zero. If N is negative, return the -(N+1)th last element.
If N is out of range, return nil.
-Thus, (ewoc--node-nth 0) returns the first node,
-and (ewoc--node-nth -1) returns the last node."
+Thus, (ewoc--node-nth dll 0) returns the first node,
+and (ewoc--node-nth dll -1) returns the last node."
;; Presuming a node is ":type vector", starting with `left' and `right':
;; Branch 0 ("follow left pointer") is used when n is negative.
;; Branch 1 ("follow right pointer") is used otherwise.
(let* ((branch (if (< n 0) 0 1))
- (node (aref ewoc--current-dll branch)))
+ (node (aref dll branch)))
(if (< n 0) (setq n (- -1 n)))
- (while (and (not (eq ewoc--current-dll node)) (> n 0))
+ (while (and (not (eq dll node)) (> n 0))
(setq node (aref node branch))
(setq n (1- n)))
- (unless (eq ewoc--current-dll node) node)))
+ (unless (eq dll node) node)))
(defun ewoc-location (node)
"Return the start location of NODE."
(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
"Execute FORMS with ewoc--buffer selected as current buffer,
-`ewoc--current-dll' bound to the dll, and VARLIST bound as in a let*.
-`ewoc--current-dll' will be bound when VARLIST is initialized, but
+`dll' bound to the dll, and VARLIST bound as in a let*.
+`dll' will be bound when VARLIST is initialized, but
the current buffer will *not* have been changed.
Return value of last form in FORMS."
(let ((hnd (make-symbol "ewoc")))
`(let* ((,hnd ,ewoc)
- (ewoc--current-dll (ewoc--dll ,hnd))
+ (dll (ewoc--dll ,hnd))
,@varlist)
(with-current-buffer (ewoc--buffer ,hnd)
,@forms))))
(eq node (ewoc--footer ewoc)))
node))
-(defun ewoc--adjust (beg end node)
+(defun ewoc--adjust (beg end node dll)
;; "Manually reseat" markers for NODE and its successors (including footer
;; and dll), in the case where they originally shared start position with
;; BEG, to END. BEG and END are buffer positions describing NODE's left
(when (< beg end)
(let (m)
(while (and (= beg (setq m (ewoc--node-start-marker node)))
+ ;; The "dummy" node `dll' actually holds the marker that
+ ;; points to the end of the footer, so we check `dll'
+ ;; *after* reseating the marker.
(progn
(set-marker m end)
- (not (eq ewoc--current-dll node))))
+ (not (eq dll node))))
(setq node (ewoc--node-right node))))))
-(defun ewoc--insert-new-node (node data pretty-printer)
+(defun ewoc--insert-new-node (node data pretty-printer dll)
"Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER.
+Fourth arg DLL -- from `(ewoc--dll EWOC)' -- is for internal purposes.
Call PRETTY-PRINTER with point at NODE's start, thus pushing back
NODE and leaving the new node's start there. Return the new node."
(save-excursion
(ewoc--node-right elemnode) node
(ewoc--node-right (ewoc--node-left node)) elemnode
(ewoc--node-left node) elemnode)
- (ewoc--refresh-node pretty-printer elemnode)
+ (ewoc--refresh-node pretty-printer elemnode dll)
elemnode)))
-(defun ewoc--refresh-node (pp node)
+(defun ewoc--refresh-node (pp node dll)
"Redisplay the element represented by NODE using the pretty-printer PP."
(let ((inhibit-read-only t)
(m (ewoc--node-start-marker node))
;; Calculate and insert the string.
(goto-char m)
(funcall pp (ewoc--node-data node))
- (ewoc--adjust m (point) R)))
+ (ewoc--adjust m (point) R dll)))
(defun ewoc--wrap (func)
(lexical-let ((ewoc--user-pp func))
(unless header (setq header ""))
(unless footer (setq footer ""))
(setf (ewoc--node-start-marker dll) (copy-marker pos)
- foot (ewoc--insert-new-node dll footer hf-pp)
- head (ewoc--insert-new-node foot header hf-pp)
+ foot (ewoc--insert-new-node dll footer hf-pp dll)
+ head (ewoc--insert-new-node foot header hf-pp dll)
(ewoc--hf-pp new-ewoc) hf-pp
(ewoc--footer new-ewoc) foot
(ewoc--header new-ewoc) head))
"Enter DATA first in EWOC.
Return the new node."
(ewoc--set-buffer-bind-dll ewoc
- (ewoc-enter-after ewoc (ewoc--node-nth 0) data)))
+ (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data)))
(defun ewoc-enter-last (ewoc data)
"Enter DATA last in EWOC.
Return the new node."
(ewoc--set-buffer-bind-dll ewoc
- (ewoc-enter-before ewoc (ewoc--node-nth -1) data)))
+ (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data)))
(defun ewoc-enter-after (ewoc node data)
"Enter a new element DATA after NODE in EWOC.
Return the new node."
(ewoc--set-buffer-bind-dll ewoc
- (ewoc-enter-before ewoc (ewoc--node-next node) data)))
+ (ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
(defun ewoc-enter-before (ewoc node data)
"Enter a new element DATA before NODE in EWOC.
Return the new node."
(ewoc--set-buffer-bind-dll ewoc
- (ewoc--insert-new-node node data (ewoc--pretty-printer ewoc))))
+ (ewoc--insert-new-node node data (ewoc--pretty-printer ewoc) dll)))
(defun ewoc-next (ewoc node)
"Return the node in EWOC that follows NODE.
Return nil if NODE is nil or the last element."
(when node
(ewoc--filter-hf-nodes
- ewoc (let ((ewoc--current-dll (ewoc--dll ewoc)))
- (ewoc--node-next node)))))
+ ewoc (ewoc--node-next (ewoc--dll ewoc) node))))
(defun ewoc-prev (ewoc node)
"Return the node in EWOC that precedes NODE.
Return nil if NODE is nil or the first element."
(when node
(ewoc--filter-hf-nodes
- ewoc (let ((ewoc--current-dll (ewoc--dll ewoc)))
- (ewoc--node-prev node)))))
+ ewoc (ewoc--node-prev (ewoc--dll ewoc) node))))
(defun ewoc-nth (ewoc n)
"Return the Nth node.
;; Skip the header (or footer, if n is negative).
(setq n (if (< n 0) (1- n) (1+ n)))
(ewoc--filter-hf-nodes ewoc
- (let ((ewoc--current-dll (ewoc--dll ewoc)))
- (ewoc--node-nth n))))
+ (ewoc--node-nth (ewoc--dll ewoc) n)))
(defun ewoc-map (map-function ewoc &rest args)
"Apply MAP-FUNCTION to all elements in EWOC.
(ewoc--set-buffer-bind-dll-let* ewoc
((footer (ewoc--footer ewoc))
(pp (ewoc--pretty-printer ewoc))
- (node (ewoc--node-nth 1)))
+ (node (ewoc--node-nth dll 1)))
(save-excursion
(while (not (eq node footer))
(if (apply map-function (ewoc--node-data node) args)
- (ewoc--refresh-node pp node))
- (setq node (ewoc--node-next node))))))
+ (ewoc--refresh-node pp node dll))
+ (setq node (ewoc--node-next dll node))))))
(defun ewoc-delete (ewoc &rest nodes)
"Delete NODES from EWOC."
(when (eq last node)
(setf last nil (ewoc--last-node ewoc) nil))
(delete-region (ewoc--node-start-marker node)
- (ewoc--node-start-marker (ewoc--node-next node)))
+ (ewoc--node-start-marker (ewoc--node-next dll node)))
(set-marker (ewoc--node-start-marker node) nil)
(setf L (ewoc--node-left node)
R (ewoc--node-right node)
The PREDICATE is called with the element as its first argument. If any
ARGS are given they will be passed to the PREDICATE."
(ewoc--set-buffer-bind-dll-let* ewoc
- ((node (ewoc--node-nth 1))
+ ((node (ewoc--node-nth dll 1))
(footer (ewoc--footer ewoc))
(goodbye nil)
(inhibit-read-only t))
(while (not (eq node footer))
(unless (apply predicate (ewoc--node-data node) args)
(push node goodbye))
- (setq node (ewoc--node-next node)))
+ (setq node (ewoc--node-next dll node)))
(apply 'ewoc-delete ewoc goodbye)))
(defun ewoc-locate (ewoc &optional pos guess)
If POS points after the last element, the last node is returned.
If the EWOC is empty, nil is returned."
(unless pos (setq pos (point)))
- (ewoc--set-buffer-bind-dll-let* ewoc
- ((footer (ewoc--footer ewoc)))
+ (ewoc--set-buffer-bind-dll ewoc
(cond
;; Nothing present?
- ((eq (ewoc--node-nth 1) (ewoc--node-nth -1))
+ ((eq (ewoc--node-nth dll 1) (ewoc--node-nth dll -1))
nil)
;; Before second elem?
- ((< pos (ewoc--node-start-marker (ewoc--node-nth 2)))
- (ewoc--node-nth 1))
+ ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2)))
+ (ewoc--node-nth dll 1))
;; After one-before-last elem?
- ((>= pos (ewoc--node-start-marker (ewoc--node-nth -2)))
- (ewoc--node-nth -2))
+ ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2)))
+ (ewoc--node-nth dll -2))
;; We now know that pos is within a elem.
(t
;; Make an educated guess about which of the three known
;; node'es (the first, the last, or GUESS) is nearest.
- (let* ((best-guess (ewoc--node-nth 1))
+ (let* ((best-guess (ewoc--node-nth dll 1))
(distance (abs (- pos (ewoc--node-start-marker best-guess)))))
(when guess
(let ((d (abs (- pos (ewoc--node-start-marker guess)))))
(setq distance d)
(setq best-guess guess))))
- (let* ((g (ewoc--node-nth -1)) ;Check the last elem
+ (let* ((g (ewoc--node-nth dll -1)) ;Check the last elem
(d (abs (- pos (ewoc--node-start-marker g)))))
(when (< d distance)
(setq distance d)
(ewoc--node-start-marker best-guess))
;; Loop until we are exactly one node too far down...
(while (>= pos (ewoc--node-start-marker best-guess))
- (setq best-guess (ewoc--node-next best-guess)))
+ (setq best-guess (ewoc--node-next dll best-guess)))
;; ...and return the previous node.
- (ewoc--node-prev best-guess))
+ (ewoc--node-prev dll best-guess))
;; Pos is before best-guess
(t
(while (< pos (ewoc--node-start-marker best-guess))
- (setq best-guess (ewoc--node-prev best-guess)))
+ (setq best-guess (ewoc--node-prev dll best-guess)))
best-guess)))))))
(defun ewoc-invalidate (ewoc &rest nodes)
((pp (ewoc--pretty-printer ewoc)))
(save-excursion
(dolist (node nodes)
- (ewoc--refresh-node pp node)))))
+ (ewoc--refresh-node pp node dll)))))
(defun ewoc-goto-prev (ewoc arg)
"Move point to the ARGth previous element in EWOC.
(setq arg (1- arg)))
(while (and node (> arg 0))
(setq arg (1- arg))
- (setq node (ewoc--node-prev node)))
+ (setq node (ewoc--node-prev dll node)))
;; Never step above the first element.
(unless (ewoc--filter-hf-nodes ewoc node)
- (setq node (ewoc--node-nth 1)))
+ (setq node (ewoc--node-nth dll 1)))
(ewoc-goto-node ewoc node))))
(defun ewoc-goto-next (ewoc arg)
((node (ewoc-locate ewoc (point))))
(while (and node (> arg 0))
(setq arg (1- arg))
- (setq node (ewoc--node-next node)))
+ (setq node (ewoc--node-next dll node)))
;; Never step below the first element.
;; (unless (ewoc--filter-hf-nodes ewoc node)
- ;; (setq node (ewoc--node-nth -2)))
+ ;; (setq node (ewoc--node-nth dll -2)))
(ewoc-goto-node ewoc node)))
(defun ewoc-goto-node (ewoc node)
(ewoc--set-buffer-bind-dll-let* ewoc
((footer (ewoc--footer ewoc)))
(let ((inhibit-read-only t))
- (delete-region (ewoc--node-start-marker (ewoc--node-nth 1))
+ (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1))
(ewoc--node-start-marker footer))
(goto-char (ewoc--node-start-marker footer))
(let ((pp (ewoc--pretty-printer ewoc))
- (node (ewoc--node-nth 1)))
+ (node (ewoc--node-nth dll 1)))
(while (not (eq node footer))
(set-marker (ewoc--node-start-marker node) (point))
(funcall pp (ewoc--node-data node))
- (setq node (ewoc--node-next node)))))
+ (setq node (ewoc--node-next dll node)))))
(set-marker (ewoc--node-start-marker footer) (point))))
(defun ewoc-collect (ewoc predicate &rest args)
remaining arguments will be passed to PREDICATE."
(ewoc--set-buffer-bind-dll-let* ewoc
((header (ewoc--header ewoc))
- (node (ewoc--node-nth -2))
+ (node (ewoc--node-nth dll -2))
result)
(while (not (eq node header))
(if (apply predicate (ewoc--node-data node) args)
(push (ewoc--node-data node) result))
- (setq node (ewoc--node-prev node)))
+ (setq node (ewoc--node-prev dll node)))
(nreverse result)))
(defun ewoc-buffer (ewoc)
(setf (ewoc--node-data head) header
(ewoc--node-data foot) footer)
(save-excursion
- (ewoc--refresh-node hf-pp head)
- (ewoc--refresh-node hf-pp foot))))
+ (ewoc--refresh-node hf-pp head dll)
+ (ewoc--refresh-node hf-pp foot dll))))
\f
(provide 'ewoc)
HCoop / bpt / emacs.git / blobdiff