/[meta-cvs]/meta-cvs/F-2ED287F6C649DBFD20CE8757A9BE1DA5.lisp
ViewVC logotype

Contents of /meta-cvs/F-2ED287F6C649DBFD20CE8757A9BE1DA5.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations)
Fri Nov 24 04:53:49 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.5: +1 -1 lines
Stylistic change.

* code/add.lisp: Change in-package calls not to use the all-caps
"META-CVS" string string, but rather the :meta-cvs keyword.
* code/branch.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/create.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/error.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/filt.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/link.lisp: Likewise.
* code/main.lisp: Likewise.
* code/mapping.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/move.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/options.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/print.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/purge.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/remap.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/restart.lisp: Likewise.
* code/restore.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/split.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/types.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/update.lisp: Likewise.
* code/watch.lisp: Likewise.
1 kaz 1.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 kaz 1.6 (in-package :meta-cvs)
6 kaz 1.4
7 kaz 1.1 (defmacro with-slot-refs ((&rest slot-entries) instance-form &body forms)
8     "A macro similar to with-slots, except that each occurence of any
9     of the bound variables newly evaluates instance-form."
10     (let ((slot-macrolets
11     (mapcar #'(lambda (e)
12     (cond
13     ((consp e)
14     (when (or (not (= (length e) 2))
15     (not (symbolp (first e)))
16     (not (symbolp (second e))))
17     (error "with-slots-*: slot entry ~a must be two symbols." e))
18     `(,(first e) (slot-value ,instance-form ',(second e))))
19 kaz 1.3 ((symbolp e)
20 kaz 1.1 `(,e (slot-value ,instance-form ',e)))
21 kaz 1.3 (t (error "with-slots-*: slot entry ~a must be a symbol." e))))
22 kaz 1.1 slot-entries)))
23     `(symbol-macrolet ,slot-macrolets ,@forms)))
24    
25     (defmacro with-multi-slot-refs ((&rest refs) &body forms)
26     "Allows nested slot-shorthand invocations to be collapsed. That is:
27 kaz 1.2 (with-slot-refs (E-1) I-1 ... ( ... (with-slot-refs (E-N) I-N F) ... ) ...)
28 kaz 1.1 can be rewritten:
29     (with-slot-refs-* ((E-1) I1 ... (E-N) V-N) F)"
30     (let (refs-pairs (expansion forms))
31     (do ((entries (pop refs) (pop refs))
32     (instance (pop refs) (pop refs)))
33     ((null entries))
34     (push (list entries instance) refs-pairs))
35     (if (null refs-pairs)
36     `(progn ,@expansion)
37     (dolist (refs-pair refs-pairs (first expansion))
38     (setf expansion `((with-slot-refs ,@refs-pair ,@expansion)))))))
39    

  ViewVC Help
Powered by ViewVC 1.1.5