/[meta-cvs]/meta-cvs/F-396AC90CF9764F6D317C43BA46376C96.lisp
ViewVC logotype

Contents of /meta-cvs/F-396AC90CF9764F6D317C43BA46376C96.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu Oct 31 04:06:01 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-0-3
Changes since 1.1: +3 -0 lines
* code/mcvs-package.lisp: New file, defines META-CVS package.

* code/purge.lisp: Put all symbols in new package.
* code/restore.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/install.sh: Likewise.
* code/restart.lisp: Likewise.
* code/update.lisp: Likewise.
* code/move.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/branch.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/link.lisp: Likewise.
* code/split.lisp: Likewise.
* code/watch.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/add.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/print.lisp: Likewise.
* code/types.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/error.lisp: Likewise.
* code/options.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/create.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/remap.lisp: Likewise.

* code/mapping.lisp: Put symbols in new package. Replace use
of CLISP specific substring function with subseq.
* code/filt.lisp: Likewise.

* code/mcvs-main.lisp: Put symbols in new package. The mcvs
function is renamed to main.

* code/install.sh: Generate mcvs script that uses qualified name
of new startup functiont to start the software.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "mcvs-package")
6 (provide "multi-hash")
7
8 (in-package "META-CVS")
9
10 (defclass multi-hash ()
11 ((dimensions :initarg :dimensions :accessor dimensions)
12 (root-hash :initform nil)
13 (tests :initform nil :initarg :tests :accessor tests)))
14
15 (defmethod initialize-instance :after ((h multi-hash) &rest stuff)
16 (declare (ignore stuff))
17 (with-slots (dimensions root-hash tests) h
18 (setf root-hash (make-hash-table :test (or (first tests) #'eql)))))
19
20 (defmacro multi-hash-common-code (setf-p)
21 `(with-slots (dimensions root-hash tests) multi-hash
22 (do* ((i 0 (1+ i))
23 (next-hash nil (or (gethash (first arg) current-hash)
24 ,(if setf-p
25 `(setf (gethash (first arg) current-hash)
26 (make-hash-table :test (or (nth i tests)
27 #'eql)))
28 `(return (values nil nil)))))
29 (arg args (rest arg))
30 (current-hash root-hash next-hash))
31 ((= i (1- dimensions))
32 ,(if setf-p
33 `(setf (gethash (first arg) current-hash) (second arg))
34 `(gethash (first arg) current-hash))))))
35
36 (defun get-multi-hash (multi-hash &rest args)
37 (multi-hash-common-code nil))
38
39 (defun set-multi-hash (multi-hash &rest args)
40 (multi-hash-common-code t))
41
42 (defsetf get-multi-hash set-multi-hash)

  ViewVC Help
Powered by ViewVC 1.1.5