Changeset 221

Timestamp:

08/18/11 05:20:58 (21 months ago)

Author:

rjs

Message:

Update.

Location:

trunk/lisp/lmwin

Files:

• menu.lisp (modified) (1 diff)
• mouse.lisp (modified) (2 diffs)
• proces.lisp (modified) (1 diff)
• shwarm.lisp (modified) (1 diff)
• stream.lisp (modified) (1 diff)
• supdup.lisp (modified) (2 diffs)

trunk/lisp/lmwin/menu.lisp

@@ -949 +949 @@
 ;;; no windows will be re-exposed before the cadr is called.
 (DEFFLAVOR MOMENTARY-MENU ((LABEL NIL)) (BASIC-MOMENTARY-MENU TEMPORARY-WINDOW-MIXIN
-                                         TOP-LABEL-MIXIN BORDERS-MIXIN
+                                         BORDERS-MIXIN TOP-BOX-LABEL-MIXIN
                                          MINIMUM-WINDOW)
-  (:DOCUMENTATION :COMBINATION "Temporary menu that goes away after item it chosen"))
+  (:DOCUMENTATION :COMBINATION "Temporary menu that goes away after item is chosen"))
 
 

trunk/lisp/lmwin/mouse.lisp

@@ -553 +553 @@
 (DEFUN MOUSE-BUTTONS-DEFAULT (BD &OPTIONAL (WINDOW SELF))
   (COND ((BIT-TEST 1 BD) (PROCESS-RUN-FUNCTION "Mouse Select" #'MOUSE-SELECT WINDOW))
-        ((BIT-TEST 2 BD) (FUNCALL WINDOW ':DOCUMENT))
+        ;((BIT-TEST 2 BD) (FUNCALL WINDOW ':DOCUMENT))  ;just causes grief
         ((BIT-TEST 4 BD) (MOUSE-CALL-SYSTEM-MENU))))
 
@@ -559 +559 @@
   (OR (FUNCALL WINDOW ':MOUSE-SELECT NIL)
       (BEEP)))
-
-(DEFMETHOD (ESSENTIAL-MOUSE :DOCUMENT) () (BEEP))
 
 (DEFMETHOD (ESSENTIAL-MOUSE :SCROLL-BAR-P) () NIL)

trunk/lisp/lmwin/proces.lisp

@@ -2 +2 @@
 
 ;;; Process system and scheduler
+
+; A process is an instance which embodies one or several stack groups as well as
+; appropriate variables to determine the stack-group's status and runnability.
+; See PRODEF
 
 ;;; ACTIVE-PROCESSES    An alist of all processes that are runnable.

trunk/lisp/lmwin/shwarm.lisp

@@ -336 +336 @@
                 (SHEET-CHARACTER-WIDTH SHEET STRING (SHEET-CURRENT-FONT SHEET))
                 (SHEET-STRING-LENGTH SHEET STRING START END)))
-  (SHEET-DELETE-CHAR LEN ':PIXEL))
+  (SHEET-DELETE-CHAR SHEET LEN ':PIXEL))
 
 (DEFUN SHEET-TYO (SHEET CHAR)

trunk/lisp/lmwin/stream.lisp

@@ -122 +122 @@
                                            &OPTIONAL (ALU CHAR-ALUF))
   (PREPARE-SHEET (SELF)
-    (%DRAW-RECTANGLE-CLIPPED RECTANGLE-WIDTH RECTANGLE-HEIGHT
-                             (+ (SHEET-INSIDE-LEFT) X)
-                             (+ (SHEET-INSIDE-TOP) Y)
-                             ALU SELF)))
+    (DRAW-RECTANGLE-INSIDE-CLIPPED RECTANGLE-WIDTH RECTANGLE-HEIGHT X Y ALU SELF)))
 
 (DEFMETHOD (STREAM-MIXIN :BITBLT) (ALU WID HEI FROM-ARRAY FROM-X FROM-Y TO-X TO-Y)

trunk/lisp/lmwin/supdup.lisp

@@ -668 +668 @@
 (DEFVAR GT40-BLINKER NIL)
 (DEFVAR GT40-CURRENT-ITEM-NUMBER)
+(DEFVAR SUDS-KBD-NEW-TABLE                      ;allows thumb keys to be used
+  (LET ((TBL (SI:KBD-MAKE-NEW-TABLE)))
+    (DOLIST (L '((176 #// #/ #// #/) (106 #/\ #/| #/\ #/|)
+                 (117 #/[ #/{ #/[ #/{) (17 #/] #/} #/] #/})))
+      (LET ((NCH (FIRST L)) (LCH (REST1 L)))
+        (DOTIMES (I 5)
+          (ASET (CAR LCH) TBL I NCH)
+          (IF (REST1 LCH) (SETQ LCH (REST1 LCH))))))
+    TBL))
 
 ;; %TDMTN is a crock for simulating GT-40's, used by DECUUO on ITS for Imlacs...
 
 (DEFUN SUPDUP-GT40 (SHEET &AUX (BYTE (- (NVT-NETI) 100)))
+  (IF ( (AREF SUDS-KBD-NEW-TABLE 0 176)        ;crock for thumb keys, only when
+         (AREF SI:KBD-NEW-TABLE 0 176))         ;doing GT40 simulation
+      (SETQ SI:KBD-NEW-TABLE SUDS-KBD-NEW-TABLE))
   (OR (< BYTE 0)
       (FUNCALL (AREF GT40-DISPATCH (LOGAND 17 BYTE)) SHEET)))
@@ -1046 +1058 @@
 
 (DEFMETHOD (BASIC-TELNET :BUFFERED-TYO) (CH)
-  (COND ((= CH NVT-IAC)
-         (FUNCALL-SELF ':HANDLE-IAC))                   ;Perform new telnet negotiations.
-        ((
- CH 200))                                       ;Ignore otelnet negotiations
-        ((= CH 7) (TV:BEEP))                            ;^G rings the bell.
-        ((= CH 12))                                     ;Ignore linefeeds
-        ((AND (= CH 177) SIMULATE-IMLAC-FLAG)           ;Escape character
-         (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE))
-        (T
-         (AND (
+  (MULTIPLE-VALUE-BIND (IGNORE Y) (FUNCALL-SELF ':READ-CURSORPOS)
+    (COND ((= CH NVT-IAC)
+           (FUNCALL-SELF ':HANDLE-IAC))         ;Perform new telnet negotiations.
+          ((
+ CH 200))                               ;Ignore otelnet negotiations
+          ((= CH 7) (TV:BEEP))                  ;^G rings the bell.
+          ((= CH 15)
+           (FUNCALL-SELF ':FORCE-OUTPUT)
+           (FUNCALL-SELF ':SET-CURSORPOS 0 Y))
+          ((= CH 12)
+           (FUNCALL-SELF ':FORCE-OUTPUT)
+           (FUNCALL-SELF ':INCREMENT-CURSORPOS 0 1 ':CHARACTER)
+           (FUNCALL-SELF ':CLEAR-EOL))
+          ((AND (= CH 177) SIMULATE-IMLAC-FLAG) ;Escape character
+           (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE))
+          (T
+           (AND (
  CH 10) (
  CH 15) ( CH 13)       ;Convert formatting controls
-              (SETQ CH (+ CH 200)))             ;to Lisp machine char set.
-         (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH))
-           (FUNCALL SELF ':FORCE-OUTPUT)))))
+                (SETQ CH (+ CH 200)))           ;to Lisp machine char set.
+           (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH))
+             (FUNCALL-SELF ':FORCE-OUTPUT))))))
 
 ;;;New telnet protocol IAC handler