cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-el.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-el.el --
   4
   5 ;;; This file is part of ILISP.
   6 ;;; Version: 5.8
   7 ;;;
   8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
   9 ;;;               1993, 1994 Ivan Vasquez
  10 ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11 ;;;               1996 Marco Antoniotti and Rick Campbell
  12 ;;;
  13 ;;; Other authors' names for which this Copyright notice also holds
  14 ;;; may appear later in this file.
  15 ;;;
  16 ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17 ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18 ;;; mailing list were bugs and improvements are discussed.
  19 ;;;
  20 ;;; ILISP is freely redistributable under the terms found in the file
  21 ;;; COPYING.
  22
  23
  24 ;;;
  25 ;;; ILISP extensions to emacs lisp
  26 ;;;
  27
  28
  29
  30 ;;;%Utils
  31 ;;; This should be in emacs, but it isn't.
  32 (defun lisp-mem (item list &optional elt=)
  33   "Test to see if ITEM is equal to an item in LIST.
  34 Option comparison function ELT= defaults to equal."
  35   (let ((elt= (or elt= (function equal)))
  36         (done nil))
  37     (while (and list (not done))
  38       (if (funcall elt= item (car list))
  39           (setq done list)
  40           (setq list (cdr list))))
  41     done))
  42
  43
  44
  45 ;;;%%Misc
  46 (defun lisp-memk (item list key)
  47   "Test to see if ITEM is in LIST using KEY on each item in LIST
  48 before comparing it to ITEM."
  49   (lisp-mem item list (function (lambda (x y)
  50                         (equal x (funcall key y))))))
  51
  52 ;;; This should be in emacs, but it isn't.
  53 (defun lisp-del (item list &optional test)
  54   "Delete ITEM from LIST using TEST comparison and return the result.
  55 Default test is equal."
  56   (let ((test (or test (function equal)))
  57         (element list)
  58         (prev nil)
  59         (done nil))
  60     (while (and element (not done))
  61       (if (funcall test item (car element))
  62           (progn
  63             (setq done t)
  64             (if prev
  65                 (rplacd prev (cdr element))
  66                 (setq list (cdr list))))
  67           (setq prev element
  68                 element (cdr element))))
  69     list))
  70
  71 ;;;
  72 (defun lisp-last (list)
  73   "Return the last element of LIST."
  74   (while (cdr list)
  75     (setq list (cdr list)))
  76   (car list))