From 3acb121e6035630f2e24c990e414e942a8bb186d Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 7 Mar 2003 19:40:14 +0000 Subject: [PATCH] Use DEFINE-RECORD-TYPE to make record descriptions more succinct. --- v7/src/rcs/object.scm | 72 ++++++++++++++++++++----------------------- 1 file changed, 33 insertions(+), 39 deletions(-) diff --git a/v7/src/rcs/object.scm b/v7/src/rcs/object.scm index 172f54434..1d47cf88b 100644 --- a/v7/src/rcs/object.scm +++ b/v7/src/rcs/object.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: object.scm,v 1.7 2003/02/14 18:28:32 cph Exp $ +$Id: object.scm,v 1.8 2003/03/07 19:40:14 cph Exp $ -Copyright (c) 1988, 1991, 1999, 2000 Massachusetts Institute of Technology +Copyright 1991,2000,2003 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -27,43 +27,37 @@ USA. (declare (usual-integrations)) -(define rcstext-rtd - (make-record-type - "rcstext" - '(head branch access symbols locks strict? comment expand description))) - -(define make-rcstext (record-constructor rcstext-rtd)) -(define rcstext/head (record-accessor rcstext-rtd 'head)) -(define rcstext/branch (record-accessor rcstext-rtd 'branch)) -(define rcstext/access (record-accessor rcstext-rtd 'access)) -(define rcstext/symbols (record-accessor rcstext-rtd 'symbols)) -(define rcstext/locks (record-accessor rcstext-rtd 'locks)) -(define rcstext/strict? (record-accessor rcstext-rtd 'strict?)) -(define rcstext/comment (record-accessor rcstext-rtd 'comment)) -(define rcstext/expand (record-accessor rcstext-rtd 'expand)) -(define rcstext/description (record-accessor rcstext-rtd 'description)) - -(define delta-rtd - (make-record-type "rcsdelta" - '(number date author state branches next log text))) - -(define make-delta (record-constructor delta-rtd)) -(define delta/number (record-accessor delta-rtd 'number)) -(define delta/date (record-accessor delta-rtd 'date)) -(define delta/author (record-accessor delta-rtd 'author)) -(define delta/state (record-accessor delta-rtd 'state)) -(define delta/branches (record-accessor delta-rtd 'branches)) -(define delta/next (record-accessor delta-rtd 'next)) -(define set-delta/next! (record-updater delta-rtd 'next)) -(define delta/log (record-accessor delta-rtd 'log)) -(define set-delta/log! (record-updater delta-rtd 'log)) -(define delta/text (record-accessor delta-rtd 'text)) -(define set-delta/text! (record-updater delta-rtd 'text)) - -(set-record-type-unparser-method! delta-rtd - (unparser/standard-method 'rcsdelta - (lambda (state delta) - (unparse-string state (delta/number delta))))) +(define-record-type + (make-rcstext head branch access symbols locks strict? comment expand + description) + rcstext? + (head rcstext/head) + (branch rcstext/branch) + (access rcstext/access) + (symbols rcstext/symbols) + (locks rcstext/locks) + (strict? rcstext/strict?) + (comment rcstext/comment) + (expand rcstext/expand) + (description rcstext/description)) + +(define-record-type + (make-delta number date author state branches next log text) + delta? + (number delta/number) + (date delta/date) + (author delta/author) + (state delta/state) + (branches delta/branches) + (next delta/next set-delta/next!) + (log delta/log set-delta/log!) + (text delta/text set-delta/text!)) + +(set-record-type-unparser-method! + (standard-unparser-method 'RCS-DELTA + (lambda (delta port) + (write-char #\space port) + (write-string (delta/number delta) port)))) (define (date/make year month day hour minute second) (let ((year (if (< year 100) (+ 1900 year) year))) -- 2.25.1