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

   1 ;;;; $Id: queue-f.el,v 1.1.1.1 1998-10-07 11:10:58 jareth Exp $
   2 ;;;; This file implements a simple FIFO queue.
   3
   4 ;; Copyright (C) 1991-1995 Free Software Foundation
   5
   6 ;; Author: Inge Wallin <inge@lysator.liu.se>
   7 ;; Maintainer: elib-maintainers@lysator.liu.se
   8 ;; Created: before 9 May 1991
   9 ;; Keywords: extensions, lisp
  10
  11 ;;;; This file is part of the GNU Emacs lisp library, Elib.
  12 ;;;;
  13 ;;;; GNU Elib is free software; you can redistribute it and/or modify
  14 ;;;; it under the terms of the GNU General Public License as published by
  15 ;;;; the Free Software Foundation; either version 2, or (at your option)
  16 ;;;; any later version.
  17 ;;;;
  18 ;;;; GNU Elib is distributed in the hope that it will be useful,
  19 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;;; GNU General Public License for more details.
  22 ;;;;
  23 ;;;; You should have received a copy of the GNU General Public License
  24 ;;;; along with GNU Elib; see the file COPYING.  If not, write to
  25 ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;;;; Boston, MA 02111-1307, USA
  27 ;;;;
  28 ;;;; Author: Inge Wallin
  29 ;;;;
  30
  31 ;;; Commentary:
  32
  33 ;;; The queue is implemented as a two cons cell list, the first
  34 ;;; containing the tag 'QUEUE.  The car of the the second cons
  35 ;;; cell points at the first element of the queue and the cdr points
  36 ;;; at the last.  All entries and removals are done using destructive
  37 ;;; functions.
  38 ;;;
  39
  40
  41 ;;; Code:
  42
  43 ;; Provide the function version and remove the macro version
  44 (provide 'queue-f)
  45 (setq features (delq 'queue-m features))
  46
  47
  48 ;;; ================================================================
  49
  50
  51 (defun queue-create ()
  52   "Create an empty fifo queue."
  53   (cons 'QUEUE (cons nil nil)))
  54
  55
  56 (defun queue-p (queue)
  57   "Return t if QUEUE is a queue, otherwise return nil."
  58   (eq (car-safe queue) 'QUEUE))
  59
  60
  61 (defun queue-enqueue (queue element)
  62   "Enter an element into a queue.
  63 Args: QUEUE ELEMENT"
  64   (let ((elementcell (cons element nil)))
  65     (if (null (car (cdr queue)))
  66         ;; QUEUE is empty
  67         (setcar (cdr queue)
  68                 (setcdr (cdr queue)
  69                         elementcell))
  70       (setcdr (cdr (cdr queue))
  71               elementcell)
  72       (setcdr (cdr queue)
  73               elementcell))))
  74
  75
  76 (defun queue-dequeue (queue)
  77   "Remove the first element of QUEUE and return it.
  78 If QUEUE is empty, return nil and do nothing."
  79   (if (not (null (car (cdr queue))))
  80       (prog1
  81           (car (car (cdr queue)))
  82         (setcar (cdr queue)
  83                 (cdr (car (cdr queue))))
  84         (if (null (car (cdr queue)))
  85             (setcdr (cdr queue) nil)))))
  86
  87
  88 (defun queue-empty (queue)
  89   "Return t if QUEUE is empty, otherwise return nil."
  90   (null (car (cdr queue))))
  91
  92
  93 (defun queue-first (queue)
  94   "Return the first element of QUEUE or nil if it is empty.
  95 The element is not removed."
  96   (car-safe (car (cdr queue))))
  97
  98
  99 (defun queue-nth (queue n)
 100   "Return the nth element of a queue, but don't remove it.
 101 Args: QUEUE N
 102 If the length of the queue is less than N, return nil.
 103
 104 The oldest element (the first one) has number 0."
 105   (nth n (car (cdr queue))))
 106
 107
 108 (defun queue-last (queue)
 109   "Return the last element of QUEUE or nil if it is empty."
 110   (car-safe (cdr (cdr queue))))
 111
 112
 113 (defun queue-all (queue)
 114   "Return a list of all elements of QUEUE or nil if it is empty.
 115 The oldest element in the queue is the first in the list."
 116   (car (cdr queue)))
 117
 118
 119 (defun queue-copy (queue)
 120   "Return a copy of QUEUE.  All entries in QUEUE are also copied."
 121   (let* ((first  (copy-sequence (car (cdr queue))))
 122          (last first))
 123     (while (cdr last)
 124       (setq last (cdr last)))
 125     (cons 'QUEUE (cons first last))))
 126
 127
 128 (defun queue-length (queue)
 129   "Return the number of elements in QUEUE."
 130   (length (car (cdr queue))))
 131
 132
 133 (defun queue-clear (queue)
 134   "Remove all elements from QUEUE."
 135   (setcdr queue (cons nil nil)))
 136
 137 ;;; queue-f.el ends here