Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer |
5b467bf4 | 2 | |
0111ab41 JB |
3 | ;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 04 |
4 | ;; Free Software Foundation | |
5b467bf4 SM |
5 | |
6 | ;; Author: Per Cederqvist <ceder@lysator.liu.se> | |
7 | ;; Inge Wallin <inge@lysator.liu.se> | |
8 | ;; Maintainer: monnier@gnu.org | |
9 | ;; Created: 3 Aug 1992 | |
10 | ;; Keywords: extensions, lisp | |
11 | ||
12 | ;; This file is part of GNU Emacs. | |
13 | ||
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation; either version 2, or (at your option) | |
17 | ;; any later version. | |
18 | ||
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
26 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
27 | ;; Boston, MA 02111-1307, USA. | |
28 | ||
29 | ;;; Commentary: | |
30 | ||
31 | ;; Ewoc Was Once Cookie | |
32 | ;; But now it's Emacs' Widget for Object Collections | |
33 | ||
34 | ;; As the name implies this derives from the `cookie' package (part | |
10c471e6 | 35 | ;; of Elib). The changes are pervasive though mostly superficial: |
5b467bf4 | 36 | |
10c471e6 | 37 | ;; - uses CL (and its `defstruct') |
5b467bf4 SM |
38 | ;; - separate from Elib. |
39 | ;; - uses its own version of a doubly-linked list which allows us | |
40 | ;; to merge the elib-wrapper and the elib-node structures into ewoc-node | |
41 | ;; - dropping functions not used by PCL-CVS (the only client of ewoc at the | |
42 | ;; time of writing) | |
43 | ;; - removing unused arguments | |
44 | ;; - renaming: | |
45 | ;; elib-node ==> ewoc--node | |
46 | ;; collection ==> ewoc | |
47 | ;; tin ==> ewoc--node | |
48 | ;; cookie ==> data or element or elem | |
49 | ||
50 | ;; Introduction | |
51 | ;; ============ | |
52 | ;; | |
53 | ;; Ewoc is a package that implements a connection between an | |
54 | ;; dll (a doubly linked list) and the contents of a buffer. | |
55 | ;; Possible uses are dired (have all files in a list, and show them), | |
56 | ;; buffer-list, kom-prioritize (in the LysKOM elisp client) and | |
57 | ;; others. pcl-cvs.el uses ewoc.el. | |
58 | ;; | |
59 | ;; Ewoc can be considered as the `view' part of a model-view-controller. | |
60 | ;; | |
61 | ;; A `element' can be any lisp object. When you use the ewoc | |
62 | ;; package you specify a pretty-printer, a function that inserts | |
63 | ;; a printable representation of the element in the buffer. (The | |
64 | ;; pretty-printer should use "insert" and not | |
65 | ;; "insert-before-markers"). | |
66 | ;; | |
67 | ;; A `ewoc' consists of a doubly linked list of elements, a | |
68 | ;; header, a footer and a pretty-printer. It is displayed at a | |
69 | ;; certain point in a certain buffer. (The buffer and point are | |
70 | ;; fixed when the ewoc is created). The header and the footer | |
71 | ;; are constant strings. They appear before and after the elements. | |
5b467bf4 SM |
72 | ;; |
73 | ;; Ewoc does not affect the mode of the buffer in any way. It | |
74 | ;; merely makes it easy to connect an underlying data representation | |
75 | ;; to the buffer contents. | |
76 | ;; | |
77 | ;; A `ewoc--node' is an object that contains one element. There are | |
10c471e6 SM |
78 | ;; functions in this package that given an ewoc--node extract the data, or |
79 | ;; give the next or previous ewoc--node. (All ewoc--nodes are linked together | |
80 | ;; in a doubly linked list. The `previous' ewoc--node is the one that appears | |
5b467bf4 SM |
81 | ;; before the other in the buffer.) You should not do anything with |
82 | ;; an ewoc--node except pass it to the functions in this package. | |
83 | ;; | |
84 | ;; An ewoc is a very dynamic thing. You can easily add or delete elements. | |
85 | ;; You can apply a function to all elements in an ewoc, etc, etc. | |
86 | ;; | |
87 | ;; Remember that an element can be anything. Your imagination is the | |
88 | ;; limit! It is even possible to have another ewoc as an | |
89 | ;; element. In that way some kind of tree hierarchy can be created. | |
90 | ;; | |
91 | ;; Full documentation will, God willing, soon be available in a | |
92 | ;; Texinfo manual. | |
93 | ||
94 | ;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help | |
95 | ;; you find all the exported functions: | |
a1506d29 | 96 | ;; |
cb3430a1 | 97 | ;; (defun ewoc-create (pretty-printer &optional header footer) |
5b467bf4 | 98 | ;; (defalias 'ewoc-data 'ewoc--node-data) |
10c471e6 | 99 | ;; (defun ewoc-location (node) |
5b467bf4 SM |
100 | ;; (defun ewoc-enter-first (ewoc data) |
101 | ;; (defun ewoc-enter-last (ewoc data) | |
102 | ;; (defun ewoc-enter-after (ewoc node data) | |
103 | ;; (defun ewoc-enter-before (ewoc node data) | |
104 | ;; (defun ewoc-next (ewoc node) | |
105 | ;; (defun ewoc-prev (ewoc node) | |
106 | ;; (defun ewoc-nth (ewoc n) | |
107 | ;; (defun ewoc-map (map-function ewoc &rest args) | |
108 | ;; (defun ewoc-filter (ewoc predicate &rest args) | |
44946a4c | 109 | ;; (defun ewoc-locate (ewoc &optional pos guess) |
5b467bf4 | 110 | ;; (defun ewoc-invalidate (ewoc &rest nodes) |
44946a4c SM |
111 | ;; (defun ewoc-goto-prev (ewoc arg) |
112 | ;; (defun ewoc-goto-next (ewoc arg) | |
5b467bf4 SM |
113 | ;; (defun ewoc-goto-node (ewoc node) |
114 | ;; (defun ewoc-refresh (ewoc) | |
115 | ;; (defun ewoc-collect (ewoc predicate &rest args) | |
116 | ;; (defun ewoc-buffer (ewoc) | |
cb3430a1 SM |
117 | ;; (defun ewoc-get-hf (ewoc) |
118 | ;; (defun ewoc-set-hf (ewoc header footer) | |
5b467bf4 SM |
119 | |
120 | ;; Coding conventions | |
121 | ;; ================== | |
122 | ;; | |
123 | ;; All functions of course start with `ewoc'. Functions and macros | |
124 | ;; starting with the prefix `ewoc--' are meant for internal use, | |
125 | ;; while those starting with `ewoc-' are exported for public use. | |
126 | ;; There are currently no global or buffer-local variables used. | |
127 | ||
128 | ||
129 | ;;; Code: | |
130 | ||
131 | (eval-when-compile (require 'cl)) ;because of CL compiler macros | |
132 | ||
133 | ;; The doubly linked list is implemented as a circular list | |
134 | ;; with a dummy node first and last. The dummy node is used as | |
135 | ;; "the dll" (or rather is the dll handle passed around). | |
136 | ||
137 | (defstruct (ewoc--node | |
138 | (:type vector) ;required for ewoc--node-branch hack | |
139 | (:constructor ewoc--node-create (start-marker data))) | |
140 | left right data start-marker) | |
141 | ||
21311ac9 SM |
142 | (defalias 'ewoc--node-branch 'aref |
143 | "Get the left (CHILD=0) or right (CHILD=1) child of the NODE. | |
144 | ||
145 | \(fn NODE CHILD)") | |
5b467bf4 SM |
146 | |
147 | (defun ewoc--dll-create () | |
148 | "Create an empty doubly linked list." | |
149 | (let ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST))) | |
150 | (setf (ewoc--node-right dummy-node) dummy-node) | |
151 | (setf (ewoc--node-left dummy-node) dummy-node) | |
152 | dummy-node)) | |
153 | ||
154 | (defun ewoc--node-enter-before (node elemnode) | |
155 | "Insert ELEMNODE before NODE in a DLL." | |
156 | (assert (and (null (ewoc--node-left elemnode)) (null (ewoc--node-right elemnode)))) | |
157 | (setf (ewoc--node-left elemnode) (ewoc--node-left node)) | |
158 | (setf (ewoc--node-right elemnode) node) | |
159 | (setf (ewoc--node-right (ewoc--node-left node)) elemnode) | |
160 | (setf (ewoc--node-left node) elemnode)) | |
161 | ||
162 | (defun ewoc--node-enter-first (dll node) | |
163 | "Add a free floating NODE first in DLL." | |
164 | (ewoc--node-enter-before (ewoc--node-right dll) node)) | |
165 | ||
166 | (defun ewoc--node-enter-last (dll node) | |
167 | "Add a free floating NODE last in DLL." | |
168 | (ewoc--node-enter-before dll node)) | |
169 | ||
170 | (defun ewoc--node-next (dll node) | |
171 | "Return the node after NODE, or nil if NODE is the last node." | |
172 | (unless (eq (ewoc--node-right node) dll) (ewoc--node-right node))) | |
173 | ||
174 | (defun ewoc--node-prev (dll node) | |
175 | "Return the node before NODE, or nil if NODE is the first node." | |
176 | (unless (eq (ewoc--node-left node) dll) (ewoc--node-left node))) | |
177 | ||
178 | (defun ewoc--node-delete (node) | |
179 | "Unbind NODE from its doubly linked list and return it." | |
180 | ;; This is a no-op when applied to the dummy node. This will return | |
181 | ;; nil if applied to the dummy node since it always contains nil. | |
182 | (setf (ewoc--node-right (ewoc--node-left node)) (ewoc--node-right node)) | |
183 | (setf (ewoc--node-left (ewoc--node-right node)) (ewoc--node-left node)) | |
184 | (setf (ewoc--node-left node) nil) | |
185 | (setf (ewoc--node-right node) nil) | |
186 | node) | |
187 | ||
188 | (defun ewoc--node-nth (dll n) | |
189 | "Return the Nth node from the doubly linked list DLL. | |
190 | N counts from zero. If DLL is not that long, nil is returned. | |
191 | If N is negative, return the -(N+1)th last element. | |
192 | Thus, (ewoc--node-nth dll 0) returns the first node, | |
193 | and (ewoc--node-nth dll -1) returns the last node." | |
194 | ;; Branch 0 ("follow left pointer") is used when n is negative. | |
195 | ;; Branch 1 ("follow right pointer") is used otherwise. | |
196 | (let* ((branch (if (< n 0) 0 1)) | |
197 | (node (ewoc--node-branch dll branch))) | |
198 | (if (< n 0) (setq n (- -1 n))) | |
199 | (while (and (not (eq dll node)) (> n 0)) | |
200 | (setq node (ewoc--node-branch node branch)) | |
201 | (setq n (1- n))) | |
202 | (unless (eq dll node) node))) | |
203 | ||
10c471e6 SM |
204 | (defun ewoc-location (node) |
205 | "Return the start location of NODE." | |
206 | (ewoc--node-start-marker node)) | |
207 | ||
5b467bf4 SM |
208 | \f |
209 | ;;; The ewoc data type | |
210 | ||
211 | (defstruct (ewoc | |
212 | (:constructor nil) | |
213 | (:constructor ewoc--create | |
214 | (buffer pretty-printer header footer dll)) | |
215 | (:conc-name ewoc--)) | |
216 | buffer pretty-printer header footer dll last-node) | |
217 | ||
218 | (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms) | |
219 | "Execute FORMS with ewoc--buffer selected as current buffer, | |
220 | dll bound to ewoc--dll, and VARLIST bound as in a let*. | |
221 | dll will be bound when VARLIST is initialized, but the current | |
222 | buffer will *not* have been changed. | |
223 | Return value of last form in FORMS." | |
224 | (let ((old-buffer (make-symbol "old-buffer")) | |
225 | (hnd (make-symbol "ewoc"))) | |
8a946354 SS |
226 | `(let* ((,old-buffer (current-buffer)) |
227 | (,hnd ,ewoc) | |
228 | (dll (ewoc--dll ,hnd)) | |
229 | ,@varlist) | |
230 | (set-buffer (ewoc--buffer ,hnd)) | |
231 | (unwind-protect | |
232 | (progn ,@forms) | |
233 | (set-buffer ,old-buffer))))) | |
5b467bf4 SM |
234 | |
235 | (defmacro ewoc--set-buffer-bind-dll (ewoc &rest forms) | |
236 | `(ewoc--set-buffer-bind-dll-let* ,ewoc nil ,@forms)) | |
237 | ||
238 | (defsubst ewoc--filter-hf-nodes (ewoc node) | |
239 | "Evaluate NODE once and return it. | |
240 | BUT if it is the header or the footer in EWOC return nil instead." | |
241 | (unless (or (eq node (ewoc--header ewoc)) | |
242 | (eq node (ewoc--footer ewoc))) | |
243 | node)) | |
244 | ||
245 | ||
5b467bf4 SM |
246 | (defun ewoc--create-node (data pretty-printer pos) |
247 | "Call PRETTY-PRINTER with point set at POS in current buffer. | |
0111ab41 | 248 | Remember the start position. Create a wrapper containing that |
5b467bf4 SM |
249 | start position and the element DATA." |
250 | (save-excursion | |
251 | ;; Remember the position as a number so that it doesn't move | |
252 | ;; when we insert the string. | |
253 | (when (markerp pos) (setq pos (marker-position pos))) | |
254 | (goto-char pos) | |
255 | (let ((inhibit-read-only t)) | |
256 | ;; Insert the trailing newline using insert-before-markers | |
257 | ;; so that the start position for the next element is updated. | |
258 | (insert-before-markers ?\n) | |
259 | ;; Move back, and call the pretty-printer. | |
260 | (backward-char 1) | |
261 | (funcall pretty-printer data) | |
262 | (ewoc--node-create (copy-marker pos) data)))) | |
263 | ||
264 | ||
265 | (defun ewoc--delete-node-internal (ewoc node) | |
266 | "Delete a data string from EWOC. | |
0111ab41 | 267 | Can not be used on the footer. Returns the wrapper that is deleted. |
5b467bf4 SM |
268 | The start-marker in the wrapper is set to nil, so that it doesn't |
269 | consume any more resources." | |
270 | (let ((dll (ewoc--dll ewoc)) | |
271 | (inhibit-read-only t)) | |
272 | ;; If we are about to delete the node pointed at by last-node, | |
273 | ;; set last-node to nil. | |
274 | (if (eq (ewoc--last-node ewoc) node) | |
275 | (setf (ewoc--last-node ewoc) nil)) | |
276 | ||
277 | (delete-region (ewoc--node-start-marker node) | |
278 | (ewoc--node-start-marker (ewoc--node-next dll node))) | |
279 | (set-marker (ewoc--node-start-marker node) nil) | |
280 | ;; Delete the node, and return the wrapper. | |
281 | (ewoc--node-delete node))) | |
282 | ||
283 | ||
cb3430a1 SM |
284 | (defun ewoc--refresh-node (pp node) |
285 | "Redisplay the element represented by NODE using the pretty-printer PP." | |
5b467bf4 SM |
286 | (let ((inhibit-read-only t)) |
287 | (save-excursion | |
288 | ;; First, remove the string from the buffer: | |
289 | (delete-region (ewoc--node-start-marker node) | |
290 | (1- (marker-position | |
cb3430a1 | 291 | (ewoc--node-start-marker (ewoc--node-right node))))) |
5b467bf4 SM |
292 | ;; Calculate and insert the string. |
293 | (goto-char (ewoc--node-start-marker node)) | |
cb3430a1 | 294 | (funcall pp (ewoc--node-data node))))) |
5b467bf4 SM |
295 | \f |
296 | ;;; =========================================================================== | |
297 | ;;; Public members of the Ewoc package | |
298 | ||
299 | ||
cb3430a1 | 300 | (defun ewoc-create (pretty-printer &optional header footer) |
5b467bf4 SM |
301 | "Create an empty ewoc. |
302 | ||
cb3430a1 | 303 | The ewoc will be inserted in the current buffer at the current position. |
5b467bf4 SM |
304 | |
305 | PRETTY-PRINTER should be a function that takes one argument, an | |
306 | element, and inserts a string representing it in the buffer (at | |
0111ab41 JB |
307 | point). The string PRETTY-PRINTER inserts may be empty or span |
308 | several lines. A trailing newline will always be inserted | |
309 | automatically. The PRETTY-PRINTER should use `insert', and not | |
310 | `insert-before-markers'. | |
311 | ||
312 | Optional second argument HEADER is a string that will always be | |
313 | present at the top of the ewoc. HEADER should end with a | |
314 | newline. Optional third argument FOOTER is similar, and will | |
cb3430a1 | 315 | be inserted at the bottom of the ewoc." |
5b467bf4 | 316 | (let ((new-ewoc |
cb3430a1 SM |
317 | (ewoc--create (current-buffer) |
318 | pretty-printer nil nil (ewoc--dll-create))) | |
319 | (pos (point))) | |
5b467bf4 SM |
320 | (ewoc--set-buffer-bind-dll new-ewoc |
321 | ;; Set default values | |
322 | (unless header (setq header "")) | |
323 | (unless footer (setq footer "")) | |
cb3430a1 SM |
324 | (setf (ewoc--node-start-marker dll) (copy-marker pos)) |
325 | (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos)) | |
326 | (head (ewoc--create-node header (lambda (x) (insert header)) pos))) | |
5b467bf4 SM |
327 | (ewoc--node-enter-first dll head) |
328 | (ewoc--node-enter-last dll foot) | |
cb3430a1 SM |
329 | (setf (ewoc--header new-ewoc) head) |
330 | (setf (ewoc--footer new-ewoc) foot))) | |
5b467bf4 SM |
331 | ;; Return the ewoc |
332 | new-ewoc)) | |
333 | ||
334 | (defalias 'ewoc-data 'ewoc--node-data) | |
335 | ||
336 | (defun ewoc-enter-first (ewoc data) | |
337 | "Enter DATA first in EWOC." | |
338 | (ewoc--set-buffer-bind-dll ewoc | |
339 | (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data))) | |
340 | ||
341 | (defun ewoc-enter-last (ewoc data) | |
342 | "Enter DATA last in EWOC." | |
343 | (ewoc--set-buffer-bind-dll ewoc | |
344 | (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data))) | |
345 | ||
346 | ||
347 | (defun ewoc-enter-after (ewoc node data) | |
10c471e6 SM |
348 | "Enter a new element DATA after NODE in EWOC. |
349 | Returns the new NODE." | |
5b467bf4 SM |
350 | (ewoc--set-buffer-bind-dll ewoc |
351 | (ewoc-enter-before ewoc (ewoc--node-next dll node) data))) | |
352 | ||
353 | (defun ewoc-enter-before (ewoc node data) | |
10c471e6 SM |
354 | "Enter a new element DATA before NODE in EWOC. |
355 | Returns the new NODE." | |
5b467bf4 SM |
356 | (ewoc--set-buffer-bind-dll ewoc |
357 | (ewoc--node-enter-before | |
358 | node | |
359 | (ewoc--create-node | |
360 | data | |
361 | (ewoc--pretty-printer ewoc) | |
362 | (ewoc--node-start-marker node))))) | |
363 | ||
364 | (defun ewoc-next (ewoc node) | |
365 | "Get the next node. | |
366 | Returns nil if NODE is nil or the last element." | |
367 | (when node | |
368 | (ewoc--filter-hf-nodes | |
369 | ewoc (ewoc--node-next (ewoc--dll ewoc) node)))) | |
370 | ||
371 | (defun ewoc-prev (ewoc node) | |
372 | "Get the previous node. | |
373 | Returns nil if NODE is nil or the first element." | |
374 | (when node | |
375 | (ewoc--filter-hf-nodes | |
376 | ewoc | |
377 | (ewoc--node-prev (ewoc--dll ewoc) node)))) | |
378 | ||
379 | ||
380 | (defun ewoc-nth (ewoc n) | |
381 | "Return the Nth node. | |
f0529b5b | 382 | N counts from zero. Return nil if there is less than N elements. |
5b467bf4 SM |
383 | If N is negative, return the -(N+1)th last element. |
384 | Thus, (ewoc-nth dll 0) returns the first node, | |
385 | and (ewoc-nth dll -1) returns the last node. | |
386 | Use `ewoc--node-data' to extract the data from the node." | |
387 | ;; Skip the header (or footer, if n is negative). | |
388 | (setq n (if (< n 0) (1- n) (1+ n))) | |
389 | (ewoc--filter-hf-nodes ewoc | |
390 | (ewoc--node-nth (ewoc--dll ewoc) n))) | |
391 | ||
392 | (defun ewoc-map (map-function ewoc &rest args) | |
393 | "Apply MAP-FUNCTION to all elements in EWOC. | |
394 | MAP-FUNCTION is applied to the first element first. | |
395 | If MAP-FUNCTION returns non-nil the element will be refreshed (its | |
396 | pretty-printer will be called once again). | |
397 | ||
0111ab41 JB |
398 | Note that the buffer for EWOC will be the current buffer when |
399 | MAP-FUNCTION is called. MAP-FUNCTION must restore the current | |
400 | buffer before it returns, if it changes it. | |
5b467bf4 SM |
401 | |
402 | If more than two arguments are given, the remaining | |
403 | arguments will be passed to MAP-FUNCTION." | |
404 | (ewoc--set-buffer-bind-dll-let* ewoc | |
405 | ((footer (ewoc--footer ewoc)) | |
406 | (node (ewoc--node-nth dll 1))) | |
407 | (while (not (eq node footer)) | |
408 | (if (apply map-function (ewoc--node-data node) args) | |
cb3430a1 | 409 | (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)) |
5b467bf4 SM |
410 | (setq node (ewoc--node-next dll node))))) |
411 | ||
412 | (defun ewoc-filter (ewoc predicate &rest args) | |
413 | "Remove all elements in EWOC for which PREDICATE returns nil. | |
a1506d29 | 414 | Note that the buffer for EWOC will be current-buffer when PREDICATE |
0111ab41 | 415 | is called. PREDICATE must restore the current buffer before it returns |
5b467bf4 | 416 | if it changes it. |
0111ab41 | 417 | The PREDICATE is called with the element as its first argument. If any |
5b467bf4 SM |
418 | ARGS are given they will be passed to the PREDICATE." |
419 | (ewoc--set-buffer-bind-dll-let* ewoc | |
420 | ((node (ewoc--node-nth dll 1)) | |
421 | (footer (ewoc--footer ewoc)) | |
422 | (next nil)) | |
423 | (while (not (eq node footer)) | |
424 | (setq next (ewoc--node-next dll node)) | |
425 | (unless (apply predicate (ewoc--node-data node) args) | |
426 | (ewoc--delete-node-internal ewoc node)) | |
427 | (setq node next)))) | |
428 | ||
44946a4c | 429 | (defun ewoc-locate (ewoc &optional pos guess) |
5b467bf4 | 430 | "Return the node that POS (a buffer position) is within. |
44946a4c | 431 | POS may be a marker or an integer. It defaults to point. |
0111ab41 | 432 | GUESS should be a node that it is likely to be near POS. |
5b467bf4 SM |
433 | |
434 | If POS points before the first element, the first node is returned. | |
435 | If POS points after the last element, the last node is returned. | |
436 | If the EWOC is empty, nil is returned." | |
44946a4c | 437 | (unless pos (setq pos (point))) |
5b467bf4 SM |
438 | (ewoc--set-buffer-bind-dll-let* ewoc |
439 | ((footer (ewoc--footer ewoc))) | |
440 | ||
441 | (cond | |
442 | ;; Nothing present? | |
443 | ((eq (ewoc--node-nth dll 1) (ewoc--node-nth dll -1)) | |
444 | nil) | |
445 | ||
446 | ;; Before second elem? | |
447 | ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2))) | |
448 | (ewoc--node-nth dll 1)) | |
449 | ||
450 | ;; After one-before-last elem? | |
451 | ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2))) | |
452 | (ewoc--node-nth dll -2)) | |
453 | ||
454 | ;; We now know that pos is within a elem. | |
455 | (t | |
456 | ;; Make an educated guess about which of the three known | |
457 | ;; node'es (the first, the last, or GUESS) is nearest. | |
458 | (let* ((best-guess (ewoc--node-nth dll 1)) | |
459 | (distance (abs (- pos (ewoc--node-start-marker best-guess))))) | |
460 | (when guess | |
461 | (let ((d (abs (- pos (ewoc--node-start-marker guess))))) | |
462 | (when (< d distance) | |
463 | (setq distance d) | |
464 | (setq best-guess guess)))) | |
465 | ||
466 | (let* ((g (ewoc--node-nth dll -1)) ;Check the last elem | |
467 | (d (abs (- pos (ewoc--node-start-marker g))))) | |
468 | (when (< d distance) | |
469 | (setq distance d) | |
470 | (setq best-guess g))) | |
471 | ||
472 | (when (ewoc--last-node ewoc) ;Check "previous". | |
473 | (let* ((g (ewoc--last-node ewoc)) | |
474 | (d (abs (- pos (ewoc--node-start-marker g))))) | |
475 | (when (< d distance) | |
476 | (setq distance d) | |
477 | (setq best-guess g)))) | |
478 | ||
479 | ;; best-guess is now a "best guess". | |
480 | ;; Find the correct node. First determine in which direction | |
481 | ;; it lies, and then move in that direction until it is found. | |
a1506d29 | 482 | |
5b467bf4 SM |
483 | (cond |
484 | ;; Is pos after the guess? | |
485 | ((>= pos | |
486 | (ewoc--node-start-marker best-guess)) | |
487 | ;; Loop until we are exactly one node too far down... | |
488 | (while (>= pos (ewoc--node-start-marker best-guess)) | |
489 | (setq best-guess (ewoc--node-next dll best-guess))) | |
490 | ;; ...and return the previous node. | |
491 | (ewoc--node-prev dll best-guess)) | |
492 | ||
493 | ;; Pos is before best-guess | |
494 | (t | |
495 | (while (< pos (ewoc--node-start-marker best-guess)) | |
496 | (setq best-guess (ewoc--node-prev dll best-guess))) | |
497 | best-guess))))))) | |
498 | ||
499 | (defun ewoc-invalidate (ewoc &rest nodes) | |
500 | "Refresh some elements. | |
0111ab41 | 501 | The pretty-printer set for EWOC will be called for all NODES." |
5b467bf4 SM |
502 | (ewoc--set-buffer-bind-dll ewoc |
503 | (dolist (node nodes) | |
cb3430a1 | 504 | (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)))) |
5b467bf4 | 505 | |
44946a4c | 506 | (defun ewoc-goto-prev (ewoc arg) |
5b467bf4 SM |
507 | "Move point to the ARGth previous element. |
508 | Don't move if we are at the first element, or if EWOC is empty. | |
509 | Returns the node we moved to." | |
510 | (ewoc--set-buffer-bind-dll-let* ewoc | |
6d84ac85 | 511 | ((node (ewoc-locate ewoc (point)))) |
5b467bf4 | 512 | (when node |
44946a4c SM |
513 | ;; If we were past the last element, first jump to it. |
514 | (when (>= (point) (ewoc--node-start-marker (ewoc--node-right node))) | |
515 | (setq arg (1- arg))) | |
5b467bf4 SM |
516 | (while (and node (> arg 0)) |
517 | (setq arg (1- arg)) | |
518 | (setq node (ewoc--node-prev dll node))) | |
519 | ;; Never step above the first element. | |
520 | (unless (ewoc--filter-hf-nodes ewoc node) | |
521 | (setq node (ewoc--node-nth dll 1))) | |
522 | (ewoc-goto-node ewoc node)))) | |
523 | ||
44946a4c | 524 | (defun ewoc-goto-next (ewoc arg) |
5b467bf4 | 525 | "Move point to the ARGth next element. |
44946a4c | 526 | Returns the node (or nil if we just passed the last node)." |
5b467bf4 | 527 | (ewoc--set-buffer-bind-dll-let* ewoc |
6d84ac85 | 528 | ((node (ewoc-locate ewoc (point)))) |
5b467bf4 SM |
529 | (while (and node (> arg 0)) |
530 | (setq arg (1- arg)) | |
531 | (setq node (ewoc--node-next dll node))) | |
532 | ;; Never step below the first element. | |
44946a4c SM |
533 | ;; (unless (ewoc--filter-hf-nodes ewoc node) |
534 | ;; (setq node (ewoc--node-nth dll -2))) | |
5b467bf4 SM |
535 | (ewoc-goto-node ewoc node))) |
536 | ||
537 | (defun ewoc-goto-node (ewoc node) | |
538 | "Move point to NODE." | |
539 | (ewoc--set-buffer-bind-dll ewoc | |
540 | (goto-char (ewoc--node-start-marker node)) | |
541 | (if goal-column (move-to-column goal-column)) | |
542 | (setf (ewoc--last-node ewoc) node))) | |
543 | ||
544 | (defun ewoc-refresh (ewoc) | |
545 | "Refresh all data in EWOC. | |
546 | The pretty-printer that was specified when the EWOC was created | |
547 | will be called for all elements in EWOC. | |
548 | Note that `ewoc-invalidate' is more efficient if only a small | |
549 | number of elements needs to be refreshed." | |
550 | (ewoc--set-buffer-bind-dll-let* ewoc | |
cb3430a1 | 551 | ((footer (ewoc--footer ewoc))) |
5b467bf4 SM |
552 | (let ((inhibit-read-only t)) |
553 | (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1)) | |
554 | (ewoc--node-start-marker footer)) | |
555 | (goto-char (ewoc--node-start-marker footer)) | |
556 | (let ((node (ewoc--node-nth dll 1))) | |
557 | (while (not (eq node footer)) | |
558 | (set-marker (ewoc--node-start-marker node) (point)) | |
559 | (funcall (ewoc--pretty-printer ewoc) | |
560 | (ewoc--node-data node)) | |
561 | (insert "\n") | |
562 | (setq node (ewoc--node-next dll node))))) | |
563 | (set-marker (ewoc--node-start-marker footer) (point)))) | |
564 | ||
565 | (defun ewoc-collect (ewoc predicate &rest args) | |
566 | "Select elements from EWOC using PREDICATE. | |
567 | Return a list of all selected data elements. | |
0111ab41 JB |
568 | PREDICATE is a function that takes a data element as its first |
569 | argument. The elements on the returned list will appear in the | |
570 | same order as in the buffer. You should not rely on the order of | |
571 | calls to PREDICATE. | |
572 | Note that the buffer the EWOC is displayed in is the current | |
573 | buffer when PREDICATE is called. PREDICATE must restore it if it | |
574 | changes it. | |
5b467bf4 SM |
575 | If more than two arguments are given the |
576 | remaining arguments will be passed to PREDICATE." | |
577 | (ewoc--set-buffer-bind-dll-let* ewoc | |
578 | ((header (ewoc--header ewoc)) | |
579 | (node (ewoc--node-nth dll -2)) | |
580 | result) | |
581 | (while (not (eq node header)) | |
582 | (if (apply predicate (ewoc--node-data node) args) | |
583 | (push (ewoc--node-data node) result)) | |
584 | (setq node (ewoc--node-prev dll node))) | |
6d84ac85 | 585 | (nreverse result))) |
5b467bf4 SM |
586 | |
587 | (defun ewoc-buffer (ewoc) | |
588 | "Return the buffer that is associated with EWOC. | |
589 | Returns nil if the buffer has been deleted." | |
590 | (let ((buf (ewoc--buffer ewoc))) | |
591 | (when (buffer-name buf) buf))) | |
592 | ||
cb3430a1 SM |
593 | (defun ewoc-get-hf (ewoc) |
594 | "Return a cons cell containing the (HEADER . FOOTER) of EWOC." | |
595 | (cons (ewoc--node-data (ewoc--header ewoc)) | |
596 | (ewoc--node-data (ewoc--footer ewoc)))) | |
597 | ||
598 | (defun ewoc-set-hf (ewoc header footer) | |
599 | "Set the HEADER and FOOTER of EWOC." | |
600 | (setf (ewoc--node-data (ewoc--header ewoc)) header) | |
601 | (setf (ewoc--node-data (ewoc--footer ewoc)) footer) | |
602 | (ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc)) | |
603 | (ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc))) | |
604 | ||
5b467bf4 SM |
605 | \f |
606 | (provide 'ewoc) | |
607 | ||
608 | ;;; Local Variables: | |
609 | ;;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1) | |
610 | ;;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2) | |
611 | ;;; End: | |
612 | ||
ab5796a9 | 613 | ;;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4 |
5b467bf4 | 614 | ;;; ewoc.el ends here |