Mercurial > hg > xemacs-beta

comparison lisp/skk/queue-m.el @ 219:262b8bb4a523 r20-4b8

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