From 44114984684ac4b34cbd0754414b2308b844418c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 3 Sep 1993 04:41:44 +0000 Subject: [PATCH] Fix typo. Split new doc string stuff into separate file. --- v7/src/edwin/comman.scm | 161 +--------------------------------------- v7/src/edwin/decls.scm | 3 +- v7/src/edwin/ed-ffi.scm | 44 ++++++++++- v7/src/edwin/edwin.ldr | 3 +- v7/src/edwin/edwin.pkg | 3 +- 5 files changed, 52 insertions(+), 162 deletions(-) diff --git a/v7/src/edwin/comman.scm b/v7/src/edwin/comman.scm index 389081c26..b44a51892 100644 --- a/v7/src/edwin/comman.scm +++ b/v7/src/edwin/comman.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: comman.scm,v 1.73 1993/09/02 20:10:03 gjr Exp $ +$Id: comman.scm,v 1.74 1993/09/03 04:41:14 cph Exp $ Copyright (c) 1986, 1989-1993 Massachusetts Institute of Technology @@ -128,7 +128,7 @@ of that license should have been included along with this file. (let ((desc (variable-%description variable))) (if (string? desc) desc - (let ((new (->doc-string (%symbol->string (veriable-name variable)) + (let ((new (->doc-string (%symbol->string (variable-name variable)) desc))) (if new (set-variable-%description! variable new)) @@ -161,7 +161,7 @@ of that license should have been included along with this file. (define-integrable (make-variable-buffer-local! variable) (set-variable-buffer-local?! variable #t)) - + (define (check-variable-value-validity! variable value) (if (not (variable-value-valid? variable value)) (editor-error "Invalid value for " (variable-name-string variable) @@ -192,157 +192,4 @@ of that license should have been included along with this file. (define (->variable object) (if (variable? object) object - (name->variable object))) - -;;;; Maintaining doc strings externally. - -(define *external-doc-strings?* true) -(define *external-doc-strings-file* false) -(define *doc-strings* false) -(define *doc-string-posn* 0) -(define *doc-string-channel* false) -(define *doc-string-buffer* false) - -(define (doc-string->posn name str) - (if (not *external-doc-strings?*) - str - (let ((nlen (string-length name)) - (dslen (string-length str)) - (slen (if (not *doc-strings*) - 0 - (string-length *doc-strings*))) - (posn *doc-string-posn*)) - (let* ((next (fix:+ posn nlen)) - (end (fix:+ next (fix:+ dslen 6)))) - (if (> end slen) - (let ((new (string-allocate - (max end - (if (fix:zero? slen) - 4096 - (fix:+ slen (fix:quotient slen 2))))))) - (if *doc-strings* - (substring-move-right! *doc-strings* 0 posn new 0)) - (set! *doc-strings* new))) - (let ((doc-strings *doc-strings*)) - (vector-8b-set! doc-strings posn (fix:remainder dslen 256)) - (vector-8b-set! doc-strings - (fix:+ posn 1) - (fix:quotient dslen 256)) - (string-set! doc-strings (fix:+ posn 2) #\Newline) - (substring-move-right! name 0 nlen doc-strings (fix:+ posn 3)) - (string-set! doc-strings (fix:+ next 3) #\Newline) - (substring-move-right! str 0 dslen doc-strings (fix:+ next 4)) - (string-set! doc-strings (fix:- end 2) #\Newline) - (string-set! doc-strings (fix:- end 1) #\Newline) - (set! *doc-string-posn* end) - posn))))) - -(define-integrable doc-string-buffer-length 512) - -(define (->doc-string name posn) - (define (out-of-range) - (editor-error "->doc-string: Out of range argument" posn)) - - (define (fill-buffer channel buffer posn blen) - (let fill-loop ((posn posn)) - (if (fix:< posn blen) - (let ((n (channel-read-block channel buffer posn blen))) - (fill-loop (fix:+ posn n)))))) - - (define (verify-and-extract buffer nlen dslen nposn) - (let ((nend (fix:+ nposn nlen))) - (if (not (string=? (substring buffer nposn nend) name)) - (editor-error "->doc-string: Inconsistency" posn) - (let ((dstart (fix:+ nend 1))) - (substring buffer dstart (fix:+ dstart dslen)))))) - - (cond ((string? posn) - posn) - ((not (fix:fixnum? posn)) - (editor-error "->doc-string: Wrong type argument" posn)) - ((fix:< posn 0) - (out-of-range)) - (*doc-strings* - (let ((slen (string-length *doc-strings*)) - (nlen (string-length name))) - (if (fix:> (fix:+ posn 2) slen) - (out-of-range)) - (let ((dslen - (fix:+ (vector-8b-ref *doc-strings* posn) - (fix:lsh (vector-8b-ref *doc-strings* (fix:+ posn 1)) - 8)))) - (if (fix:> (fix:+ (fix:+ posn 6) (fix:+ nlen dslen)) slen) - (out-of-range) - (verify-and-extract *doc-strings* nlen dslen - (fix:+ posn 3)))))) - (else - (guarantee-doc-string-state) - (let* ((channel *doc-string-channel*) - (buffer *doc-string-buffer*) - (flen (file-length channel)) - (nlen (string-length name)) - (delta (fix:- flen (fix:+ posn 2)))) - (if (fix:< delta 0) - (out-of-range)) - (file-set-position channel posn) - (let ((blen (min doc-string-buffer-length delta))) - (fill-buffer channel buffer 0 blen) - (let* ((dslen (fix:+ (vector-8b-ref buffer 0) - (fix:lsh (vector-8b-ref buffer 1) - 8))) - (end (fix:+ (fix:+ dslen nlen) 6))) - (cond ((not (fix:> end blen)) - (verify-and-extract buffer nlen dslen 3)) - ((fix:> (fix:+ end posn) flen) - (out-of-range)) - (else - (let* ((rlen (fix:+ (fix:+ nlen dslen) 1)) - (result (string-allocate rlen))) - (substring-move-right! buffer 3 blen result 0) - (fill-buffer channel result (fix:- blen 3) rlen) - (verify-and-extract result nlen dslen 0)))))))))) - -(define (dump-doc-strings output #!optional permanent) - (if (not *doc-strings*) - (error "dump-doc-strings: No doc strings to dump!")) - (set! *external-doc-strings-file* - (if (or (default-object? permanent) - (not permanent)) - output - permanent)) - (set-string-length! *doc-strings* *doc-string-posn*) - (call-with-binary-output-file - output - (lambda (port) - (output-port/write-string port *doc-strings*))) - (set! *external-doc-strings?* false) - (set! *doc-string-posn* 0) - (set! *doc-strings* false) - unspecific) - -(define (guarantee-doc-string-state) - (if (not *doc-string-buffer*) - (set! *doc-string-buffer* (string-allocate doc-string-buffer-length))) - (cond (*doc-string-channel*) - ((not *external-doc-strings-file*) - (editor-error - "guarantee-doc-string-channel: Undeclared doc-string file")) - (else - (let ((doc-strings - (if (or (pathname-absolute? *external-doc-strings-file*) - (file-exists? *external-doc-strings-file*)) - *external-doc-strings-file* - (merge-pathnames *external-doc-strings-file* - (edwin-etc-directory))))) - (if (not (file-exists? doc-strings)) - (editor-error - "guarantee-doc-string-channel: Non-existent doc-string file") - (begin - (set! *doc-string-channel* - (file-open-input-channel - (->namestring doc-strings))) - unspecific)))))) - -(add-event-receiver! event:after-restart - (lambda () - (set! *doc-string-channel* false))) \ No newline at end of file + (name->variable object))) \ No newline at end of file diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm index 0c26a506d..8f858fba3 100644 --- a/v7/src/edwin/decls.scm +++ b/v7/src/edwin/decls.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: decls.scm,v 1.47 1993/08/09 19:36:39 jawilson Exp $ +$Id: decls.scm,v 1.48 1993/09/03 04:41:21 cph Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -135,6 +135,7 @@ MIT in each case. |# "debuge" "dired" "dirunx" + "docstr" "dos" "doscom" "dosproc" diff --git a/v7/src/edwin/ed-ffi.scm b/v7/src/edwin/ed-ffi.scm index b721aab5f..90b4651f2 100644 --- a/v7/src/edwin/ed-ffi.scm +++ b/v7/src/edwin/ed-ffi.scm @@ -1,7 +1,45 @@ -;;; -*- Scheme -*- +#| -*-Scheme-*- -(declare (usual-integrations)) +$Id: ed-ffi.scm,v 1.32 1993/09/03 04:41:44 cph Exp $ + +Copyright (c) 1990-93 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. + +NOTE: Parts of this program (Edwin) were created by translation +from corresponding parts of GNU Emacs. Users should be aware that +the GNU GENERAL PUBLIC LICENSE may apply to these parts. A copy +of that license should have been included along with this file. +|# + +(declare (usual-integrations)) + ;; This list must be kept in alphabetical order by filename. (standard-scheme-find-file-initialization @@ -69,6 +107,8 @@ edwin-syntax-table) ("display" (edwin display-type) syntax-table/system-internal) + ("docstr" (edwin) + edwin-syntax-table) ("ed-ffi" (edwin) edwin-syntax-table) ("editor" (edwin) diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr index 699e3e1f6..3bd66fc99 100644 --- a/v7/src/edwin/edwin.ldr +++ b/v7/src/edwin/edwin.ldr @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.ldr,v 1.43 1993/09/01 18:12:01 gjr Exp $ +$Id: edwin.ldr,v 1.44 1993/09/03 04:41:36 cph Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -105,6 +105,7 @@ MIT in each case. |# (load "search" environment) (load "image" environment) (load "comman" environment) + (load "docstr" environment) (if (not (memq (lookup 'os-type) '(dos nt))) (set! (access *external-doc-strings?* environment) false)) (load "comtab" (->environment '(EDWIN COMTAB))) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index c066db2ff..5356e58d4 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.128 1993/09/01 18:12:59 gjr Exp $ +$Id: edwin.pkg,v 1.129 1993/09/03 04:41:30 cph Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -54,6 +54,7 @@ MIT in each case. |# "search" "image" "comman" + "docstr" "modes" "buffer" "bufset" -- 2.25.1