Mercurial > hg > xemacs-beta

comparison lisp/pcl-cvs/cookie.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; $Id: cookie.el,v 1.1.1.1 1996/12/18 03:32:25 steve Exp $
2 ;;; cookie.el -- Utility to display cookies in buffers
3
4 ;; Copyright (C) 1991-1995 Free Software Foundation
5
6 ;; Author: Per Cederqvist <ceder@lysator.liu.se>
7 ;; Inge Wallin <inge@lysator.liu.se>
8 ;; Maintainer: elib-maintainers@lysator.liu.se
9 ;; Created: 3 Aug 1992
10 ;; Keywords: extensions, lisp
11
12 ;;; This program is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
16 ;;;
17 ;;; This program is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
21 ;;;
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with GNU Elib; see the file COPYING. If not, write to
24 ;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;;; Boston, MA 02111-1307, USA
26 ;;;
27
28
29 ;;; Commentary:
30
31 ;;; Introduction
32 ;;; ============
33 ;;;
34 ;;; Cookie is a package that implements a connection between an
35 ;;; dll (a doubly linked list) and the contents of a buffer.
36 ;;; Possible uses are dired (have all files in a list, and show them),
37 ;;; buffer-list, kom-prioritize (in the LysKOM elisp client) and
38 ;;; others. pcl-cvs.el uses cookie.el.
39 ;;;
40 ;;; A `cookie' can be any lisp object. When you use the cookie
41 ;;; package you specify a pretty-printer, a function that inserts
42 ;;; a printable representation of the cookie in the buffer. (The
43 ;;; pretty-printer should use "insert" and not
44 ;;; "insert-before-markers").
45 ;;;
46 ;;; A `collection' consists of a doubly linked list of cookies, a
47 ;;; header, a footer and a pretty-printer. It is displayed at a
48 ;;; certain point in a certain buffer. (The buffer and point are
49 ;;; fixed when the collection is created). The header and the footer
50 ;;; are constant strings. They appear before and after the cookies.
51 ;;; (Currently, once set, they can not be changed).
52 ;;;
53 ;;; Cookie does not affect the mode of the buffer in any way. It
54 ;;; merely makes it easy to connect an underlying data representation
55 ;;; to the buffer contents.
56 ;;;
57 ;;; A `tin' is an object that contains one cookie. There are
58 ;;; functions in this package that given a tin extracts the cookie, or
59 ;;; gives the next or previous tin. (All tins are linked together in
60 ;;; a doubly linked list. The 'previous' tin is the one that appears
61 ;;; before the other in the buffer.) You should not do anything with
62 ;;; a tin except pass it to the functions in this package.
63 ;;;
64 ;;; A collection is a very dynamic thing. You can easily add or
65 ;;; delete cookies. You can sort all cookies in a collection (you
66 ;;; have to supply a function that compares two cookies). You can
67 ;;; apply a function to all cookies in a collection, et c, et c.
68 ;;;
69 ;;; Remember that a cookie can be anything. Your imagination is the
70 ;;; limit! It is even possible to have another collection as a
71 ;;; cookie. In that way some kind of tree hierarchy can be created.
72 ;;;
73 ;;; Full documentation will, God willing, soon be available in a
74 ;;; Texinfo manual.
75
76
77
78 ;;; Coding conventions
79 ;;; ==================
80 ;;;
81 ;;; All functions that are intended for external use begin with one of
82 ;;; the prefixes "cookie-", "collection-" or "tin-". The prefix
83 ;;; "elib-" is used for internal functions and macros. There are
84 ;;; currently no global or buffer-local variables used.
85 ;;;
86 ;;; Many function operate on `tins' instead of `cookies'. To avoid
87 ;;; confusion most of the function names include the string "cookie"
88 ;;; or "tin" to show this.
89 ;;;
90 ;;; Most doc-strings contains an "Args:" line that lists the
91 ;;; arguments.
92 ;;;
93 ;;; The internal functions don't contain any doc-strings. RMS thinks
94 ;;; this is a good way to save space.
95
96
97
98 ;;; INTERNAL DOCUMENTATION (Your understanding of this package might
99 ;;; increase if you read it, but you should not exploit the knowledge
100 ;;; you gain. The internal details might change without notice).
101 ;;;
102 ;;; A collection is implemented as an dll (a doubly linked list).
103 ;;; The first and last element on the list are always the header and
104 ;;; footer (as strings). Any remaining entries are `wrappers'.
105 ;;;
106 ;;; At the implementation level a `tin' is really an elib-node that
107 ;;; consists of
108 ;;; left Pointer to previous tin
109 ;;; right Pointer to next tin
110 ;;; data Holder of a `wrapper'.
111 ;;; These internals of an elib-node are in fact unknown to cookie.el.
112 ;;; It uses dll.el to handle everything that deals with the
113 ;;; doubly linked list.
114 ;;;
115 ;;; The wrapper data type contains
116 ;;; start-marker Position of the printed representation of the
117 ;;; cookie in the buffer.
118 ;;; cookie The user-supplied cookie.
119 ;;;
120 ;;; The wrapper is not accessible to the user of this package.
121
122 ;;; Code:
123
124 (require 'dll)
125 (provide 'cookie)
126
127
128 ;;; ================================================================
129 ;;; Internal macros for use in the cookie package
130
131
132 (put 'elib-set-buffer-bind-dll 'lisp-indent-hook 1)
133
134 (defmacro elib-set-buffer-bind-dll (collection &rest forms)
135
136 ;; Execute FORMS with collection->buffer selected as current buffer,
137 ;; and dll bound to collection->dll.
138 ;; Return value of last form in FORMS. INTERNAL USE ONLY.
139
140 (let ((old-buffer (make-symbol "old-buffer"))
141 (hnd (make-symbol "collection")))
142 (` (let* (((, old-buffer) (current-buffer))
143 ((, hnd) (, collection))
144 (dll (elib-collection->dll (, hnd))))
145 (set-buffer (elib-collection->buffer (, hnd)))
146 (unwind-protect
147 (progn (,@ forms))
148 (set-buffer (, old-buffer)))))))
149
150
151 (put 'elib-set-buffer-bind-dll-let* 'lisp-indent-hook 2)
152
153 (defmacro elib-set-buffer-bind-dll-let* (collection varlist &rest forms)
154
155 ;; Execute FORMS with collection->buffer selected as current buffer,
156 ;; dll bound to collection->dll, and VARLIST bound as in a let*.
157 ;; dll will be bound when VARLIST is initialized, but the current
158 ;; buffer will *not* have been changed.
159 ;; Return value of last form in FORMS. INTERNAL USE ONLY.
160
161 (let ((old-buffer (make-symbol "old-buffer"))
162 (hnd (make-symbol "collection")))
163 (` (let* (((, old-buffer) (current-buffer))
164 ((, hnd) (, collection))
165 (dll (elib-collection->dll (, hnd)))
166 (,@ varlist))
167 (set-buffer (elib-collection->buffer (, hnd)))
168 (unwind-protect
169 (progn (,@ forms))
170 (set-buffer (, old-buffer)))))))
171
172
173 (defmacro elib-filter-hf (collection tin)
174
175 ;; Evaluate TIN once and return it. BUT if it is
176 ;; the header or the footer in COLLECTION return nil instead.
177 ;; Args: COLLECTION TIN
178 ;; INTERNAL USE ONLY.
179
180 (let ((tempvar (make-symbol "tin"))
181 (tmpcoll (make-symbol "tmpcollection")))
182 (` (let (((, tempvar) (, tin))
183 ((, tmpcoll) (, collection)))
184 (if (or (eq (, tempvar) (elib-collection->header (, tmpcoll)))
185 (eq (, tempvar) (elib-collection->footer (, tmpcoll))))
186 nil
187 (, tempvar))))))
188
189
190
191 ;;; ================================================================
192 ;;; Internal data types for use in the cookie package
193
194 ;;; Yes, I know about cl.el, but I don't like it. /ceder
195
196 ;;; The wrapper data type.
197
198 (defun elib-create-wrapper (start-marker cookie)
199 ;; Create a wrapper. INTERNAL USE ONLY.
200 (cons 'WRAPPER (vector start-marker cookie)))
201
202 (defun elib-wrapper->start-marker (wrapper)
203 ;; Get start-marker from wrapper. INTERNAL USE ONLY.
204 (elt (cdr wrapper) 0))
205
206 (defun elib-wrapper->cookie-safe (wrapper)
207 ;; Get cookie from wrapper. INTERNAL USE ONLY.
208 ;; Returns nil if given nil as input.
209 ;; Since (elt nil 1) returns nil in emacs version 18.57 and 18.58
210 ;; this can be defined in this way. The documentation in the info
211 ;; file says that elt should signal an error in that case. I think
212 ;; it is the documentation that is buggy. (The bug is reported).
213 (elt (cdr wrapper) 1))
214
215 (defun elib-wrapper->cookie (wrapper)
216 ;; Get cookie from wrapper. INTERNAL USE ONLY.
217 (elt (cdr wrapper) 1))
218
219
220
221 ;;; The collection data type
222
223 (defun elib-create-collection (buffer pretty-printer
224 header-wrapper footer-wrapper
225 dll)
226 ;; Create a collection. INTERNAL USE ONLY.
227 (cons 'COLLECTION
228 ;; The last element is a pointer to the last tin
229 ;; the cursor was at, or nil if that is unknown.
230 (vector buffer
231 pretty-printer
232 header-wrapper footer-wrapper
233 dll nil)))
234
235
236 (defun elib-collection->buffer (collection)
237 ;; Get buffer from COLLECTION.
238 (elt (cdr collection) 0))
239
240 (defun elib-collection->pretty-printer (collection)
241 ;; Get pretty-printer from COLLECTION.
242 (elt (cdr collection) 1))
243
244 (defun elib-collection->header (collection)
245 ;; Get header from COLLECTION.
246 (elt (cdr collection) 2))
247
248 (defun elib-collection->footer (collection)
249 ;; Get footer from COLLECTION.
250 (elt (cdr collection) 3))
251
252 (defun elib-collection->dll (collection)
253 ;; Get dll from COLLECTION.
254 (elt (cdr collection) 4))
255
256 (defun elib-collection->last-tin (collection)
257 ;; Get last-tin from COLLECTION.
258 (elt (cdr collection) 5))
259
260
261
262 (defun elib-set-collection->buffer (collection buffer)
263 ;; Change the buffer. Args: COLLECTION BUFFER.
264 (aset (cdr collection) 0 buffer))
265
266 (defun elib-set-collection->pretty-printer (collection pretty-printer)
267 ;; Change the pretty-printer. Args: COLLECTION PRETTY-PRINTER.
268 (aset (cdr collection) 1 pretty-printer))
269
270 (defun elib-set-collection->header (collection header)
271 ;; Change the header. Args: COLLECTION HEADER.
272 (aset (cdr collection) 2 header))
273
274 (defun elib-set-collection->footer (collection footer)
275 ;; Change the footer. Args: COLLECTION FOOTER.
276 (aset (cdr collection) 3 footer))
277
278 (defun elib-set-collection->dll (collection dll)
279 ;; Change the dll. Args: COLLECTION DLL.
280 (aset (cdr collection) 4 dll))
281
282 (defun elib-set-collection->last-tin (collection last-tin)
283 ;; Change the last-tin. Args: COLLECTION LAST-TIN.
284 (aset (cdr collection) 5 last-tin))
285
286
287 ;;; ================================================================
288 ;;; Internal functions for use in the cookie package
289
290 (defun elib-abs (x)
291 ;; Return the absolute value of x
292 (max x (- x)))
293
294 (defun elib-create-wrapper-and-insert (cookie string pos)
295 ;; Insert STRING at POS in current buffer. Remember the start
296 ;; position. Create a wrapper containing that start position and the
297 ;; COOKIE.
298 ;; INTERNAL USE ONLY.
299
300 (save-excursion
301 (goto-char pos)
302 ;; Remember the position as a number so that it doesn't move
303 ;; when we insert the string.
304 (let ((start (if (markerp pos)
305 (marker-position pos)
306 pos))
307 (buffer-read-only nil))
308 ;; Use insert-before-markers so that the marker for the
309 ;; next cookie is updated.
310 (insert-before-markers string)
311
312 ;; Always insert a newline. You want invisible cookies? You
313 ;; lose. (At least in this version). FIXME-someday. (It is
314 ;; harder to fix than it might seem. All markers have to point
315 ;; to the right place all the time...)
316 (insert-before-markers ?\n)
317 (elib-create-wrapper (copy-marker start) cookie))))
318
319
320 (defun elib-create-wrapper-and-pretty-print (cookie
321 pretty-printer pos)
322 ;; Call PRETTY-PRINTER with point set at POS in current buffer.
323 ;; Remember the start position. Create a wrapper containing that
324 ;; start position and the COOKIE.
325 ;; INTERNAL USE ONLY.
326
327 (save-excursion
328 (goto-char pos)
329 ;; Remember the position as a number so that it doesn't move
330 ;; when we insert the string.
331 (let ((start (if (markerp pos)
332 (marker-position pos)
333 pos))
334 (buffer-read-only nil))
335 ;; Insert the trailing newline using insert-before-markers
336 ;; so that the start position for the next cookie is updated.
337 (insert-before-markers ?\n)
338 ;; Move back, and call the pretty-printer.
339 (backward-char 1)
340 (funcall pretty-printer cookie)
341 (elib-create-wrapper (copy-marker start) cookie))))
342
343
344 (defun elib-delete-tin-internal (collection tin)
345 ;; Delete a cookie string from COLLECTION. INTERNAL USE ONLY.
346 ;; Can not be used on the footer. Returns the wrapper that is deleted.
347 ;; The start-marker in the wrapper is set to nil, so that it doesn't
348 ;; consume any more resources.
349 (let ((dll (elib-collection->dll collection))
350 (buffer-read-only nil))
351 ;; If we are about to delete the tin pointed at by last-tin,
352 ;; set last-tin to nil.
353 (if (eq (elib-collection->last-tin collection) tin)
354 (elib-set-collection->last-tin collection nil))
355
356 (delete-region (elib-wrapper->start-marker (dll-element dll tin))
357 (elib-wrapper->start-marker
358 (dll-element dll (dll-next dll tin))))
359 (set-marker (elib-wrapper->start-marker (dll-element dll tin)) nil)
360 ;; Delete the tin, and return the wrapper.
361 (dll-delete dll tin)))
362
363 (defun elib-refresh-tin (collection tin)
364 ;; Redisplay the cookie represented by TIN. INTERNAL USE ONLY.
365 ;; Args: COLLECTION TIN
366 ;; Can not be used on the footer. dll *must* be bound to
367 ;; (elib-collection->dll collection).
368
369 (let ((buffer-read-only nil))
370 (save-excursion
371 ;; First, remove the string from the buffer:
372 (delete-region (elib-wrapper->start-marker (dll-element dll tin))
373 (1- (marker-position
374 (elib-wrapper->start-marker
375 (dll-element dll (dll-next dll tin))))))
376
377 ;; Calculate and insert the string.
378
379 (goto-char (elib-wrapper->start-marker (dll-element dll tin)))
380 (funcall (elib-collection->pretty-printer collection)
381 (elib-wrapper->cookie (dll-element dll tin))))))
382
383
384 (defun elib-pos-before-middle-p (collection pos tin1 tin2)
385
386 ;; Return true if for the cookies in COLLECTION, POS is in the first
387 ;; half of the region defined by TIN1 and TIN2.
388
389 (let ((dll (elib-collection->dll collection)))
390 (< pos (/ (+ (elib-wrapper->start-marker (dll-element dll tin1))
391 (elib-wrapper->start-marker (dll-element dll tin2)))
392 2))))
393
394
395 ;;; ===========================================================================
396 ;;; Public members of the cookie package
397
398
399 (defun collection-create (buffer pretty-printer
400 &optional header footer pos)
401 "Create an empty collection of cookies.
402 Args: BUFFER PRETTY-PRINTER &optional HEADER FOOTER POS.
403
404 The collection will be inserted in BUFFER. BUFFER may be a
405 buffer or a buffer name. It is created if it does not exist.
406
407 PRETTY-PRINTER should be a function that takes one argument, a
408 cookie, and inserts a string representing it in the buffer (at
409 point). The string PRETTY-PRINTER inserts may be empty or span
410 several linse. A trailing newline will always be inserted
411 automatically. The PRETTY-PRINTER should use insert, and not
412 insert-before-markers.
413
414 Optional third argument HEADER is a string that will always be
415 present at the top of the collection. HEADER should end with a
416 newline. Optionaly fourth argument FOOTER is similar, and will
417 always be inserted at the bottom of the collection.
418
419 Optional fifth argument POS is a buffer position, specifying
420 where the collection will be inserted. It defaults to the
421 begining of the buffer."
422
423 (let ((new-collection
424 (elib-create-collection (get-buffer-create buffer)
425 pretty-printer nil nil (dll-create))))
426
427 (elib-set-buffer-bind-dll new-collection
428 ;; Set default values
429 (if (not header)
430 (setq header ""))
431 (if (not footer)
432 (setq footer ""))
433 (if (not pos)
434 (setq pos (point-min))
435 (if (markerp pos)
436 (set pos (marker-position pos)))) ;Force header to be above footer.
437
438 (let ((foot (elib-create-wrapper-and-insert footer footer pos))
439 (head (elib-create-wrapper-and-insert header header pos)))
440
441 (dll-enter-first dll head)
442 (dll-enter-last dll foot)
443 (elib-set-collection->header new-collection (dll-nth dll 0))
444 (elib-set-collection->footer new-collection (dll-nth dll -1))))
445
446 ;; Return the collection
447 new-collection))
448
449
450 (defun tin-cookie (collection tin)
451 "Get the cookie from a TIN. Args: COLLECTION TIN."
452 (elib-wrapper->cookie (dll-element (cookie->dll collection) tin)))
453
454 (defun cookie-enter-first (collection cookie)
455 "Enter a COOKIE first in the cookie collection COLLECTION.
456 Args: COLLECTION COOKIE."
457
458 (elib-set-buffer-bind-dll collection
459
460 ;; It is always safe to insert an element after the first element,
461 ;; because the header is always present. (dll-nth dll 0) should
462 ;; therefore never return nil.
463
464 (dll-enter-after
465 dll
466 (dll-nth dll 0)
467 (elib-create-wrapper-and-pretty-print
468 cookie
469 (elib-collection->pretty-printer collection)
470 (elib-wrapper->start-marker
471 (dll-element dll (dll-nth dll 1)))))))
472
473
474 (defun cookie-enter-last (collection cookie)
475 "Enter a COOKIE last in the cookie-collection COLLECTION.
476 Args: COLLECTION COOKIE."
477
478 (elib-set-buffer-bind-dll collection
479
480 ;; Remember that the header and footer are always present. There
481 ;; is no need to check if (dll-nth dll -1) returns nil - it never
482 ;; does.
483
484 (dll-enter-before
485 dll
486 (dll-nth dll -1)
487 (elib-create-wrapper-and-pretty-print
488 cookie
489 (elib-collection->pretty-printer collection)
490 (elib-wrapper->start-marker (dll-last dll))))))
491
492
493 (defun cookie-enter-after-tin (collection tin cookie)
494 "Enter a new COOKIE after TIN.
495 Args: COLLECTION TIN COOKIE."
496 (elib-set-buffer-bind-dll collection
497 (dll-enter-after
498 dll tin
499 (elib-create-wrapper-and-pretty-print
500 cookie
501 (elib-collection->pretty-printer collection)
502 (elib-wrapper->start-marker (dll-element dll (dll-next dll tin)))))))
503
504
505 (defun cookie-enter-before-tin (collection tin cookie)
506 "Enter a new COOKIE before TIN.
507 Args: COLLECTION TIN COOKIE."
508 (elib-set-buffer-bind-dll collection
509 (dll-enter-before
510 dll tin
511 (elib-create-wrapper-and-pretty-print
512 cookie
513 (elib-collection->pretty-printer collection)
514 (elib-wrapper->start-marker (dll-element dll tin))))))
515
516
517 (defun tin-next (collection tin)
518 "Get the next tin. Args: COLLECTION TIN.
519 Returns nil if TIN is nil or the last cookie."
520 (if tin
521 (elib-filter-hf
522 collection (dll-next (elib-collection->dll collection) tin))
523 nil))
524
525 (defun tin-previous (collection tin)
526 "Get the previous tin. Args: COLLECTION TIN.
527 Returns nil if TIN is nil or the first cookie."
528 (if tin
529 (elib-filter-hf
530 collection
531 (dll-previous (elib-collection->dll collection) tin))
532 nil))
533
534
535 (defun tin-nth (collection n)
536 "Return the Nth tin. Args: COLLECTION N.
537 N counts from zero. Nil is returned if there is less than N cookies.
538 If N is negative, return the -(N+1)th last element.
539 Thus, (tin-nth dll 0) returns the first node,
540 and (tin-nth dll -1) returns the last node.
541
542 Use tin-cookie to extract the cookie from the tin (or use
543 cookie-nth instead)."
544
545 ;; Skip the header (or footer, if n is negative).
546 (if (< n 0)
547 (setq n (1- n))
548 (setq n (1+ n)))
549
550 (elib-filter-hf collection
551 (dll-nth (elib-collection->dll collection) n)))
552
553 (defun cookie-nth (collection n)
554 "Return the Nth cookie. Args: COLLECTION N.
555 N counts from zero. Nil is returned if there is less than N cookies.
556 If N is negative, return the -(N+1)th last element.
557 Thus, (cookie-nth dll 0) returns the first cookie,
558 and (cookie-nth dll -1) returns the last cookie."
559
560 ;; Skip the header (or footer, if n is negative).
561 (if (< n 0)
562 (setq n (1- n))
563 (setq n (1+ n)))
564
565 (let* ((dll (elib-collection->dll collection))
566 (tin (elib-filter-hf collection (dll-nth dll n))))
567 (if tin
568 (elib-wrapper->cookie (dll-element dll tin))
569 nil)))
570
571 (defun tin-delete (collection tin)
572 "Delete a tin from a collection. Args: COLLECTION TIN.
573 The cookie in the tin is returned."
574
575 (elib-set-buffer-bind-dll collection
576 (elib-wrapper->cookie
577 (elib-delete-tin-internal collection tin))))
578
579
580 (defun cookie-delete-first (collection)
581 "Delete first cookie and return it. Args: COLLECTION.
582 Returns nil if there are no cookies left in the collection."
583
584 (elib-set-buffer-bind-dll-let* collection
585 ((tin (dll-nth dll 1))) ;Skip the header.
586
587 ;; We have to check that we do not try to delete the footer.
588 (if (eq tin (elib-collection->footer collection))
589 nil
590 (elib-wrapper->cookie (elib-delete-tin-internal collection tin)))))
591
592
593 (defun cookie-delete-last (collection)
594 "Delete last cookie and return it. Args: COLLECTION.
595 Returns nil if there is no cookie left in the collection."
596
597 (elib-set-buffer-bind-dll-let* collection
598 ((tin (dll-nth dll -2))) ;Skip the footer.
599 ;; We have to check that we do not try to delete the header.
600 (if (eq tin (elib-collection->header collection))
601 nil
602 (elib-wrapper->cookie (elib-delete-tin-internal collection tin)))))
603
604 (defun cookie-first (collection)
605 "Return the first cookie in COLLECTION. The cookie is not removed."
606
607 (let* ((dll (elib-collection->dll collection))
608 (tin (elib-filter-hf collection (dll-nth dll -1))))
609 (if tin
610 (elib-wrapper->cookie (dll-element dll tin)))))
611
612
613
614 (defun cookie-last (collection)
615 "Return the last cookie in COLLECTION. The cookie is not removed."
616
617 (let* ((dll (elib-collection->dll collection))
618 (tin (elib-filter-hf collection (dll-nth dll -2))))
619 (if tin
620 (elib-wrapper->cookie (dll-element dll tin)))))
621
622
623 (defun collection-empty (collection)
624 "Return true if there are no cookies in COLLECTION."
625
626 (eq (dll-nth (elib-collection->dll collection) 1)
627 (elib-collection->footer collection)))
628
629
630 (defun collection-length (collection)
631 "Return the number of cookies in COLLECTION."
632
633 ;; Don't count the footer and header.
634 (- (dll-length (elib-collection->dll collection)) 2))
635
636
637 (defun collection-list-cookies (collection)
638 "Return a list of all cookies in COLLECTION."
639
640 (elib-set-buffer-bind-dll-let* collection
641 ((result nil)
642 (header (elib-collection->header collection))
643 (tin (dll-nth dll -2)))
644 (while (not (eq tin header))
645 (setq result (cons (elib-wrapper->cookie (dll-element dll tin))
646 result))
647 (setq tin (dll-previous dll tin)))
648 result))
649
650
651 (defun collection-clear (collection)
652 "Remove all cookies in COLLECTION."
653
654 (elib-set-buffer-bind-dll-let* collection
655 ((header (elib-collection->header collection))
656 (footer (elib-collection->footer collection)))
657
658 ;; We have to bind buffer-read-only separately, so that the
659 ;; current buffer is correct.
660 (let ((buffer-read-only nil))
661 (delete-region (elib-wrapper->start-marker
662 (dll-element dll (dll-nth dll 1)))
663 (elib-wrapper->start-marker
664 (dll-element dll footer))))
665 (setq dll (dll-create-from-list (list (dll-element dll header)
666 (dll-element dll footer))))
667 (elib-set-collection->dll collection dll)
668
669 ;; Re-set the header and footer, since they are now new objects.
670 ;; elib-filter-hf uses eq to compare objects to them...
671 (elib-set-collection->header collection (dll-nth dll 0))
672 (elib-set-collection->footer collection (dll-nth dll -1))))
673
674
675 (defun cookie-map (map-function collection &rest map-args)
676 "Apply MAP-FUNCTION to all cookies in COLLECTION.
677 MAP-FUNCTION is applied to the first element first.
678 If MAP-FUNCTION returns non-nil the cookie will be refreshed (its
679 pretty-printer will be called once again).
680
681 Note that the buffer for COLLECTION will be current buffer when MAP-FUNCTION
682 is called. MAP-FUNCTION must restore the current buffer to BUFFER before
683 it returns, if it changes it.
684
685 If more than two arguments are given to cookie-map, remaining
686 arguments will be passed to MAP-FUNCTION."
687
688 (elib-set-buffer-bind-dll-let* collection
689 ((footer (elib-collection->footer collection))
690 (tin (dll-nth dll 1)))
691
692 (while (not (eq tin footer))
693
694 (if (apply map-function
695 (elib-wrapper->cookie (dll-element dll tin))
696 map-args)
697 (elib-refresh-tin collection tin))
698
699 (setq tin (dll-next dll tin)))))
700
701
702
703 (defun cookie-map-reverse (map-function collection &rest map-args)
704 "Apply MAP-FUNCTION to all cookies in COLLECTION.
705 MAP-FUNCTION is applied to the last cookie first.
706 If MAP-FUNCTION returns non-nil the cookie will be refreshed.
707
708 Note that the buffer for COLLECTION will be current buffer when MAP-FUNCTION
709 is called. MAP-FUNCTION must restore the current buffer to BUFFER before
710 it returns, if it changes the current buffer.
711
712 If more than two arguments are given to cookie-map, remaining
713 arguments will be passed to MAP-FUNCTION."
714
715 (elib-set-buffer-bind-dll-let* collection
716 ((header (elib-collection->header collection))
717 (tin (dll-nth dll -2)))
718
719 (while (not (eq tin header))
720
721 (if (apply map-function
722 (elib-wrapper->cookie (dll-element dll tin))
723 map-args)
724 (elib-refresh-tin collection tin))
725
726 (setq tin (dll-previous dll tin)))))
727
728
729
730 (defun collection-append-cookies (collection cookie-list)
731 "Insert all cookies in the list COOKIE-LIST last in COLLECTION.
732 Args: COLLECTION COOKIE-LIST."
733
734 (while cookie-list
735 (cookie-enter-last collection (car cookie-list))
736 (setq cookie-list (cdr cookie-list))))
737
738
739 (defun collection-filter-cookies (collection predicate &rest extra-args)
740 "Remove all cookies in COLLECTION for which PREDICATE returns nil.
741 Args: COLLECTION PREDICATE &rest EXTRA-ARGS.
742 Note that the buffer for COLLECTION will be current-buffer when PREDICATE
743 is called. PREDICATE must restore the current buffer before it returns
744 if it changes it.
745
746 The PREDICATE is called with the cookie as its first argument. If any
747 EXTRA-ARGS are given to collection-filter-cookies they will be passed to the
748 PREDICATE."
749
750 (elib-set-buffer-bind-dll-let* collection
751 ((tin (dll-nth dll 1))
752 (footer (elib-collection->footer collection))
753 (next nil))
754 (while (not (eq tin footer))
755 (setq next (dll-next dll tin))
756 (if (apply predicate
757 (elib-wrapper->cookie (dll-element dll tin))
758 extra-args)
759 nil
760 (elib-delete-tin-internal collection tin))
761 (setq tin next))))
762
763
764 (defun collection-filter-tins (collection predicate &rest extra-args)
765 "Remove all cookies in COLLECTION for which PREDICATE returns nil.
766 Note that the buffer for COLLECTION will be current-buffer when PREDICATE
767 is called. PREDICATE must restore the current buffer before it returns
768 if it changes it.
769
770 The PREDICATE is called with one argument, the tin. If any EXTRA-ARGS
771 are given to collection-filter-cookies they will be passed to the PREDICATE."
772
773 (elib-set-buffer-bind-dll-let* collection
774 ((tin (dll-nth dll 1))
775 (footer (elib-collection->footer collection))
776 (next nil))
777 (while (not (eq tin footer))
778 (setq next (dll-next dll tin))
779 (if (apply predicate tin extra-args)
780 nil
781 (elib-delete-tin-internal collection tin))
782 (setq tin next))))
783
784
785 (defun tin-locate (collection pos &optional guess)
786 "Return the tin that POS (a buffer position) is within.
787 Args: COLLECTION POS &optional GUESS.
788 POS may be a marker or an integer.
789 GUESS should be a tin that it is likely that POS is near.
790
791 If POS points before the first cookie, the first cookie is returned.
792 If POS points after the last cookie, the last cookie is returned.
793 If the COLLECTION is empty, nil is returned."
794
795 (elib-set-buffer-bind-dll-let* collection
796 ((footer (elib-collection->footer collection)))
797
798 (cond
799 ;; No cookies present?
800 ((eq (dll-nth dll 1) (dll-nth dll -1))
801 nil)
802
803 ;; Before first cookie?
804 ((< pos (elib-wrapper->start-marker
805 (dll-element dll (dll-nth dll 1))))
806 (dll-nth dll 1))
807
808 ;; After last cookie?
809 ((>= pos (elib-wrapper->start-marker (dll-last dll)))
810 (dll-nth dll -2))
811
812 ;; We now now that pos is within a cookie.
813 (t
814 ;; Make an educated guess about which of the three known
815 ;; cookies (the first, the last, or GUESS) is nearest.
816 (let* ((best-guess (dll-nth dll 1))
817 (distance (elib-abs (- pos (elib-wrapper->start-marker
818 (dll-element dll best-guess))))))
819 (if guess
820 (let* ((g guess) ;Check the guess, if given.
821 (d (elib-abs
822 (- pos (elib-wrapper->start-marker
823 (dll-element dll g))))))
824 (cond
825 ((< d distance)
826 (setq distance d)
827 (setq best-guess g)))))
828
829 (let* ((g (dll-nth dll -1)) ;Check the last cookie
830 (d (elib-abs
831 (- pos (elib-wrapper->start-marker
832 (dll-element dll g))))))
833 (cond
834 ((< d distance)
835 (setq distance d)
836 (setq best-guess g))))
837
838 (if (elib-collection->last-tin collection) ;Check "previous".
839 (let* ((g (elib-collection->last-tin collection))
840 (d (elib-abs
841 (- pos (elib-wrapper->start-marker
842 (dll-element dll g))))))
843 (cond
844 ((< d distance)
845 (setq distance d)
846 (setq best-guess g)))))
847
848 ;; best-guess is now a "best guess".
849
850 ;; Find the correct cookie. First determine in which direction
851 ;; it lies, and then move in that direction until it is found.
852
853 (cond
854 ;; Is pos after the guess?
855 ((>= pos
856 (elib-wrapper->start-marker (dll-element dll best-guess)))
857
858 ;; Loop until we are exactly one cookie too far down...
859 (while (>= pos (elib-wrapper->start-marker
860 (dll-element dll best-guess)))
861 (setq best-guess (dll-next dll best-guess)))
862
863 ;; ...and return the previous cookie.
864 (dll-previous dll best-guess))
865
866 ;; Pos is before best-guess
867 (t
868
869 (while (< pos (elib-wrapper->start-marker
870 (dll-element dll best-guess)))
871 (setq best-guess (dll-previous dll best-guess)))
872
873 best-guess)))))))
874
875
876 ;;(defun tin-start-marker (collection tin)
877 ;; "Return start-position of a cookie in COLLECTION.
878 ;;Args: COLLECTION TIN.
879 ;;The marker that is returned should not be modified in any way,
880 ;;and is only valid until the contents of the cookie buffer changes."
881 ;;
882 ;; (elib-wrapper->start-marker
883 ;; (dll-element (elib-collection->dll collection) tin)))
884
885
886 ;;(defun tin-end-marker (collection tin)
887 ;; "Return end-position of a cookie in COLLECTION.
888 ;;Args: COLLECTION TIN.
889 ;;The marker that is returned should not be modified in any way,
890 ;;and is only valid until the contents of the cookie buffer changes."
891 ;;
892 ;; (let ((dll (elib-collection->dll collection)))
893 ;; (elib-wrapper->start-marker
894 ;; (dll-element dll (dll-next dll tin)))))
895
896
897
898 (defun collection-refresh (collection)
899 "Refresh all cookies in COLLECTION.
900
901 The pretty-printer that was specified when the COLLECTION was created
902 will be called for all cookies in COLLECTION.
903
904 Note that tin-invalidate is more efficient if only a small
905 number of cookies needs to be refreshed."
906
907 (elib-set-buffer-bind-dll-let* collection
908
909 ((header (elib-collection->header collection))
910 (footer (elib-collection->footer collection)))
911
912 (let ((buffer-read-only nil))
913 (delete-region (elib-wrapper->start-marker
914 (dll-element dll (dll-nth dll 1)))
915 (elib-wrapper->start-marker
916 (dll-element dll footer)))
917
918 (goto-char (elib-wrapper->start-marker
919 (dll-element dll footer)))
920
921 (let ((tin (dll-nth dll 1)))
922 (while (not (eq tin footer))
923
924 (set-marker (elib-wrapper->start-marker (dll-element dll tin))
925 (point))
926 (funcall (elib-collection->pretty-printer collection)
927 (elib-wrapper->cookie (dll-element dll tin)))
928 (insert "\n")
929 (setq tin (dll-next dll tin)))))
930
931 (set-marker (elib-wrapper->start-marker (dll-element dll footer))
932 (point))))
933
934
935 (defun tin-invalidate (collection &rest tins)
936 "Refresh some cookies. Args: COLLECTION &rest TINS.
937 The pretty-printer that for COLLECTION will be called for all TINS."
938
939 (elib-set-buffer-bind-dll collection
940
941 (while tins
942 (elib-refresh-tin collection (car tins))
943 (setq tins (cdr tins)))))
944
945
946 (defun collection-set-goal-column (collection goal)
947 "Set goal-column for COLLECTION.
948 Args: COLLECTION GOAL.
949 goal-column is made buffer-local.
950
951 There will eventually be a better way to specify the cursor position."
952 (elib-set-buffer-bind-dll collection
953 (make-local-variable 'goal-column)
954 (setq goal-column goal)))
955
956
957 (defun tin-goto-previous (collection pos arg)
958 "Move point to the ARGth previous cookie.
959 Don't move if we are at the first cookie, or if COLLECTION is empty.
960 Args: COLLECTION POS ARG.
961 Returns the tin we move to."
962
963 (elib-set-buffer-bind-dll-let* collection
964 ((tin (tin-locate
965 collection pos (elib-collection->last-tin collection))))
966
967 (cond
968 (tin
969 (while (and tin (> arg 0))
970 (setq arg (1- arg))
971 (setq tin (dll-previous dll tin)))
972
973 ;; Never step above the first cookie.
974
975 (if (null (elib-filter-hf collection tin))
976 (setq tin (dll-nth dll 1)))
977
978 (goto-char
979 (elib-wrapper->start-marker
980 (dll-element dll tin)))
981
982 (if goal-column
983 (move-to-column goal-column))
984 (elib-set-collection->last-tin collection tin)
985 tin))))
986
987
988 (defun tin-goto-next (collection pos arg)
989 "Move point to the ARGth next cookie.
990 Don't move if we are at the last cookie.
991 Args: COLLECTION POS ARG.
992 Returns the tin."
993
994 ;;Need to do something clever with (current-buffer)...
995 ;;Previously, when the buffer was used instead of the collection, this line
996 ;;did the trick. No longer so... This is hard to do right! Remember that a
997 ;;cookie can contain a collection!
998 ;;(interactive (list (current-buffer) (point)
999 ;; (prefix-numeric-value current-prefix-arg)))
1000
1001 (elib-set-buffer-bind-dll-let* collection
1002 ((tin (tin-locate
1003 collection pos (elib-collection->last-tin collection))))
1004
1005 (while (and tin (> arg 0))
1006 (setq arg (1- arg))
1007 (setq tin (dll-next dll tin)))
1008
1009 ;; Never step below the first cookie.
1010
1011 (if (null (elib-filter-hf collection tin))
1012 (setq tin (dll-nth dll -2)))
1013
1014 (goto-char
1015 (elib-wrapper->start-marker
1016 (dll-element dll tin)))
1017
1018 (if goal-column
1019 (move-to-column goal-column))
1020
1021 (elib-set-collection->last-tin collection tin)
1022 tin))
1023
1024
1025 (defun tin-goto (collection tin)
1026 "Move point to TIN. Args: COLLECTION TIN."
1027 (elib-set-buffer-bind-dll collection
1028 (goto-char
1029 (elib-wrapper->start-marker
1030 (dll-element dll tin)))
1031
1032 (if goal-column
1033 (move-to-column goal-column))
1034
1035 (elib-set-collection->last-tin collection tin)))
1036
1037
1038 (defun collection-collect-tin (collection predicate &rest predicate-args)
1039 "Select cookies from COLLECTION using PREDICATE.
1040 Return a list of all selected tins.
1041
1042 PREDICATE is a function that takes a cookie as its first argument.
1043
1044 The tins on the returned list will appear in the same order as in the
1045 buffer. You should not rely on in which order PREDICATE is called.
1046
1047 Note that the buffer the COLLECTION is displayed in is current-buffer
1048 when PREDICATE is called. If PREDICATE must restore current-buffer if
1049 it changes it.
1050
1051 If more than two arguments are given to collection-collect-tin the remaining
1052 arguments will be passed to PREDICATE."
1053
1054 (elib-set-buffer-bind-dll-let* collection
1055 ((header (elib-collection->header collection))
1056 (tin (dll-nth dll -2))
1057 (result nil))
1058
1059 ;; Collect the tins, starting at the last one, so that they
1060 ;; appear in the correct order in the result (which is cons'ed
1061 ;; together).
1062
1063 (while (not (eq tin header))
1064
1065 (if (apply predicate
1066 (elib-wrapper->cookie (dll-element dll tin))
1067 predicate-args)
1068 (setq result (cons tin result)))
1069
1070 (setq tin (dll-previous dll tin)))
1071 result))
1072
1073
1074 (defun collection-collect-cookie (collection predicate &rest predicate-args)
1075 "Select cookies from COLLECTION using PREDICATE.
1076 Return a list of all selected cookies.
1077
1078 PREDICATE is a function that takes a cookie as its first argument.
1079
1080 The cookies on the returned list will appear in the same order as in
1081 the buffer. You should not rely on in which order PREDICATE is
1082 called.
1083
1084 Note that the buffer the COLLECTION is displayed in is current-buffer
1085 when PREDICATE is called. If PREDICATE must restore current-buffer if
1086 it changes it.
1087
1088 If more than two arguments are given to collection-collect-cookie the
1089 remaining arguments will be passed to PREDICATE."
1090
1091 (elib-set-buffer-bind-dll-let* collection
1092 ((header (elib-collection->header collection))
1093 (tin (dll-nth dll -2))
1094 result)
1095
1096 (while (not (eq tin header))
1097
1098 (if (apply predicate
1099 (elib-wrapper->cookie (dll-element dll tin))
1100 predicate-args)
1101 (setq result (cons (elib-wrapper->cookie (dll-element dll tin))
1102 result)))
1103
1104 (setq tin (dll-previous dll tin)))
1105 result))
1106
1107
1108 (defun cookie-sort (collection predicate)
1109 "Sort the cookies in COLLECTION, stably, comparing elements using PREDICATE.
1110 PREDICATE is called with two cookies, and should return T
1111 if the first cookie is \"less\" than the second.
1112
1113 All cookies will be refreshed when the sort is complete."
1114
1115 (elib-set-collection->last-tin collection nil)
1116
1117 (collection-append-cookies
1118 collection
1119 (prog1 (sort (collection-list-cookies collection) predicate)
1120 (collection-clear collection))))
1121
1122
1123 (defun collection-buffer (collection)
1124 "Return the buffer that is associated with COLLECTION.
1125 Returns nil if the buffer has been deleted."
1126 (let ((buf (elib-collection->buffer collection)))
1127 (if (buffer-name buf)
1128 buf
1129 nil)))
1130
1131
1132 ;;; Local Variables:
1133 ;;; eval: (put 'elib-set-buffer-bind-dll 'lisp-indent-hook 1)
1134 ;;; eval: (put 'elib-set-buffer-bind-dll-let* 'lisp-indent-hook 2)
1135 ;;; End:
1136
1137 ;;; cookie.el ends here