Mercurial > hg > xemacs-beta
diff lisp/skk/queue-m.el @ 219:262b8bb4a523 r20-4b8
Import from CVS: tag r20-4b8
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:09:35 +0200 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/skk/queue-m.el Mon Aug 13 10:09:35 2007 +0200 @@ -0,0 +1,142 @@ +;;;; $Id: queue-m.el,v 1.1 1997/12/02 08:48:36 steve Exp $ +;;;; This file implements a simple FIFO queue using macros. + +;; Copyright (C) 1991-1995 Free Software Foundation + +;; Author: Inge Wallin <inge@lysator.liu.se> +;; Maintainer: elib-maintainers@lysator.liu.se +;; Created: before 12 May 1991 +;; Last Modified: $Date: 1997/12/02 08:48:36 $ +;; Keywords: extensions, lisp + +;;;; +;;;; This file is part of the GNU Emacs lisp library, Elib. +;;;; +;;;; GNU Elib 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, or (at your option) +;;;; any later version. +;;;; +;;;; GNU Elib 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 GNU Elib; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;;; Boston, MA 02111-1307, USA +;;;; +;;;; Author: Inge Wallin +;;;; + +;;; Commentary: + +;;; The queue is implemented as a two cons cell list, the first +;;; containing the tag 'QUEUE. The car of the the second cons +;;; cell points at the first element of the queue and the cdr points +;;; at the last. All entries and removals are done using destructive +;;; functions. +;;; +;;; This file implements the short functions as macros for speed in +;;; compiled code. +;;; + + +;;; Code: + +;; Provide the function version and remove the macro version +(provide 'queue-m) +(setq features (delq 'queue-f features)) + + +;;; ================================================================ + + +(defmacro queue-create () + "Create an empty fifo queue." + (` (cons 'QUEUE (cons nil nil)))) + + +(defmacro queue-p (queue) + "Return t if QUEUE is a queue, otherwise return nil." + (` (eq (car-safe (, queue)) 'QUEUE))) + + +(defun queue-enqueue (queue element) + "Enter an element into a queue. +Args: QUEUE ELEMENT" + (let ((elementcell (cons element nil))) + (if (null (car (cdr queue))) + ;; QUEUE is empty + (setcar (cdr queue) + (setcdr (cdr queue) + elementcell)) + (setcdr (cdr (cdr queue)) + elementcell) + (setcdr (cdr queue) + elementcell)))) + + +(defun queue-dequeue (queue) + "Remove the first element of QUEUE and return it. +If QUEUE is empty, return nil and do nothing." + (if (car (cdr queue)) + (prog1 + (car (car (cdr queue))) + (setcar (cdr queue) + (cdr (car (cdr queue)))) + (if (null (car (cdr queue))) + (setcdr (cdr queue) nil))))) + + +(defmacro queue-empty (queue) + "Return t if QUEUE is empty, otherwise return nil." + (` (null (car (cdr (, queue)))))) + + +(defmacro queue-first (queue) + "Return the first element of QUEUE or nil if it is empty. +The element is not removed." + (` (car-safe (car (cdr (, queue)))))) + + +(defmacro queue-nth (queue n) + "Return the nth element of a queue, but don't remove it. +Args: QUEUE N +If the length of the queue is less than N, return nil. + +The oldest element (the first one) has number 0." + (` (nth (, n) (car (cdr (, queue)))))) + + +(defmacro queue-last (queue) + "Return the last element of QUEUE or nil if it is empty." + (` (car-safe (cdr (cdr (, queue)))))) + + +(defmacro queue-all (queue) + "Return a list of all elements of QUEUE or nil if it is empty. +The oldest element in the queue is the first in the list." + (` (car (cdr (, queue))))) + + +(defun queue-copy (queue) + "Return a copy of QUEUE. All entries in QUEUE are also copied." + (let* ((first (copy-sequence (car (cdr queue)))) + (last first)) + (while (cdr last) + (setq last (cdr last))) + (cons 'QUEUE (cons first last)))) + + +(defmacro queue-length (queue) + "Return the number of elements in QUEUE." + (` (length (car (cdr (, queue)))))) + + +(defmacro queue-clear (queue) + "Remove all elements from QUEUE." + (` (setcdr (, queue) (cons nil nil)))) + +;;; queue-m.el ends here