From c1d187038d939447a439f31176901c66f0890126 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 9 Jan 1993 09:44:40 +0000 Subject: [PATCH] Fix several instances of SET-INTERRUPT-ENABLES! that appear in value position but are intended to be for effect. --- v7/src/edwin/bufwin.scm | 59 ++++++++++++++++++++++++----------------- v7/src/edwin/bufwiu.scm | 30 ++++++++++++--------- v7/src/edwin/intmod.scm | 13 +++++---- 3 files changed, 60 insertions(+), 42 deletions(-) diff --git a/v7/src/edwin/bufwin.scm b/v7/src/edwin/bufwin.scm index ce4b167a6..23734dd1c 100644 --- a/v7/src/edwin/bufwin.scm +++ b/v7/src/edwin/bufwin.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: bufwin.scm,v 1.297 1993/01/09 01:15:54 cph Exp $ +;;; $Id: bufwin.scm,v 1.298 1993/01/09 09:43:59 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology ;;; @@ -638,7 +638,8 @@ (%set-window-point-moved?! window 'SINCE-START-SET) (%reset-window-structures! window) (buffer-window/redraw! window) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) (define-method buffer-window (:set-size! window x y) (if (%window-debug-trace window) @@ -740,7 +741,8 @@ (%set-window-force-redraw?! window true) (%clear-window-incremental-redisplay-state! window) (window-needs-redisplay! window) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) ;;;; Window State @@ -860,7 +862,8 @@ (%set-window-point-moved?! window 'SINCE-START-SET) (%set-buffer-point! (%window-buffer window) mark) (window-needs-redisplay! window) - (set-interrupt-enables! mask)))) + (set-interrupt-enables! mask) + unspecific))) ;;;; Start Mark @@ -891,23 +894,6 @@ 0 (fix:- (window-y-size window) 1)))))) -(define (set-new-coordinates! window index y point-y) - (with-values (lambda () (predict-start-line window index y)) - (lambda (start y-start) - (cond ((predict-index-visible? window start y-start - (%window-point-index window)) - (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) - (set-start-mark! window start y-start) - (set-interrupt-enables! mask))) - (point-y - (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) - (%set-window-point-index! - window - (or (predict-index window start y-start 0 point-y) - (%window-group-end-index window))) - (set-start-mark! window start y-start) - (set-interrupt-enables! mask))))))) - (define (buffer-window/scroll-y-absolute! window y-point) (if (%window-debug-trace window) ((%window-debug-trace window) 'window window 'scroll-y-absolute! @@ -921,7 +907,8 @@ (lambda (start y-start) (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) (set-start-mark! window start y-start) - (set-interrupt-enables! mask))))) + (set-interrupt-enables! mask) + unspecific)))) (define (buffer-window/y-center window) (let ((y-size (window-y-size window))) @@ -940,6 +927,25 @@ This number is a percentage, where 0 is the window's top and 100 the bottom." (and (real? cursor-centering-point) (<= 0 cursor-centering-point 100)))) +(define (set-new-coordinates! window index y point-y) + (with-values (lambda () (predict-start-line window index y)) + (lambda (start y-start) + (cond ((predict-index-visible? window start y-start + (%window-point-index window)) + (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) + (set-start-mark! window start y-start) + (set-interrupt-enables! mask) + unspecific)) + (point-y + (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) + (%set-window-point-index! + window + (or (predict-index window start y-start 0 point-y) + (%window-group-end-index window))) + (set-start-mark! window start y-start) + (set-interrupt-enables! mask) + unspecific)))))) + (define (set-start-mark! window start-line y-start) (if (fix:= y-start 0) (if (%window-start-line-mark window) @@ -989,7 +995,8 @@ This number is a percentage, where 0 is the window's top and 100 the bottom." (define (guarantee-start-mark! window) (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) (%guarantee-start-mark! window) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) (define (%guarantee-start-mark! window) (let ((index-at! @@ -1071,7 +1078,8 @@ If this is zero, point is always centered after it moves off screen." (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) (%set-window-override-string! window message) (window-needs-redisplay! window) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) (define (buffer-window/clear-override-message! window) (if (%window-override-string window) @@ -1082,7 +1090,8 @@ If this is zero, point is always centered after it moves off screen." (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok))) (%set-window-override-string! window false) (buffer-window/redraw! window) - (set-interrupt-enables! mask))))) + (set-interrupt-enables! mask) + unspecific)))) (define (update-override-string! window screen x-start y-start xl xu yl yu) ;; This should probably update like any other string, paying diff --git a/v7/src/edwin/bufwiu.scm b/v7/src/edwin/bufwiu.scm index 8758fec90..7c6e42c36 100644 --- a/v7/src/edwin/bufwiu.scm +++ b/v7/src/edwin/bufwiu.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: bufwiu.scm,v 1.20 1993/01/09 01:15:56 cph Exp $ +;;; $Id: bufwiu.scm,v 1.21 1993/01/09 09:44:07 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology ;;; @@ -186,11 +186,6 @@ (preserve-all! window start end))))) (%clear-window-outstanding-changes! window)) -(define-integrable (preserve-nothing! window) - (regenerate-outlines window - (%window-start-line-index window) - (%window-start-line-y window))) - (define (preserve-top! window start start-changes) (let ((start-outline (%window-start-outline window)) (start-y (%window-current-start-y window))) @@ -331,6 +326,11 @@ (if (not y) (regenerate-outlines window wlstart wlsy) (scroll-up y)))))))) + +(define-integrable (preserve-nothing! window) + (regenerate-outlines window + (%window-start-line-index window) + (%window-start-line-y window))) (define (first-unchanged-outline end-outline end end-changes) (let loop ((outline end-outline) (end end)) @@ -417,7 +417,8 @@ (fix:+ (%window-saved-x-start window) x-start) (fix:+ (%window-saved-y-start window) y-start)) (%set-inferior-x-start! (%window-cursor-inferior window) x-start)) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) (define (buffer-window/direct-output-backward-char! window) (if (%window-debug-trace window) @@ -433,7 +434,8 @@ (fix:+ (%window-saved-x-start window) x-start) (fix:+ (%window-saved-y-start window) y-start)) (%set-inferior-x-start! (%window-cursor-inferior window) x-start)) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) (define (buffer-window/home-cursor! window) (if (%window-debug-trace window) @@ -447,7 +449,8 @@ (screen-direct-output-move-cursor (%window-saved-screen window) (%window-saved-x-start window) (%window-saved-y-start window)) - (set-interrupt-enables! mask)))) + (set-interrupt-enables! mask) + unspecific))) (define (buffer-window/direct-output-insert-char! window char) (if (%window-debug-trace window) @@ -471,7 +474,8 @@ (%set-inferior-x-start! (%window-cursor-inferior window) (fix:+ x-start 1))) (update-modified-tick! window) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) (define (buffer-window/direct-output-insert-substring! window string start end) (if (%window-debug-trace window) @@ -498,7 +502,8 @@ (%set-inferior-x-start! (%window-cursor-inferior window) (fix:+ x-start length))) (update-modified-tick! window) - (set-interrupt-enables! mask))) + (set-interrupt-enables! mask) + unspecific)) (define (direct-output-outline window y) (let loop @@ -530,4 +535,5 @@ (%set-inferior-x-start! (%window-cursor-inferior window) 0) (%set-inferior-y-start! (%window-cursor-inferior window) end-y)) (update-modified-tick! window) - (set-interrupt-enables! mask))) \ No newline at end of file + (set-interrupt-enables! mask) + unspecific)) \ No newline at end of file diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm index c170e7da8..017e29ab5 100644 --- a/v7/src/edwin/intmod.scm +++ b/v7/src/edwin/intmod.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: intmod.scm,v 1.53 1992/11/17 17:39:01 cph Exp $ +;;; $Id: intmod.scm,v 1.54 1993/01/09 09:44:40 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology +;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -539,7 +539,8 @@ If this is an error, the debugger examines the error condition." (define (enqueue! queue object) (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))) (enqueue!/unsafe queue object) - (set-interrupt-enables! interrupt-mask))) + (set-interrupt-enables! interrupt-mask) + unspecific)) (define (dequeue! queue empty) (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))) @@ -642,7 +643,8 @@ If this is an error, the debugger examines the error condition." (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))) (set-port/output-strings! port (cons string (port/output-strings port))) (inferior-thread-output!/unsafe (port/output-registration port)) - (set-interrupt-enables! interrupt-mask))) + (set-interrupt-enables! interrupt-mask) + unspecific)) (define (enqueue-output-operation! port operator) (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))) @@ -658,7 +660,8 @@ If this is an error, the debugger examines the error condition." (region-insert-string! mark string))))))) (enqueue!/unsafe (port/output-queue port) operator) (inferior-thread-output!/unsafe (port/output-registration port)) - (set-interrupt-enables! interrupt-mask))) + (set-interrupt-enables! interrupt-mask) + unspecific)) (define (process-output-queue port) (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)) -- 2.25.1