InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/gnu/lucid/lemacs-19.6/lisp/pcl-cvs/cookie.el

Text File | 1992-10-28 | 25.8 KB | 906 lines

;;; Id: cookie.el,v 1.10 1992/07/20 16:01:20 ceder Exp
;;; cookie.el -- Utility to display cookies in buffers
;;; Copyright (C) 1991, 1992  Per Cederqvist
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Note that this file is still under development.  Comments,
;;; enhancements and bug fixes are welcome.
;;; Send them to [e-mail].

(defun impl nil (error "Not yet implemented!"))

;;; Cookie is a package that imlements a connection between an
;;; elib-dll (a doubly linked list) and the contents of a buffer.
;;; Possible uses are dired (have all files in a list, and show them),
;;; buffer-list, kom-prioritize (in the LysKOM elisp client) and
;;; others. pcl-cvs.el uses cookie.el.
;;;
;;; A cookie buffer contains a header, any number of cookies, and a
;;; footer. The header and footer are constant strings that are given
;;; to cookie-create when the buffer is placed under cookie. Each
;;; cookie is formatted in the buffer by calling a user-supplied
;;; function that takes a cookie and returns a string. The string may
;;; be empty, or contain any number of lines. An extra newline is
;;; always appended unless the string is empty.
;;;
;;; Cookie does not affect the mode of the buffer in any way. It
;;; merely makes it easy to connect an underlying data representation
;;; to the buffer contents.
;;;
;;; A tin is an object that contains one cookie.  There are functions
;;; in this package that for instance given a tin extracts the cookie,
;;; or gives the next or previous tin.  (All tins are linked together
;;; in a doubly linked list.  The 'previous' tin is the one that
;;; appears before the other in the buffer.)  You should not do
;;; anything with a tin except handle it to the functions in this
;;; package.

;;; INTERNAL DOCUMENTATION (Your understanding of this package might
;;; increase if you read it, but you should not exploit the knowledge
;;; you gain. The internal details might change without notice).
;;;
;;; At the implementation level a tin is really an elib-node that
;;; consists of
;;;      left        Pointer to previous tin
;;;      right       Pointer to next tin
;;;      data        Holder of a 'wrapper'.
;;; The internals of an elib-node are in fact unknown to cookie.el.
;;; It uses elib-dll.el to handle everything that deals with the
;;; doubly linked list.
;;;
;;; The wrapper data type contains
;;;      start-marker    Position of the printed representation of the
;;;                      cookie in the buffer.
;;;      cookie          The user-supplied element.
;;;
;;; The wrapper is not accessible to the user of this package.

