cgit.sxemacs.org Git - packages/blob - xemacs-packages/elib/cookie.el

   1 ;;; $Id: cookie.el,v 1.2 2000-10-06 08:35:00 youngs 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 \f
 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 \f
 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 \f
 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 \f
 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.  Optional 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 beginning 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 \f
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