From: morioka Date: Thu, 27 May 1999 09:37:02 +0000 (+0000) Subject: (calist-package-alist): New variable. X-Git-Tag: apel-9_20~59 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=0d1d483074d501ed6a6b43bdfa96c981f14e9384;p=elisp%2Fapel.git (calist-package-alist): New variable. (make-calist-package): New function. (find-calist-package): New function. (in-calist-package): New function. (standard): New calist package. (calist-field-match-method): Use method for `t' as a default method; set up `calist-default-field-match-method' as method for `t' of `standard' package. --- diff --git a/calist.el b/calist.el index 504476a..d11b466 100644 --- a/calist.el +++ b/calist.el @@ -1,8 +1,10 @@ ;;; calist.el --- Condition functions -;; Copyright (C) 1998 MORIOKA Tomohiko. +;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: condition, alist, tree ;; This file is part of APEL (A Portable Emacs Library). @@ -26,7 +28,28 @@ (eval-when-compile (require 'cl)) -(defvar calist-field-match-method-obarray [nil]) +(require 'alist) + +(defvar calist-package-alist nil) +(defvar calist-field-match-method-obarray nil) + +(defun make-calist-package (name) + "Create a new calist-package." + (let ((p (make-vector 7 0))) + (set-alist 'calist-package-alist name p) + p)) + +(defun find-calist-package (name) + "Return a calist-package by NAME." + (cdr (assq name calist-package-alist))) + +(defun in-calist-package (name) + "Set the current calist-package to a new or existing calist-package." + (setq calist-field-match-method-obarray + (or (find-calist-package name) + (make-calist-package name)))) + +(in-calist-package 'standard) (defun define-calist-field-match-method (field-type function) "Set field-match-method for FIELD-TYPE to FUNCTION." @@ -43,13 +66,13 @@ ((equal (cdr s-field) field-value) calist)))) +(define-calist-field-match-method t #'calist-default-field-match-method) + (defsubst calist-field-match-method (field-type) - (condition-case nil - (symbol-function - (intern-soft - (symbol-name field-type) calist-field-match-method-obarray)) - (error (symbol-function 'calist-default-field-match-method)) - )) + (symbol-function + (or (intern-soft + (symbol-name field-type) calist-field-match-method-obarray) + (intern-soft "t" calist-field-match-method-obarray)))) (defsubst calist-field-match (calist field-type field-value) (funcall (calist-field-match-method field-type)