(require 'elib-dll)
(provide 'cookie)

(defvar cookies nil
  "A doubly linked list that contains the underlying data representation
for the contents of a cookie buffer. The package elib-dll is used to
manipulate this list.")

(defvar cookie-pretty-printer nil
  "The function that is used to pretty-print a cookie in this buffer.")

(defvar cookie-header nil
  "The tin that holds the header cookie.")

(defvar cookie-footer nil
  "The tin that holds the footer cookie.")

(defvar cookie-last-tin nil
  "The tin the cursor was positioned at, the last time the cookie
package checked the cursor position. Buffer local in all buffers
the cookie package works on. You may set this if your package
thinks it knows where the cursor will be the next time this
package is called. It can speed things up.

It must never be set to a tin that has been deleted.")

;;; ================================================================
;;;      Internal functions for use in the cookie package

(put 'cookie-set-buffer 'lisp-indent-hook 1)

(defmacro cookie-set-buffer (buffer &rest forms)

  ;; Execute FORMS with BUFFER selected as current buffer.
  ;; Return value of last form in FORMS.  INTERNAL USE ONLY.

  (let ((old-buffer (make-symbol "old-buffer")))
    (` (let (((, old-buffer) (current-buffer)))
     (set-buffer (get-buffer-create (, buffer)))
     (unwind-protect
         (progn (,@ forms))
       (set-buffer (, old-buffer)))))))


(defmacro cookie-filter-hf (tin)

  ;; Evaluate TIN once and return it. BUT if it is
  ;; equal to cookie-header or cookie-footer return nil instead.
  ;; INTERNAL USE ONLY.

  (let ((tempvar (make-symbol "tin")))
    (` (let (((, tempvar) (, tin)))
     (if (or (eq (, tempvar) cookie-header)
         (eq (, tempvar) cookie-footer))
         nil
       (, tempvar))))))


;;; The wrapper data type.
;;; Constructor:

(defun cookie-create-wrapper (start-marker
                  cookie)
  ;; Create a wrapper.   INTERNAL USE ONLY.
  (cons 'WRAPPER (vector start-marker cookie)))


;;; Selectors:

(defun cookie-wrapper-start-marker (wrapper)
  ;; Get start-marker from wrapper.    INTERNAL USE ONLY.
  (elt (cdr wrapper) 0))


(defun cookie-wrapper-cookie-safe (wrapper)
  ;; Get cookie from wrapper.   INTERNAL USE ONLY.
  ;; Returns nil if given nil as input.
  ;; This is the same as cookie-wrapper-cookie in version 18.57
  ;; of emacs, but elt should signal an error when given nil
  ;; as input (according to the info files).
  (elt (cdr wrapper) 1))

(defun cookie-wrapper-cookie (wrapper)
  ;; Get cookie from wrapper.   INTERNAL USE ONLY.
  (elt (cdr wrapper) 1))


;;; Modifiers:

;; Currently not used.
;;(defun cookie-wrapper-set-start-marker (wrapper newval)
;;  ;; Set start-marker in WRAPPER to NEWVAL.   INTERNAL USE ONLY.
;;  (aset (cdr wrapper) 0 newval))

;; Currently not used.
;;(defun cookie-wrapper-set-cookie (wrapper newval)
;;  ;; Set cookie in WRAPPER to NEWVAL.   INTERNAL USE ONLY.
;;  (aset (cdr wrapper) 1 newval))



;;; Predicate:

;; Currently not used.
;;(defun cookie-wrapper-p (object)
;;  ;; Return t if OBJECT is a wrapper.   INTERNAL USE ONLY.
;;  (eq (car-safe object) 'WRAPPER))

;;; end of wrapper data type.


(defun cookie-create-wrapper-and-insert (cookie string pos)
  ;; Insert STRING at POS in current buffer. Remember start
  ;; position. Create a wrapper containing the start position and the
  ;; COOKIE.
  ;;    INTERNAL USE ONLY.

  (save-excursion
    (goto-char pos)
    ;; Remember the position as a number so that it doesn't move
    ;; when we insert the string.
    (let ((start (if (markerp pos)
             (marker-position pos)
           pos))
      buffer-read-only)
      ;; Use insert-before-markers so that the marker for the
      ;; next cookie is updated.
      (insert-before-markers string)
      (insert-before-markers ?\n)
      (cookie-create-wrapper (copy-marker start) cookie))))


(defun cookie-delete-tin-internal (tin)
  ;; Delete a cookie from the buffer.  INTERNAL USE ONLY.
  ;; Can not be used on the footer.
  (let (buffer-read-only)
    (delete-region (cookie-wrapper-start-marker (dll-element cookies tin))
           (cookie-wrapper-start-marker
            (dll-element cookies
                 (dll-next cookies  tin))))))



(defun cookie-refresh-tin (tin)
  ;; Redisplay the cookie represented by TIN. INTERNAL USE ONLY.
  ;; Can not be used on the footer.

  (save-excursion
    (let (buffer-read-only)
      ;; First, remove the string:
      (delete-region (cookie-wrapper-start-marker (dll-element cookies tin))
             (1- (marker-position
              (cookie-wrapper-start-marker
               (dll-element cookies
                    (dll-next cookies  tin))))))

      ;; Calculate and insert the string.

      (goto-char (cookie-wrapper-start-marker (dll-element cookies tin)))
      (insert
       (funcall cookie-pretty-printer
        (cookie-wrapper-cookie (dll-element cookies tin)))))))


;;; ================================================================
;;;      The public members of the cookie package


(defun cookie-cookie (buffer tin)
  "Get the cookie from a TIN. Args: BUFFER TIN."
  (cookie-set-buffer buffer
    (cookie-wrapper-cookie (dll-element cookies tin))))




(defun cookie-create (buffer pretty-printer &optional header footer)

  "Start to use the cookie package in BUFFER.
BUFFER may be a buffer or a buffer name. It is created if it does not exist.
Beware that the entire contents of the buffer will be erased, and all local
varables deleted. (The mode of the BUFFER should therefore be set after the
call to cookie-create).

PRETTY-PRINTER is a function that takes one cookie and returns a string
to be displayed in the buffer. The string may be empty. If it is not
empty a newline will be added automatically. It may span several lines.
Optional third argument HEADER is a string that will always be present
at the top of the buffer. HEADER should end with a newline. Optionaly
fourth argument FOOTER is similar, and will always be inserted at the
bottom of the buffer."

  (cookie-set-buffer buffer

    (kill-all-local-variables)
    (setq buffer-read-only nil)
    (erase-buffer)

    (make-local-variable 'cookie-last-tin)
    (make-local-variable 'cookie-pretty-printer)
    (make-local-variable 'cookie-header)
    (make-local-variable 'cookie-footer)
    (make-local-variable 'cookies)

    (setq cookie-last-tin nil)
    (setq cookie-pretty-printer pretty-printer)
    (setq cookies (dll-create))

    (dll-enter-first cookies
             (cookie-create-wrapper-and-insert
              header header 0))
    (setq cookie-header (dll-nth cookies 0))

    (dll-enter-last cookies
            (cookie-create-wrapper-and-insert
             footer footer (point-max)))
    (setq cookie-footer (dll-nth cookies -1))

    (goto-char (point-min))
    (forward-line 1)
    (setq buffer-read-only t)))


(defun cookie-set-header (buffer header)
  "Change the header. Args: BUFFER HEADER."
  (impl))


(defun cookie-set-footer (buffer header)
  "Change the footer. Args: BUFFER FOOTER."
  (impl))



(defun cookie-enter-first (buffer cookie)
  "Enter a COOKIE first in BUFFER.
Args: BUFFER COOKIE."

  (cookie-set-buffer buffer

    ;; It is always safe to insert an element after the first element,
    ;; because the header is always present. (dll-nth cookies 0) should
    ;; never return nil.

    (dll-enter-after
     cookies
     (dll-nth cookies 0)
     (cookie-create-wrapper-and-insert
      cookie
      (funcall cookie-pretty-printer cookie)
      (cookie-wrapper-start-marker
       (dll-element cookies (dll-nth cookies 1)))))))



(defun cookie-enter-last (buffer cookie)
  "Enter a COOKIE last in BUFFER.
Args: BUFFER COOKIE."

  (cookie-set-buffer buffer

    ;; Remember that the header and footer are always present. There
    ;; is no need to check if (dll-nth cookies -2) returns nil.

    (dll-enter-before
     cookies
     (dll-nth cookies -1)
     (cookie-create-wrapper-and-insert
      cookie
      (funcall cookie-pretty-printer cookie)
      (cookie-wrapper-start-marker (dll-last cookies))))))


(defun cookie-enter-after (buffer node cookie)
  (impl))


(defun cookie-enter-before (buffer node cookie)
  (impl))



(defun tin-next (buffer tin)
  "Get the next tin. Args: BUFFER TIN.
Returns nil if TIN is nil or the last cookie."
  (if tin
      (cookie-set-buffer buffer
    (cookie-filter-hf (dll-next cookies tin)))))



(defun tin-previous (buffer tin)
  "Get the previous tin. Args: BUFFER TIN.
Returns nil if TIN is nil or the first cookie."
  (if tin
      (cookie-set-buffer buffer
    (cookie-filter-hf (dll-previous cookies tin)))))


(defun tin-nth (buffer n)

  "Return the Nth tin. Args: BUFFER N.
N counts from zero. Nil is returned if there is less than N cookies.
If N is negative, return the -(N+1)th last element.
Thus, (tin-nth dll 0) returns the first node,
and (tin-nth dll -1) returns the last node.

Use cookie-cookie to extract the cookie from the tin."

  (cookie-set-buffer buffer

    ;; Skip the header (or footer, if n is negative).
    (if (< n 0)
    (setq n (1- n))
      (setq n (1+ n)))

    (cookie-filter-hf (dll-nth cookies n))))



(defun tin-delete (buffer tin)
  "Delete a cookie. Args: BUFFER TIN."

  (cookie-set-buffer buffer
    (if (eq cookie-last-tin tin)
    (setq cookie-last-tin nil))

    (cookie-delete-tin-internal tin)
    (dll-delete cookies tin)))



(defun cookie-delete-first (buffer)
  "Delete first cookie and return it. Args: BUFFER.
Returns nil if there is no cookie left."

  (cookie-set-buffer buffer

    ;; We have to check that we do not try to delete the footer.

    (let ((tin (dll-nth cookies 1)))    ;Skip the header.
      (if (eq tin cookie-footer)
      nil
    (cookie-delete-tin-internal tin)
    (cookie-wrapper-cookie (dll-delete cookies tin))))))



(defun cookie-delete-last (buffer)
  "Delete last cookie and return it. Args: BUFFER.
Returns nil if there is no cookie left."

  (cookie-set-buffer buffer

    ;; We have to check that we do not try to delete the header.

    (let ((tin (dll-nth cookies -2)))    ;Skip the footer.
      (if (eq tin cookie-header)
      nil
    (cookie-delete-tin-internal tin)
    (cookie-wrapper-cookie (dll-delete cookies tin))))))



(defun cookie-first (buffer)

  "Return the first cookie in BUFFER. The cookie is not removed."

  (cookie-set-buffer buffer
    (let ((tin (cookie-filter-hf (dll-nth cookies -1))))
      (if tin
      (cookie-wrapper-cookie-safe
       (dll-element cookies tin))))))


(defun cookie-last (buffer)

  "Return the last cookie in BUFFER. The cookie is not removed."

  (cookie-set-buffer buffer
    (let ((tin (cookie-filter-hf (dll-nth cookies -2))))
      (if tin
      (cookie-wrapper-cookie-safe
       (dll-element cookies tin))))))


(defun cookie-empty (buffer)

  "Return true if there are no cookies in BUFFER."

  (cookie-set-buffer buffer
    (eq (dll-nth cookies 1) cookie-footer)))


(defun cookie-length (buffer)

  "Return number of cookies in BUFFER."

  ;; Don't count the footer and header.

  (cookie-set-buffer buffer
    (- (dll-length cookies) 2)))


(defun cookie-all (buffer)

  "Return a list of all cookies in BUFFER."

  (cookie-set-buffer buffer
    (let (result
      (tin (dll-nth cookies -2)))
      (while (not (eq tin cookie-header))
    (setq result (cons (cookie-wrapper-cookie (dll-element cookies tin))
               result))
    (setq tin (dll-previous cookies tin)))
      result)))

(defun cookie-clear (buffer)

  "Remove all cookies in buffer."

  (cookie-set-buffer buffer
    (cookie-create buffer cookie-pretty-printer
           (cookie-wrapper-cookie (dll-element cookies cookie-header))
           (cookie-wrapper-cookie (dll-element cookies cookie-footer)))))



(defun cookie-map (map-function buffer &rest map-args)

  "Apply MAP-FUNCTION to all cookies in BUFFER.
MAP-FUNCTION is applied to the first element first.
If MAP-FUNCTION returns non-nil the cookie will be refreshed.

Note that BUFFER will be current buffer when MAP-FUNCTION is called.

If more than two arguments are given to cookie-map, remaining
arguments will be passed to MAP-FUNCTION."

  (cookie-set-buffer buffer
    (let ((tin (dll-nth cookies 1))
      result)

      (while (not (eq tin cookie-footer))

    (if (apply map-function
           (cookie-wrapper-cookie (dll-element cookies tin))
           map-args)
        (cookie-refresh-tin tin))

    (setq tin (dll-next cookies tin))))))



(defun cookie-map-reverse (map-function buffer &rest map-args)

  "Apply MAP-FUNCTION to all cookies in BUFFER.
MAP-FUNCTION is applied to the last cookie first.
If MAP-FUNCTION returns non-nil the cookie will be refreshed.

Note that BUFFER will be current buffer when MAP-FUNCTION is called.

If more than two arguments are given to cookie-map, remaining
arguments will be passed to MAP-FUNCTION."

  (cookie-set-buffer buffer
    (let ((tin (dll-nth cookies -2))
      result)

      (while (not (eq tin cookie-header))

    (if (apply map-function
           (cookie-wrapper-cookie (dll-element cookies tin))
           map-args)
        (cookie-refresh-tin tin))

    (setq tin (dll-previous cookies tin))))))



(defun cookie-enter-cookies (buffer cookie-list)

  "Insert all cookies in the list COOKIE-LIST last in BUFFER.
Args: BUFFER COOKIE-LIST."

  (while cookie-list
    (cookie-enter-last buffer (car cookie-list))
    (setq cookie-list (cdr cookie-list))))


(defun cookie-filter (buffer predicate)

  "Remove all cookies in BUFFER for which PREDICATE returns nil.
Note that BUFFER will be current-buffer when PREDICATE is called.

The PREDICATE is called with one argument, the cookie."

  (cookie-set-buffer buffer
    (let ((tin (dll-nth cookies 1))
      next)
      (while (not (eq tin cookie-footer))
    (setq next (dll-next cookies tin))
    (if (funcall predicate (cookie-wrapper-cookie (dll-element cookies tin)))
        nil
      (cookie-delete-tin-internal tin)
      (dll-delete cookies tin))
    (setq tin next)))))


(defun tin-filter (buffer predicate)

  "Remove all cookies in BUFFER for which PREDICATE returns nil.
Note that BUFFER will be current-buffer when PREDICATE is called.

The PREDICATE is called with one argument, the tin."

  (cookie-set-buffer buffer
    (let ((tin (dll-nth cookies 1))
      next)
      (while (not (eq tin cookie-footer))
    (setq next (dll-next cookies tin))
    (if (funcall predicate tin)
        nil
      (cookie-delete-tin-internal tin)
      (dll-delete cookies tin))
    (setq tin next)))))

(defun cookie-pos-before-middle-p (pos tin1 tin2)

  "Return true if POS is in the first half of the region defined by TIN1 and
TIN2."

  (< pos (/ (+ (cookie-wrapper-start-marker (dll-element cookies tin1))
           (cookie-wrapper-start-marker (dll-element cookies tin2)))
        2)))


(defun tin-get-selection (buffer pos &optional guess force-guess)

  "Return the tin the POS is within.
Args: BUFFER POS &optional GUESS FORCE-GUESS.
GUESS should be a tin that it is likely that POS is near. If FORCE-GUESS
is non-nil GUESS is always used as a first guess, otherwise the first
guess is the first tin, last tin, or GUESS, whichever is nearest to
pos in the BUFFER.

If pos points within the header, the first cookie is returned.
If pos points within the footer, the last cookie is returned.
Nil is returned if there is no cookie.

It is often good to specify cookie-last-tin as GUESS, but remember
that cookie-last-tin is buffer local in all buffers that cookie
operates on."

  (cookie-set-buffer buffer

    (cond
     ;; No cookies present?
     ((eq (dll-nth cookies 1) (dll-nth cookies -1))
      nil)

     ;; Before first cookie?
     ((< pos (cookie-wrapper-start-marker
          (dll-element cookies (dll-nth cookies 1))))
      (dll-nth cookies 1))

     ;; After last cookie?
     ((>= pos (cookie-wrapper-start-marker (dll-last cookies)))
      (dll-nth cookies -2))

     ;; We now now that pos is within a cookie.
     (t
      ;; Make an educated guess about which of the three known
      ;; cookies (the first, the last, or GUESS) is nearest.
      (setq
       guess
       (cond
    (force-guess guess)
    (guess
     (cond
      ;; Closest to first cookie?
      ((cookie-pos-before-middle-p
        pos guess
        (dll-nth cookies 1))
       (dll-nth cookies 1))
      ;; Closest to GUESS?
      ((cookie-pos-before-middle-p
        pos guess
        cookie-footer)
       guess)
      ;; Closest to last cookie.
      (t (dll-previous cookies cookie-footer))))
    (t
     ;; No guess given.
     (cond
      ;; First half?
      ((cookie-pos-before-middle-p
        pos (dll-nth cookies 1)
        cookie-footer)
       (dll-nth cookies 1))
      (t (dll-previous cookies cookie-footer))))))

      ;; GUESS is now a "best guess".

      ;; Find the correct cookie. First determine in which direction
      ;; it lies, and then move in that direction until it is found.

      (cond
       ;; Is pos after the guess?
       ((>= pos (cookie-wrapper-start-marker (dll-element cookiess guess)))

    ;; Loop until we are exactly one cookie too far down...
    (while (>= pos (cookie-wrapper-start-marker (dll-element cookiess guess)))
      (setq guess (dll-next cookies guess)))

    ;; ...and return the previous cookie.
    (dll-previous cookies guess))

       ;; Pos is before guess
       (t

    (while (< pos (cookie-wrapper-start-marker (dll-element cookiess guess)))
      (setq guess (dll-previous cookies guess)))

    guess))))))


(defun tin-start-marker (buffer tin)

  "Return start-position of a cookie in BUFFER.
Args: BUFFER TIN.
The marker that is returned should not be modified in any way,
and is only valid until the contents of the cookie buffer changes."

  (cookie-set-buffer buffer
    (cookie-wrapper-start-marker (dll-element cookies tin))))


(defun tin-end-marker (buffer tin)

  "Return end-position of a cookie in BUFFER.
Args: BUFFER TIN.
The marker that is returned should not be modified in any way,
and is only valid until the contents of the cookie buffer changes."

  (cookie-set-buffer buffer
    (cookie-wrapper-start-marker
     (dll-element cookies (dll-next cookies tin)))))



(defun cookie-refresh (buffer)

  "Refresh all cookies in BUFFER.
Cookie-pretty-printer will be called for all cookies and the new result
displayed.

See also tin-invalidate-tins."

  (cookie-set-buffer buffer

    (let (buffer-read-only)
      (erase-buffer)

      (set-marker (cookie-wrapper-start-marker (dll-element cookies cookie-header))
          (point) buffer)
      (insert (cookie-wrapper-cookie (dll-element cookies cookie-header)))
      (insert "\n")

      (let ((tin (dll-nth cookies 1)))
    (while (not (eq tin cookie-footer))

      (set-marker (cookie-wrapper-start-marker (dll-element cookies tin))
              (point) buffer)
      (insert
       (funcall cookie-pretty-printer
            (cookie-wrapper-cookie (dll-element cookies tin))))
      (insert "\n")
      (setq tin (dll-next cookies tin))))

      (set-marker (cookie-wrapper-start-marker (dll-element cookies cookie-footer))
          (point) buffer)
      (insert (cookie-wrapper-cookie (dll-element cookies cookie-footer)))
      (insert "\n"))))


(defun tin-invalidate-tins (buffer &rest tins)

  "Refresh some cookies.
Args: BUFFER &rest TINS."

  (cookie-set-buffer buffer

    (while tins
      (cookie-refresh-tin (car tins))
      (setq tins (cdr tins)))))


;;; Cookie movement commands.

(defun cookie-set-goal-column (buffer goal)
  "Set goal-column for BUFFER.
Args: BUFFER GOAL.
goal-column is made buffer-local."
  (cookie-set-buffer buffer
    (make-local-variable 'goal-column)
    (setq goal-column goal)))


(defun cookie-previous-cookie (buffer pos arg)
  "Move point to the ARGth previous cookie.
Don't move if we are at the first cookie.
ARG is the prefix argument when called interactively.
Args: BUFFER POS ARG.
Sets cookie-last-tin to the cookie we move to."

  (interactive (list (current-buffer) (point)
             (prefix-numeric-value current-prefix-arg)))

  (cookie-set-buffer buffer
    (setq cookie-last-tin
      (tin-get-selection buffer pos cookie-last-tin))

    (while (and cookie-last-tin (> arg 0))
      (setq arg (1- arg))
      (setq cookie-last-tin
        (dll-previous cookies cookie-last-tin)))

    ;; Never step above the first cookie.

    (if (null (cookie-filter-hf cookie-last-tin))
    (setq cookie-last-tin (dll-nth cookies 1)))

    (goto-char
     (cookie-wrapper-start-marker
      (dll-element cookies cookie-last-tin)))

    (if goal-column
    (move-to-column goal-column))))



(defun cookie-next-cookie (buffer pos arg)
  "Move point to the ARGth next cookie.
Don't move if we are at the last cookie.
ARG is the prefix argument when called interactively.
Args: BUFFER POS ARG.
Sets cookie-last-tin to the cookie we move to."

  (interactive (list (current-buffer) (point)
             (prefix-numeric-value current-prefix-arg)))

  (cookie-set-buffer buffer
    (setq cookie-last-tin
      (tin-get-selection buffer pos cookie-last-tin))

    (while (and cookie-last-tin (> arg 0))
      (setq arg (1- arg))
      (setq cookie-last-tin
        (dll-next cookies cookie-last-tin)))

    (if (null (cookie-filter-hf cookie-last-tin))
    (setq cookie-last-tin (dll-nth cookies -2)))

    (goto-char
     (cookie-wrapper-start-marker
      (dll-element cookies cookie-last-tin)))

    (if goal-column
    (move-to-column goal-column))))


(defun tin-collect (buffer predicate &rest predicate-args)

  "Return a list of all tins in BUFFER whose cookie PREDICATE
returns true for.
PREDICATE is a function that takes a cookie as its argument.
The tins on the returned list will appear in the same order
as in the buffer. You should not rely on in which order PREDICATE
is called. Note that BUFFER is current-buffer when PREDICATE
is called. (If you call cookie-collect with another buffer set
as current-buffer and need to access buffer-local variables
from that buffer within PREDICATE you must send them via
PREDICATE-ARGS).

If more than two arguments are given to cookie-collect the remaining
arguments will be passed to PREDICATE.

Use cookie-cookie to get the cookie from the tin."

  (cookie-set-buffer buffer
    (let ((tin (dll-nth cookies -2))
      result)

      (while (not (eq tin cookie-header))

    (if (apply predicate
           (cookie-wrapper-cookie (dll-element cookies tin))
           predicate-args)
        (setq result (cons tin result)))

    (setq tin (dll-previous cookies tin)))
      result)))


(defun cookie-collect (buffer predicate &rest predicate-args)

  "Return a list of all cookies in BUFFER that PREDICATE
returns true for.
PREDICATE is a function that takes a cookie as its argument.
The cookie on the returned list will appear in the same order
as in the buffer. You should not rely on in which order PREDICATE
is called. Note that BUFFER is current-buffer when PREDICATE
is called. (If you call cookie-collect with another buffer set
as current-buffer and need to access buffer-local variables
from that buffer within PREDICATE you must send them via
PREDICATE-ARGS).

If more than two arguments are given to cookie-collect the remaining
arguments will be passed to PREDICATE."

  (cookie-set-buffer buffer
    (let ((tin (dll-nth cookies -2))
      result)

      (while (not (eq tin cookie-header))

    (if (apply predicate
           (cookie-wrapper-cookie (dll-element cookies tin))
           predicate-args)
        (setq result (cons (cookie-wrapper-cookie (dll-element cookies tin))
                   result)))

    (setq tin (dll-previous cookies tin)))
      result)))