From: Mark Friedman <edu/mit/csail/zurich/markf>
Date: Tue, 19 Nov 1991 19:44:15 +0000 (+0000)
Subject: Added support for modified (i.e. with shift, control or meta) mouse buttons.
X-Git-Tag: 20090517-FFI~10061
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=aa529b47e2c321de0c3d07e980ac63f4f4c9d11e;p=mit-scheme.git

Added support for modified (i.e. with shift, control or meta) mouse buttons.
---

diff --git a/v7/src/edwin/edtstr.scm b/v7/src/edwin/edtstr.scm
index 42ca6e37b..5295b6898 100644
--- a/v7/src/edwin/edtstr.scm
+++ b/v7/src/edwin/edtstr.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtstr.scm,v 1.16 1991/05/10 05:50:04 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtstr.scm,v 1.17 1991/11/19 19:44:15 markf Exp $
 ;;;
 ;;;	Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -159,6 +159,22 @@
 	      (set! up-buttons (vector-grow up-buttons (1+ number))))
 	  (%make-button up-buttons number false))))
 
+(define (make-modified-button modifier button-number up-or-down)
+  (let ((button
+	 (+ button-number
+	    (case modifier
+	      ((shift) 5)
+	      ((control) 10)
+	      ((meta) 20)
+	      (else (error "make-modified-button: Bad button modifier"
+			   modifier))))))
+    (cond ((eq? up-or-down 'DOWN)
+	   (make-down-button button))
+	  ((eq? up-or-down 'UP)
+	   (make-up-button button))
+	  (else (error "make-modified-button: Must specify UP or DOWN"
+		       up-or-down)))))
+
 (define button?
   (record-predicate button-record-type))