#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/format.scm,v 1.1 1991/01/18 19:07:22 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/format.scm,v 1.2 1991/01/19 04:21:02 cph Exp $
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
;;;; RCS Format
(declare (usual-integrations))
-(declare (integrate-external "object"))
\f
(define (rcs/format rcstext)
(let ((head (rcstext/head rcstext)))
(define (format/lock lock)
(write-string " ")
- (write (car lock))
+ (write-string (car lock))
(write-string ": ")
(write-string (delta/number (cdr lock))))
(define (format/user user)
(write-string " ")
- (write user))
+ (write-string user))
(define (format/symbol symbol)
(write-string " ")
- (write (car symbol))
+ (write-string (car symbol))
(write-string ": ")
(write-string (delta/number (cdr symbol))))
-\f
+
(define (format/delta-trunk head)
(let loop ((delta head))
(if delta
- (begin (format/delta delta)
- (loop (delta/next delta))))))
+ (begin
+ (format/delta delta)
+ (loop (delta/next delta))))))
(define (format/delta-tree head)
(if head
- (begin (format/delta-tree (delta/next head))
- (format/delta-forest (delta/branches head)))))
+ (begin
+ (format/delta-tree (delta/next head))
+ (format/delta-forest (delta/branches head)))))
(define (format/delta-forest branches)
(if (not (null? branches))
- (begin (format/delta-forest (cdr branches))
- (format/delta-branch (car branches))
- (format/delta-tree (car branches)))))
+ (begin
+ (format/delta-forest (cdr branches))
+ (format/delta-branch (car branches))
+ (format/delta-tree (car branches)))))
(define (format/delta-branch branch)
(if branch
- (begin (format/delta-branch (delta/next branch))
- (format/delta branch))))
+ (begin
+ (format/delta-branch (delta/next branch))
+ (format/delta branch))))
(define (format/delta delta)
(write-string "----------------------------\nrevision ")
(write-string "\ndate: ")
(format/date (delta/date delta))
(write-string "; author: ")
- (write (delta/author delta))
+ (write-string (delta/author delta))
(write-string "; state: ")
- (write (delta/state delta))
+ (write-string (delta/state delta))
(newline)
(write-string (delta/log delta)))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/logmer.scm,v 1.1 1991/01/18 19:07:39 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/logmer.scm,v 1.2 1991/01/19 04:21:08 cph Exp $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
;;;; RCS Log Merge
(declare (usual-integrations))
-(declare (integrate-external "object"))
\f
(define trace-port false)
(write-string "\ndate: ")
(write-string (date->string (delta/date delta)))
(write-string "; author: ")
- (write (delta/author delta))
+ (write-string (delta/author delta))
(write-string "; state: ")
- (write (delta/state delta))
+ (write-string (delta/state delta))
(newline))
(define (compress-entries entries)
(write-string (pathname->string pathname) trace-port)))
(let ((deltas (rcstext->deltas (rcs/read-file pathname 'LOG-ONLY))))
(for-each (lambda (delta)
- (delta/set-log! delta
+ (set-delta/log! delta
(let ((log (string-trim (delta/log delta))))
(if (string-null? log)
empty-log-message
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/make.scm,v 1.1 1991/01/18 19:07:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/make.scm,v 1.2 1991/01/19 04:21:14 cph Exp $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(declare (usual-integrations))
+(load-option 'hash-table)
(package/system-loader "rcs" '() 'QUERY)
-(add-identification! "RCS" 1 0)
\ No newline at end of file
+(add-identification! "RCS" 2 0)
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/object.scm,v 1.1 1991/01/18 19:08:04 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/object.scm,v 1.2 1991/01/19 04:21:19 cph Exp $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(declare (usual-integrations))
\f
-(define-integrable (rcstext/make head access symbols locks strict? comment
- description)
- (vector rcstext/tag head access symbols locks strict? comment description))
-
-(define rcstext/tag
- "rcstext")
-
-(define-integrable (rcstext/head rcstext) (vector-ref rcstext 1))
-(define-integrable (rcstext/access rcstext) (vector-ref rcstext 2))
-(define-integrable (rcstext/symbols rcstext) (vector-ref rcstext 3))
-(define-integrable (rcstext/locks rcstext) (vector-ref rcstext 4))
-(define-integrable (rcstext/strict? rcstext) (vector-ref rcstext 5))
-(define-integrable (rcstext/comment rcstext) (vector-ref rcstext 6))
-(define-integrable (rcstext/description rcstext) (vector-ref rcstext 7))
-
-(define-integrable (rcstext/set-head! rcstext head)
- (vector-set! rcstext 1 head))
-
-(define-integrable (rcstext/set-access! rcstext access)
- (vector-set! rcstext 2 access))
-
-(define-integrable (rcstext/set-symbols! rcstext symbols)
- (vector-set! rcstext 3 symbols))
-
-(define-integrable (rcstext/set-locks! rcstext locks)
- (vector-set! rcstext 4 locks))
-
-(define-integrable (rcstext/set-strict?! rcstext strict?)
- (vector-set! rcstext 5 strict?))
-
-(define-integrable (rcstext/set-comment! rcstext comment)
- (vector-set! rcstext 6 comment))
-
-(define-integrable (rcstext/set-description! rcstext description)
- (vector-set! rcstext 7 description))
-\f
-(define-integrable (delta/make number)
- (vector delta/tag number false false false false false false false))
-
-(define delta/tag
- "delta")
-
-(define-integrable (delta/number delta) (vector-ref delta 1))
-(define-integrable (delta/date delta) (vector-ref delta 2))
-(define-integrable (delta/author delta) (vector-ref delta 3))
-(define-integrable (delta/state delta) (vector-ref delta 4))
-(define-integrable (delta/branches delta) (vector-ref delta 5))
-(define-integrable (delta/next delta) (vector-ref delta 6))
-(define-integrable (delta/log delta) (vector-ref delta 7))
-(define-integrable (delta/text delta) (vector-ref delta 8))
-
-(define-integrable (delta/set-number! delta number)
- (vector-set! delta 1 number))
-
-(define-integrable (delta/set-date! delta date)
- (vector-set! delta 2 date))
-
-(define-integrable (delta/set-author! delta author)
- (vector-set! delta 3 author))
-
-(define-integrable (delta/set-state! delta state)
- (vector-set! delta 4 state))
-
-(define-integrable (delta/set-branches! delta branches)
- (vector-set! delta 5 branches))
-
-(define-integrable (delta/set-next! delta next)
- (vector-set! delta 6 next))
-
-(define-integrable (delta/set-log! delta log)
- (vector-set! delta 7 log))
-
-(define-integrable (delta/set-text! delta text)
- (vector-set! delta 8 text))
-
-(unparser/set-tagged-vector-method!
- delta/tag
- (unparser/standard-method "DELTA"
- (lambda (state delta)
- (unparse-string state (delta/number delta)))))
+(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)))))
\f
(define (date/make year month day hour minute second)
(vector
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/rcs.pkg,v 1.1 1991/01/18 19:09:56 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/rcs.pkg,v 1.2 1991/01/19 04:21:25 cph Exp $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
rcs/format))
(define-package (rcs parser)
- (files "parser")
+ (files "nparse")
(parent (rcs))
(export (rcs)
rcs/read-file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/rcs.sf,v 1.1 1991/01/18 19:10:09 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/rcs.sf,v 1.2 1991/01/19 04:21:33 cph Exp $
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
MIT in each case. |#
(fluid-let ((sf/default-syntax-table system-global-syntax-table))
- (sf-conditionally "object")
(sf-directory "."))
;; Guarantee that the package modeller is loaded.
projects / mit-scheme.git / commitdiff