emacs-lisp/alist.el

   1 ;;; alist.el --- utility functions for association list
   2
   3 ;; Copyright (C) 1993,1994,1995,1996,1998,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: alist
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 ;;;###autoload
  28 (defun put-alist (key value alist)
  29   "Set cdr of an element (KEY . ...) in ALIST to VALUE and return ALIST.
  30 If there is no such element, create a new pair (KEY . VALUE) and
  31 return a new alist whose car is the new pair and cdr is ALIST."
  32   (let ((elm (assoc key alist)))
  33     (if elm
  34         (progn
  35           (setcdr elm value)
  36           alist)
  37       (cons (cons key value) alist))))
  38
  39 ;;;###autoload
  40 (defun del-alist (key alist)
  41   "Delete an element whose car equals KEY from ALIST.
  42 Return the modified ALIST."
  43   (if (equal key (car (car alist)))
  44       (cdr alist)
  45     (let ((pr alist)
  46           (r (cdr alist)))
  47       (catch 'tag
  48         (while (not (null r))
  49           (if (equal key (car (car r)))
  50               (progn
  51                 (rplacd pr (cdr r))
  52                 (throw 'tag alist)))
  53           (setq pr r)
  54           (setq r (cdr r)))
  55         alist))))
  56
  57 ;;;###autoload
  58 (defun set-alist (symbol key value)
  59   "Set cdr of an element (KEY . ...) in the alist bound to SYMBOL to VALUE."
  60   (or (boundp symbol)
  61       (set symbol nil))
  62   (set symbol (put-alist key value (symbol-value symbol))))
  63
  64 ;;;###autoload
  65 (defun remove-alist (symbol key)
  66   "Delete an element whose car equals KEY from the alist bound to SYMBOL."
  67   (and (boundp symbol)
  68        (set symbol (del-alist key (symbol-value symbol)))))
  69
  70 ;;;###autoload
  71 (defun modify-alist (modifier default)
  72   "Store elements in the alist MODIFIER in the alist DEFAULT.
  73 Return the modified alist."
  74   (mapcar (function
  75            (lambda (as)
  76              (setq default (put-alist (car as)(cdr as) default))))
  77           modifier)
  78   default)
  79
  80 ;;;###autoload
  81 (defun set-modified-alist (symbol modifier)
  82   "Store elements in the alist MODIFIER in an alist bound to SYMBOL.
  83 If SYMBOL is not bound, set it to nil at first."
  84   (if (not (boundp symbol))
  85       (set symbol nil))
  86   (set symbol (modify-alist modifier (eval symbol))))
  87
  88
  89 ;;; @ association-vector-list
  90 ;;;
  91
  92 ;;;###autoload
  93 (defun vassoc (key avlist)
  94   "Search AVLIST for an element whose first element equals KEY.
  95 AVLIST is a list of vectors.
  96 See also `assoc'."
  97   (while (and avlist
  98               (not (equal key (aref (car avlist) 0))))
  99     (setq avlist (cdr avlist)))
 100   (and avlist
 101        (car avlist)))
 102
 103
 104 ;;; @ end
 105 ;;;
 106
 107 (require 'product)
 108 (product-provide (provide 'alist) (require 'apel-ver))
 109
 110 ;;; alist.el ends here