tl-list.el

   1 ;;;
   2 ;;; $Id: tl-list.el,v 0.3 1994/07/16 04:08:52 morioka Exp morioka $
   3 ;;;
   4
   5 (provide 'tl-list)
   6
   7 ;;; @ alist
   8 ;;;
   9
  10 (defun put-alist (item value alist)
  11   "\t(put-alist <ITEM> <VALUE> <ALIST>)\n
  12 If there is a pair whose car is <ITEM>, replace its cdr by <VALUE>.
  13 If there is not such pair, create new pair (<ITEM> . <VALUE>) and
  14 return new alist whose car is the new pair and cdr is <ALIST>.
  15 [mol's ELIS emulating function]"
  16   (if (assoc item alist)
  17       (progn
  18         (rplacd (assoc item alist) value)
  19         alist)
  20     (cons (cons item value) alist)
  21     ))
  22
  23 (defun del-alist (item alist)
  24   "\t(del-alist <ITEM> <ALIST>)\n
  25 If there is a pair whose key is <ITEM>, delete it from <ALIST>.
  26 [mol's ELIS emulating function]"
  27   (if (equal item (car (car alist)))
  28       (cdr alist)
  29     (let ((pr alist)
  30           (r (cdr alist))
  31           )
  32       (catch 'tag
  33         (while (not (null r))
  34           (if (equal item (car (car r)))
  35               (progn
  36                 (rplacd pr (cdr r))
  37                 (throw 'tag alist)))
  38           (setq pr r)
  39           (setq r (cdr r))
  40           )
  41         alist))))
  42
  43
  44 ;;; @ field
  45 ;;;
  46
  47 (defun fetch-field (key alist)
  48   (assoc key alist))
  49
  50 (fset 'put-field 'put-alist)
  51 (fset 'delete-field 'del-alist)