From 89b6bf6df4908dff8b117ff541c295ca7f4a2a91 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 1 Apr 2018 16:52:10 -0700 Subject: [PATCH] Downcase more symbols and constants. --- src/edwin/buffer.scm | 48 ++++++++++---------- src/edwin/calias.scm | 18 ++++---- src/edwin/clsmac.scm | 10 ++--- src/edwin/search.scm | 100 ++++++++++++++++++++--------------------- src/edwin/tterm.scm | 52 ++++++++++----------- src/edwin/utils.scm | 30 ++++++------- src/edwin/xcom.scm | 8 ++-- src/imail/compile.scm | 10 ++--- src/imail/fake-env.scm | 12 ++--- src/imail/load.scm | 6 +-- 10 files changed, 147 insertions(+), 147 deletions(-) diff --git a/src/edwin/buffer.scm b/src/edwin/buffer.scm index 14ac16a06..4220640d3 100644 --- a/src/edwin/buffer.scm +++ b/src/edwin/buffer.scm @@ -53,8 +53,8 @@ USA. (sc-macro-transformer (lambda (form environment) (let ((slot-name (cadr form))) - `(DEFINE-INTEGRABLE ,(symbol 'BUFFER- slot-name) - ,(close-syntax (symbol 'BUFFER-% slot-name) + `(define-integrable ,(symbol 'buffer- slot-name) + ,(close-syntax (symbol 'buffer-% slot-name) environment)))))) (rename-buffer-accessor name) @@ -134,11 +134,11 @@ The buffer is guaranteed to be deselected at that time." buffer (variable-default-value (ref-variable-object editor-default-mode))) (event-distributor/invoke! event:set-buffer-pathname buffer) - (buffer-modeline-event! buffer 'BUFFER-RESET)))) + (buffer-modeline-event! buffer 'buffer-reset)))) (define (set-buffer-name! buffer name) (set-buffer-%name! buffer name) - (buffer-modeline-event! buffer 'BUFFER-NAME)) + (buffer-modeline-event! buffer 'buffer-name)) (define (set-buffer-default-directory! buffer directory) (set-buffer-%default-directory! buffer (pathname-simplify directory))) @@ -148,14 +148,14 @@ The buffer is guaranteed to be deselected at that time." (if pathname (set-buffer-default-directory! buffer (directory-pathname pathname))) (event-distributor/invoke! event:set-buffer-pathname buffer) - (buffer-modeline-event! buffer 'BUFFER-PATHNAME)) + (buffer-modeline-event! buffer 'buffer-pathname)) (define event:set-buffer-pathname (make-event-distributor)) (define (set-buffer-truename! buffer truename) (set-buffer-%truename! buffer truename) - (buffer-modeline-event! buffer 'BUFFER-TRUENAME)) + (buffer-modeline-event! buffer 'buffer-truename)) (define-integrable (set-buffer-save-length! buffer) (set-buffer-%save-length! buffer (buffer-length buffer))) @@ -178,7 +178,7 @@ The buffer is guaranteed to be deselected at that time." (set-group-point-index! (buffer-group buffer) index)) (define-integrable (minibuffer? buffer) - (char=? (string-ref (buffer-name buffer) 0) #\Space)) + (char=? (string-ref (buffer-name buffer) 0) #\space)) (define-integrable (buffer-region buffer) (group-region (buffer-group buffer))) @@ -251,8 +251,8 @@ The buffer is guaranteed to be deselected at that time." ((group? object) (group-buffer object)) ((region? object) (mark-buffer (region-start object))) ((window? object) (window-buffer object)) - (else (error:wrong-type-argument object "buffer" '->BUFFER))) - (error:bad-range-argument object '->BUFFER))) + (else (error:wrong-type-argument object "buffer" '->buffer))) + (error:bad-range-argument object '->buffer))) ;;;; Modification Flags @@ -266,7 +266,7 @@ The buffer is guaranteed to be deselected at that time." (if (group-modified? group) (begin (set-group-modified?! group #f) - (buffer-modeline-event! buffer 'BUFFER-MODIFIED) + (buffer-modeline-event! buffer 'buffer-modified) (set-buffer-auto-saved?! buffer #f))))))) (define (buffer-modified! buffer) @@ -276,7 +276,7 @@ The buffer is guaranteed to be deselected at that time." (if (not (group-modified? group)) (begin (set-group-modified?! group #t) - (buffer-modeline-event! buffer 'BUFFER-MODIFIED))))))) + (buffer-modeline-event! buffer 'buffer-modified))))))) (define (verify-visited-file-modification-time? buffer) (let ((truename (buffer-truename buffer)) @@ -291,7 +291,7 @@ The buffer is guaranteed to be deselected at that time." (define (set-buffer-auto-saved! buffer) (set-buffer-auto-saved?! buffer #t) - (set-group-modified?! (buffer-group buffer) 'AUTO-SAVED)) + (set-group-modified?! (buffer-group buffer) 'auto-saved)) (define-integrable (buffer-auto-save-modified? buffer) (eq? #t (group-modified? (buffer-group buffer)))) @@ -299,7 +299,7 @@ The buffer is guaranteed to be deselected at that time." (define (buffer-clip-daemon buffer) (lambda (group start end) group start end ;ignore - (buffer-modeline-event! buffer 'CLIPPING-CHANGED))) + (buffer-modeline-event! buffer 'clipping-changed))) (define-integrable (buffer-read-only? buffer) (group-read-only? (buffer-group buffer))) @@ -309,16 +309,16 @@ The buffer is guaranteed to be deselected at that time." (define (set-buffer-writeable! buffer) (set-group-writeable! (buffer-group buffer)) - (buffer-modeline-event! buffer 'BUFFER-MODIFIABLE)) + (buffer-modeline-event! buffer 'buffer-modifiable)) (define (set-buffer-read-only! buffer) (set-group-read-only! (buffer-group buffer)) - (buffer-modeline-event! buffer 'BUFFER-MODIFIABLE)) + (buffer-modeline-event! buffer 'buffer-modifiable)) (define (with-read-only-defeated object thunk) (let ((group (buffer-group (->buffer object))) (outside) - (inside 'FULLY)) + (inside 'fully)) (dynamic-wind (lambda () (set! outside (group-writeable? group)) (set-group-writeable?! group inside)) @@ -499,15 +499,15 @@ The buffer is guaranteed to be deselected at that time." (define (set-buffer-major-mode! buffer mode) (if (not (and (mode? mode) (mode-major? mode))) - (error:wrong-type-argument mode "major mode" 'SET-BUFFER-MAJOR-MODE!)) - (if (buffer-get buffer 'MAJOR-MODE-LOCKED) + (error:wrong-type-argument mode "major mode" 'set-buffer-major-mode!)) + (if (buffer-get buffer 'major-mode-locked) (editor-error "The major mode of this buffer is locked: " buffer)) ;; The very first buffer is created before the editor (without-editor-interrupts (lambda () (undo-local-bindings! buffer #f) (%set-buffer-major-mode! buffer mode) - (buffer-modeline-event! buffer 'BUFFER-MODES)))) + (buffer-modeline-event! buffer 'buffer-modes)))) (define (%set-buffer-major-mode! buffer mode) (set-buffer-modes! buffer (list mode)) @@ -526,12 +526,12 @@ The buffer is guaranteed to be deselected at that time." (define (buffer-minor-mode? buffer mode) (if (not (and (mode? mode) (not (mode-major? mode)))) - (error:wrong-type-argument mode "minor mode" 'BUFFER-MINOR-MODE?)) + (error:wrong-type-argument mode "minor mode" 'buffer-minor-mode?)) (memq mode (cdr (buffer-modes buffer)))) (define (enable-buffer-minor-mode! buffer mode) (if (not (minor-mode? mode)) - (error:wrong-type-argument mode "minor mode" 'ENABLE-BUFFER-MINOR-MODE!)) + (error:wrong-type-argument mode "minor mode" 'enable-buffer-minor-mode!)) (without-editor-interrupts (lambda () (let ((modes (buffer-modes buffer))) @@ -543,12 +543,12 @@ The buffer is guaranteed to be deselected at that time." (buffer-comtabs buffer))) (add-minor-mode-line-entry! buffer mode) ((mode-initialization mode) buffer) - (buffer-modeline-event! buffer 'BUFFER-MODES))))))) + (buffer-modeline-event! buffer 'buffer-modes))))))) (define (disable-buffer-minor-mode! buffer mode) (if (not (minor-mode? mode)) (error:wrong-type-argument mode "minor mode" - 'DISABLE-BUFFER-MINOR-MODE!)) + 'disable-buffer-minor-mode!)) (without-editor-interrupts (lambda () (let ((modes (buffer-modes buffer))) @@ -559,4 +559,4 @@ The buffer is guaranteed to be deselected at that time." (delq! (minor-mode-comtab mode) (buffer-comtabs buffer))) (remove-minor-mode-line-entry! buffer mode) - (buffer-modeline-event! buffer 'BUFFER-MODES))))))) \ No newline at end of file + (buffer-modeline-event! buffer 'buffer-modes))))))) \ No newline at end of file diff --git a/src/edwin/calias.scm b/src/edwin/calias.scm index 922750fa8..a19eac61e 100644 --- a/src/edwin/calias.scm +++ b/src/edwin/calias.scm @@ -90,7 +90,7 @@ USA. ((char? key) (char->name (unmap-alias-key key))) ((special-key? key) (special-key/name key)) ((button? key) (button-name key)) - (else (error:wrong-type-argument key "key" 'KEY-NAME)))) + (else (error:wrong-type-argument key "key" 'key-name)))) (define (xkey->name xkey) (let ((keys (xkey->list xkey))) @@ -149,7 +149,7 @@ USA. (char->name (unmap-alias-key key)))))) ((special-key? key) (special-key/name key)) ((button? key) (button-name key)) - (else (error:wrong-type-argument key "key" 'EMACS-KEY-NAME)))) + (else (error:wrong-type-argument key "key" 'emacs-key-name)))) (define (key? object) (or (char? object) @@ -160,7 +160,7 @@ USA. (cond ((char? key) (char-bits key)) ((special-key? key) (special-key/bucky-bits key)) ((button? key) (button-bits key)) - (else (error:wrong-type-argument key "key" 'KEY-BUCKY-BITS)))) + (else (error:wrong-type-argument key "key" 'key-bucky-bits)))) (define (keylist x)) (y (xkey->list y))) @@ -217,7 +217,7 @@ USA. (define-structure (special-key (constructor %make-special-key) (conc-name special-key/) (print-procedure - (standard-unparser-method 'SPECIAL-KEY + (standard-unparser-method 'special-key (lambda (key port) (write-char #\space port) (write-string (special-key/name key) @@ -249,7 +249,7 @@ USA. (define (make-special-key name bits) (hook/make-special-key name bits)) -(define hashed-keys (list 'HASHED-KEYS)) +(define hashed-keys (list 'hashed-keys)) (define hook/make-special-key intern-special-key) ;; Predefined special keys @@ -257,8 +257,8 @@ USA. (sc-macro-transformer (lambda (form environment) environment - `(DEFINE ,(cadr form) - (INTERN-SPECIAL-KEY ',(cadr form) 0))))) + `(define ,(cadr form) + (intern-special-key ',(cadr form) 0))))) (define-special-key backspace) (define-special-key stop) diff --git a/src/edwin/clsmac.scm b/src/edwin/clsmac.scm index a3ecd2c72..79731357d 100644 --- a/src/edwin/clsmac.scm +++ b/src/edwin/clsmac.scm @@ -49,9 +49,9 @@ USA. (name->class (identifier->symbol superclass))) variables) ;; Load-time definition. - `(,(close-syntax 'DEFINE environment) + `(,(close-syntax 'define environment) ,name - (,(close-syntax 'MAKE-CLASS environment) + (,(close-syntax 'make-class environment) ',(identifier->symbol name) ,superclass ',variables))) @@ -62,7 +62,7 @@ USA. (lambda (form environment) (let ((finish (lambda (name operation expression) - `(,(close-syntax 'CLASS-METHOD-DEFINE environment) + `(,(close-syntax 'class-method-define environment) ,name ',operation ,expression)))) @@ -74,9 +74,9 @@ USA. (identifier? (cadr (caddr form)))) (finish (cadr form) (car (caddr form)) - `(,(close-syntax 'NAMED-LAMBDA environment) + `(,(close-syntax 'named-lambda environment) ,(caddr form) - (,(close-syntax 'WITH-INSTANCE-VARIABLES environment) + (,(close-syntax 'with-instance-variables environment) ,(cadr form) ,(cadr (caddr form)) () diff --git a/src/edwin/search.scm b/src/edwin/search.scm index a44c8b285..e140f8f2d 100644 --- a/src/edwin/search.scm +++ b/src/edwin/search.scm @@ -33,34 +33,34 @@ USA. (lambda (form environment) (let ((name (cadr form)) (find-next (close-syntax (caddr form) environment))) - `(DEFINE (,name GROUP START END CHAR) + `(define (,name group start end char) ;; Assume (FIX:<= START END) - (AND (NOT (FIX:= START END)) - (COND ((FIX:<= END (GROUP-GAP-START GROUP)) - (,find-next (GROUP-TEXT GROUP) START END CHAR)) - ((FIX:<= (GROUP-GAP-START GROUP) START) - (LET ((POSITION + (and (not (fix:= start end)) + (cond ((fix:<= end (group-gap-start group)) + (,find-next (group-text group) start end char)) + ((fix:<= (group-gap-start group) start) + (let ((position (,find-next - (GROUP-TEXT GROUP) - (FIX:+ START (GROUP-GAP-LENGTH GROUP)) - (FIX:+ END (GROUP-GAP-LENGTH GROUP)) - CHAR))) - (AND POSITION - (FIX:- POSITION (GROUP-GAP-LENGTH GROUP))))) - ((,find-next (GROUP-TEXT GROUP) - START - (GROUP-GAP-START GROUP) - CHAR)) - (ELSE - (LET ((POSITION - (,find-next (GROUP-TEXT GROUP) - (GROUP-GAP-END GROUP) - (FIX:+ END - (GROUP-GAP-LENGTH GROUP)) - CHAR))) - (AND POSITION - (FIX:- POSITION - (GROUP-GAP-LENGTH GROUP)))))))))))) + (group-text group) + (fix:+ start (group-gap-length group)) + (fix:+ end (group-gap-length group)) + char))) + (and position + (fix:- position (group-gap-length group))))) + ((,find-next (group-text group) + start + (group-gap-start group) + char)) + (else + (let ((position + (,find-next (group-text group) + (group-gap-end group) + (fix:+ end + (group-gap-length group)) + char))) + (and position + (fix:- position + (group-gap-length group)))))))))))) (define-next-char-search group-find-next-char substring-find-next-char) @@ -74,31 +74,31 @@ USA. (lambda (form environment) (let ((name (cadr form)) (find-previous (close-syntax (caddr form) environment))) - `(DEFINE (,name GROUP START END CHAR) + `(define (,name group start end char) ;; Assume (FIX:<= START END) - (AND (NOT (FIX:= START END)) - (COND ((FIX:<= END (GROUP-GAP-START GROUP)) - (,find-previous (GROUP-TEXT GROUP) START END CHAR)) - ((FIX:<= (GROUP-GAP-START GROUP) START) - (LET ((POSITION + (and (not (fix:= start end)) + (cond ((fix:<= end (group-gap-start group)) + (,find-previous (group-text group) start end char)) + ((fix:<= (group-gap-start group) start) + (let ((position (,find-previous - (GROUP-TEXT GROUP) - (FIX:+ START (GROUP-GAP-LENGTH GROUP)) - (FIX:+ END (GROUP-GAP-LENGTH GROUP)) - CHAR))) - (AND POSITION - (FIX:- POSITION (GROUP-GAP-LENGTH GROUP))))) - ((,find-previous (GROUP-TEXT GROUP) - (GROUP-GAP-END GROUP) - (FIX:+ END (GROUP-GAP-LENGTH GROUP)) - CHAR) - => (LAMBDA (POSITION) - (FIX:- POSITION (GROUP-GAP-LENGTH GROUP)))) + (group-text group) + (fix:+ start (group-gap-length group)) + (fix:+ end (group-gap-length group)) + char))) + (and position + (fix:- position (group-gap-length group))))) + ((,find-previous (group-text group) + (group-gap-end group) + (fix:+ end (group-gap-length group)) + char) + => (lambda (position) + (fix:- position (group-gap-length group)))) (else - (,find-previous (GROUP-TEXT GROUP) - START - (GROUP-GAP-START GROUP) - CHAR))))))))) + (,find-previous (group-text group) + start + (group-gap-start group) + char))))))))) (define-prev-char-search group-find-previous-char substring-find-previous-char) @@ -313,7 +313,7 @@ USA. (define (skip-chars-forward pattern #!optional start end limit?) (let ((start (if (default-object? start) (current-point) start)) - (limit? (if (default-object? limit?) 'LIMIT limit?))) + (limit? (if (default-object? limit?) 'limit limit?))) (let ((end (default-end-mark start end))) (let ((index (group-find-next-char-in-set (mark-group start) @@ -326,7 +326,7 @@ USA. (define (skip-chars-backward pattern #!optional end start limit?) (let ((end (if (default-object? end) (current-point) end)) - (limit? (if (default-object? limit?) 'LIMIT limit?))) + (limit? (if (default-object? limit?) 'limit limit?))) (let ((start (default-start-mark start end))) (let ((index (group-find-previous-char-in-set (mark-group start) diff --git a/src/edwin/tterm.scm b/src/edwin/tterm.scm index 5d7cee0f9..dcc01c3bf 100644 --- a/src/edwin/tterm.scm +++ b/src/edwin/tterm.scm @@ -97,7 +97,7 @@ USA. (terminal-output-baud-rate channel)))) (define (output-port/buffered-bytes port) - (let ((operation (textual-port-operation port 'BUFFERED-OUTPUT-BYTES))) + (let ((operation (textual-port-operation port 'buffered-output-bytes))) (if operation (operation port) 0))) @@ -109,7 +109,7 @@ USA. (no-undesirable-characteristics? description)))) (define (console-termcap-description) - (if (eq? console-description 'UNKNOWN) + (if (eq? console-description 'unknown) (set! console-description (let ((term (get-environment-variable "TERM"))) (and term @@ -191,16 +191,16 @@ USA. (let ((n-chars (fix:- end start))) (let find ((key-pairs (terminal-state/key-table terminal-state)) - (possible-pending? #F)) + (possible-pending? #f)) (if (null? key-pairs) (begin (if (number? incomplete-pending) (if (or (not possible-pending?) (> (real-time-clock) incomplete-pending)) - (set! incomplete-pending #T))) + (set! incomplete-pending #t))) (if (number? incomplete-pending) - #F + #f (vector-8b-ref buffer start))) (let* ((key-seq (caar key-pairs)) (n-seq (string-length key-seq))) @@ -224,14 +224,14 @@ USA. (read-more? ; -> #F or #T if some octets were read (named-lambda (read-more?) (let ((n (%channel-read channel buffer end input-buffer-size))) - (cond ((not n) #F) - ((eq? n #T) #F) + (cond ((not n) #f) + ((eq? n #t) #f) ((fix:> n 0) (set! end (fix:+ end n)) - #T) + #t) ((fix:= n 0) ;;(error "Reached EOF in keyboard input.") - #F))))) + #f))))) (match-event ; -> #F or match (char or pair) or input event (named-lambda (match-event block?) (let loop () @@ -263,7 +263,7 @@ USA. (named-lambda (->update-event redisplay?) (and redisplay? (make-input-event - (if (eq? redisplay? 'FORCE-RETURN) 'RETURN 'UPDATE) + (if (eq? redisplay? 'force-return) 'return 'update) update-screens! #f)))) (consume-match! (named-lambda (consume-match! match) @@ -311,7 +311,7 @@ USA. (set! registrations (cons (register-io-thread-event - (channel-descriptor-for-select channel) 'READ + (channel-descriptor-for-select channel) 'read thread (lambda (mode) mode (set! input-available? #t))) @@ -381,7 +381,7 @@ USA. (define (initialize-package!) (set! console-display-type - (make-display-type 'CONSOLE + (make-display-type 'console false console-available? make-console-screen @@ -391,7 +391,7 @@ USA. with-console-grabbed with-console-interrupts-enabled with-console-interrupts-disabled)) - (set! console-description 'UNKNOWN) + (set! console-description 'unknown) unspecific) (define (with-console-grabbed receiver) @@ -490,22 +490,22 @@ USA. (sc-macro-transformer (lambda (form environment) (let ((name (cadr form))) - `(DEFINE-INTEGRABLE (,(symbol 'SCREEN- name) SCREEN) - (,(close-syntax (symbol 'TERMINAL-STATE/ name) + `(define-integrable (,(symbol 'screen- name) screen) + (,(close-syntax (symbol 'terminal-state/ name) environment) - (SCREEN-STATE SCREEN))))))) + (screen-state screen))))))) (define-syntax define-ts-modifier (sc-macro-transformer (lambda (form environment) (let ((name (cadr form))) (let ((param (make-synthetic-identifier name))) - `(DEFINE-INTEGRABLE - (,(symbol 'SET-SCREEN- name '!) SCREEN ,param) + `(define-integrable + (,(symbol 'set-screen- name '!) screen ,param) (,(close-syntax - (symbol 'SET-TERMINAL-STATE/ name '!) + (symbol 'set-terminal-state/ name '!) environment) - (SCREEN-STATE SCREEN) + (screen-state screen) ,param))))))) (define-ts-accessor description) @@ -533,7 +533,7 @@ USA. (define (console-discard! screen) screen - (set! console-description 'UNKNOWN) + (set! console-description 'unknown) unspecific) (define (console-enter! screen) @@ -661,7 +661,7 @@ USA. (and (fix:< (insert-lines-cost screen yl yu amount) draw-cost) (begin (insert-lines screen yl yu amount) - 'CLEARED)) + 'cleared)) (and (fix:< (fix:+ (delete-lines-cost screen yu* y-size amount) (insert-lines-cost screen yl y-size amount)) @@ -669,7 +669,7 @@ USA. (begin (delete-lines screen yu* y-size amount) (insert-lines screen yl y-size amount) - 'CLEARED)))))))) + 'cleared)))))))) (define (console-scroll-lines-up! screen xl xu yl yu amount) (let ((description (screen-description screen))) @@ -683,7 +683,7 @@ USA. (and (fix:< (delete-lines-cost screen yl yu amount) draw-cost) (begin (delete-lines screen yl yu amount) - 'CLEARED)) + 'cleared)) (let ((yu* (fix:- yu amount))) (and (fix:< (fix:+ (delete-lines-cost screen yl y-size amount) @@ -692,7 +692,7 @@ USA. (begin (delete-lines screen yl y-size amount) (insert-lines screen yu* y-size amount) - 'CLEARED)))))))) + 'cleared)))))))) (define (scroll-draw-cost screen yl yu) (do ((yl yl (fix:+ yl 1)) @@ -1199,7 +1199,7 @@ compute this as INSERT-LINE-COST[line]+INSERT-LINE-NEXT-COST[line], we add INSERT-LINE-NEXT-COST into INSERT-LINE-COST. This is reasonable because of the particular algorithm used. -Deletion is essentially the same as insertion. +Deletion is essentially the same as insertion. Note that the multiply factors are in tenths of characters. |# diff --git a/src/edwin/utils.scm b/src/edwin/utils.scm index 797242051..b66a04ffd 100644 --- a/src/edwin/utils.scm +++ b/src/edwin/utils.scm @@ -40,10 +40,10 @@ USA. (error:allocation-failure n-words operator)))) (define condition-type:allocation-failure - (make-condition-type 'ALLOCATION-FAILURE condition-type:error - '(OPERATOR N-WORDS) + (make-condition-type 'allocation-failure condition-type:error + '(operator n-words) (lambda (condition port) - (let ((operator (access-condition condition 'OPERATOR))) + (let ((operator (access-condition condition 'operator))) (if operator (begin (write-string "The procedure " port) @@ -51,7 +51,7 @@ USA. (write-string " is unable" port)) (write-string "Unable" port))) (write-string " to allocate " port) - (write (access-condition condition 'N-WORDS) port) + (write (access-condition condition 'n-words) port) (write-string " words of storage." port)))) (define error:allocation-failure @@ -63,7 +63,7 @@ USA. ;; Too much of Edwin relies on fixnum-specific arithmetic for this ;; to be safe. Unfortunately, this means that Edwin can't edit ;; files >32MB. - (guarantee index-fixnum? n-chars 'ALLOCATE-BUFFER-STORAGE) + (guarantee index-fixnum? n-chars 'allocate-buffer-storage) (make-string n-chars)) (define-syntax chars-to-words-shift @@ -86,9 +86,9 @@ USA. (define (edwin-string-allocate n-chars) (if (not (fix:fixnum? n-chars)) - (error:wrong-type-argument n-chars "fixnum" 'STRING-ALLOCATE)) + (error:wrong-type-argument n-chars "fixnum" 'string-allocate)) (if (not (fix:>= n-chars 0)) - (error:bad-range-argument n-chars 'STRING-ALLOCATE)) + (error:bad-range-argument n-chars 'string-allocate)) (with-interrupt-mask interrupt-mask/none (lambda (mask) (let ((n-words ;Add two, for manifest & length. @@ -97,7 +97,7 @@ USA. (with-interrupt-mask interrupt-mask/gc-normal (lambda (ignore) ignore ; ignored - (guarantee-heap-available n-words 'STRING-ALLOCATE mask)))) + (guarantee-heap-available n-words 'string-allocate mask)))) (let ((result ((ucode-primitive primitive-get-free 1) (ucode-type string)))) ((ucode-primitive primitive-object-set! 3) @@ -219,15 +219,15 @@ USA. (define (y-or-n? . strings) (define (loop) - (let ((char (char-upcase (read-char)))) - (cond ((or (char=? char #\Y) - (char=? char #\Space)) + (let ((char (read-char))) + (cond ((or (char-ci=? char #\y) + (char=? char #\space)) (write-string "Yes") - true) - ((or (char=? char #\N) - (char=? char #\Rubout)) + #t) + ((or (char-ci=? char #\n) + (char=? char #\rubout)) (write-string "No") - false) + #f) (else (if (not (char=? char #\newline)) (beep)) diff --git a/src/edwin/xcom.scm b/src/edwin/xcom.scm index 7c0d9b265..dd3f73be2 100644 --- a/src/edwin/xcom.scm +++ b/src/edwin/xcom.scm @@ -295,8 +295,8 @@ When called interactively, completion is available on the input." (sc-macro-transformer (lambda (form environment) (let ((name (cadr form))) - `(DEFINE ,(symbol 'EDWIN-COMMAND$X- name) - ,(close-syntax (symbol 'EDWIN-COMMAND$ name) + `(define ,(symbol 'edwin-command$x- name) + ,(close-syntax (symbol 'edwin-command$ name) environment)))))) (define-old-mouse-command set-foreground-color) @@ -327,8 +327,8 @@ When called interactively, completion is available on the input." (sc-macro-transformer (lambda (form environment) (let ((name (cadr form))) - `(DEFINE ,(symbol 'EDWIN-VARIABLE$X-SCREEN- name) - ,(close-syntax (symbol 'EDWIN-VARIABLE$FRAME- name) + `(define ,(symbol 'edwin-variable$x-screen- name) + ,(close-syntax (symbol 'edwin-variable$frame- name) environment)))))) (define-old-screen-command icon-name-format) diff --git a/src/imail/compile.scm b/src/imail/compile.scm index 3a7beaa59..16a609e16 100644 --- a/src/imail/compile.scm +++ b/src/imail/compile.scm @@ -26,13 +26,13 @@ USA. ;;;; IMAIL mail reader: compilation -(load-option 'CREF) -(load-option 'SOS) -(load-option '*PARSER) +(load-option 'cref) +(load-option 'sos) +(load-option '*parser) (with-working-directory-pathname (directory-pathname (current-load-pathname)) (lambda () (for-each (lambda (filename) - (compile-file filename '() (->environment '(EDWIN)))) + (compile-file filename '() (->environment '(edwin)))) '("imail-browser" "imail-core" "imail-file" @@ -45,4 +45,4 @@ USA. "imail-util" "imap-response" "imap-syntax")) - (cref/generate-constructors "imail" 'ALL))) \ No newline at end of file + (cref/generate-constructors "imail" 'all))) \ No newline at end of file diff --git a/src/imail/fake-env.scm b/src/imail/fake-env.scm index f72aa543b..97eae0f4c 100644 --- a/src/imail/fake-env.scm +++ b/src/imail/fake-env.scm @@ -5,9 +5,9 @@ name (extend-top-level-environment (package/environment package))))))) - (new-child '(EDWIN) 'IMAIL) - (new-child '(EDWIN IMAIL) 'IMAP-RESPONSE) - (new-child '(EDWIN IMAIL) 'IMAP-SYNTAX) - (new-child '(EDWIN IMAIL) 'PARSER) - (new-child '(EDWIN IMAIL) 'REXP) - (new-child '(EDWIN IMAIL) 'URL)) \ No newline at end of file + (new-child '(edwin) 'imail) + (new-child '(edwin imail) 'imap-response) + (new-child '(edwin imail) 'imap-syntax) + (new-child '(edwin imail) 'parser) + (new-child '(edwin imail) 'rexp) + (new-child '(edwin imail) 'url)) \ No newline at end of file diff --git a/src/imail/load.scm b/src/imail/load.scm index af6f70e20..6894fb371 100644 --- a/src/imail/load.scm +++ b/src/imail/load.scm @@ -26,9 +26,9 @@ USA. ;;;; IMAIL mail reader: loader -(load-option 'REGULAR-EXPRESSION) -(load-option 'SOS) -(load-option 'WT-TREE) +(load-option 'regular-expression) +(load-option 'sos) +(load-option 'wt-tree) (with-loader-base-uri (system-library-uri "imail/") (lambda () (fluid-let ((*allow-package-redefinition?* #t)) -- 2.25.1