diff lisp/alist.el @ 219:262b8bb4a523 r20-4b8

Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents
children fbbf69b4e8a7
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/alist.el	Mon Aug 13 10:09:35 2007 +0200
@@ -0,0 +1,101 @@
+;;; alist.el --- utility functions about assoc-list
+
+;; Copyright (C) 1993,1994,1995,1996 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Version:
+;;	$Id: alist.el,v 1.1 1997/11/29 20:37:43 steve Exp $
+;; Keywords: alist
+
+;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
+
+;; This program 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.
+
+;; This program 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 Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defun put-alist (item value alist)
+  "Modify ALIST to set VALUE to ITEM.
+If there is a pair whose car is ITEM, replace its cdr by VALUE.
+If there is not such pair, create new pair (ITEM . VALUE) and
+return new alist whose car is the new pair and cdr is ALIST.
+\[tomo's ELIS like function]"
+  (let ((pair (assoc item alist)))
+    (if pair
+	(progn
+	  (setcdr pair value)
+	  alist)
+      (cons (cons item value) alist)
+      )))
+
+(defun del-alist (item alist)
+  "If there is a pair whose key is ITEM, delete it from ALIST.
+\[tomo's ELIS emulating function]"
+  (if (equal item (car (car alist)))
+      (cdr alist)
+    (let ((pr alist)
+	  (r (cdr alist))
+	  )
+      (catch 'tag
+	(while (not (null r))
+	  (if (equal item (car (car r)))
+	      (progn
+		(rplacd pr (cdr r))
+		(throw 'tag alist)))
+	  (setq pr r)
+	  (setq r (cdr r))
+	  )
+	alist))))
+
+(defun set-alist (symbol item value)
+  "Modify a alist indicated by SYMBOL to set VALUE to ITEM."
+  (or (boundp symbol)
+      (set symbol nil)
+      )
+  (set symbol (put-alist item value (symbol-value symbol)))
+  )
+
+(defun remove-alist (symbol item)
+  "Remove ITEM from the alist indicated by SYMBOL."
+  (and (boundp symbol)
+       (set symbol (del-alist item (symbol-value symbol)))
+       ))
+
+(defun modify-alist (modifier default)
+  "Modify alist DEFAULT into alist MODIFIER."
+  (mapcar (function
+	   (lambda (as)
+	     (setq default (put-alist (car as)(cdr as) default))
+	     ))
+	  modifier)
+  default)
+
+(defun set-modified-alist (sym modifier)
+  "Modify a value of a symbol SYM into alist MODIFIER.
+The symbol SYM should be alist. If it is not bound,
+its value regard as nil."
+  (if (not (boundp sym))
+      (set sym nil)
+    )
+  (set sym (modify-alist modifier (eval sym)))
+  )
+
+
+;;; @ end
+;;;
+
+(provide 'alist)
+
+;;; alist.el ends here