Changeset 221

Show
Ignore:
Timestamp:
08/18/11 05:20:58 (3 years ago)
Author:
rjs
Message:

Update.

Location:
trunk/lisp/lmwin
Files:
6 modified

Legend:

Unmodified
Added
Removed
  • trunk/lisp/lmwin/menu.lisp

    r220 r221  
    949949;;; no windows will be re-exposed before the cadr is called. 
    950950(DEFFLAVOR MOMENTARY-MENU ((LABEL NIL)) (BASIC-MOMENTARY-MENU TEMPORARY-WINDOW-MIXIN 
    951                                          TOP-LABEL-MIXIN BORDERS-MIXIN 
     951                                         BORDERS-MIXIN TOP-BOX-LABEL-MIXIN 
    952952                                         MINIMUM-WINDOW) 
    953   (:DOCUMENTATION :COMBINATION "Temporary menu that goes away after item it chosen")) 
     953  (:DOCUMENTATION :COMBINATION "Temporary menu that goes away after item is chosen")) 
    954954 
    955955 
  • trunk/lisp/lmwin/mouse.lisp

    r220 r221  
    553553(DEFUN MOUSE-BUTTONS-DEFAULT (BD &OPTIONAL (WINDOW SELF)) 
    554554  (COND ((BIT-TEST 1 BD) (PROCESS-RUN-FUNCTION "Mouse Select" #'MOUSE-SELECT WINDOW)) 
    555         ((BIT-TEST 2 BD) (FUNCALL WINDOW ':DOCUMENT)) 
     555        ;((BIT-TEST 2 BD) (FUNCALL WINDOW ':DOCUMENT))  ;just causes grief 
    556556        ((BIT-TEST 4 BD) (MOUSE-CALL-SYSTEM-MENU)))) 
    557557 
     
    559559  (OR (FUNCALL WINDOW ':MOUSE-SELECT NIL) 
    560560      (BEEP))) 
    561  
    562 (DEFMETHOD (ESSENTIAL-MOUSE :DOCUMENT) () (BEEP)) 
    563561 
    564562(DEFMETHOD (ESSENTIAL-MOUSE :SCROLL-BAR-P) () NIL) 
  • trunk/lisp/lmwin/proces.lisp

    r220 r221  
    22 
    33;;; Process system and scheduler 
     4 
     5; A process is an instance which embodies one or several stack groups as well as 
     6; appropriate variables to determine the stack-group's status and runnability. 
     7; See PRODEF 
    48 
    59;;; ACTIVE-PROCESSES    An alist of all processes that are runnable. 
  • trunk/lisp/lmwin/shwarm.lisp

    r220 r221  
    336336                (SHEET-CHARACTER-WIDTH SHEET STRING (SHEET-CURRENT-FONT SHEET)) 
    337337                (SHEET-STRING-LENGTH SHEET STRING START END))) 
    338   (SHEET-DELETE-CHAR LEN ':PIXEL)) 
     338  (SHEET-DELETE-CHAR SHEET LEN ':PIXEL)) 
    339339 
    340340(DEFUN SHEET-TYO (SHEET CHAR) 
  • trunk/lisp/lmwin/stream.lisp

    r220 r221  
    122122                                           &OPTIONAL (ALU CHAR-ALUF)) 
    123123  (PREPARE-SHEET (SELF) 
    124     (%DRAW-RECTANGLE-CLIPPED RECTANGLE-WIDTH RECTANGLE-HEIGHT 
    125                              (+ (SHEET-INSIDE-LEFT) X) 
    126                              (+ (SHEET-INSIDE-TOP) Y) 
    127                              ALU SELF))) 
     124    (DRAW-RECTANGLE-INSIDE-CLIPPED RECTANGLE-WIDTH RECTANGLE-HEIGHT X Y ALU SELF))) 
    128125 
    129126(DEFMETHOD (STREAM-MIXIN :BITBLT) (ALU WID HEI FROM-ARRAY FROM-X FROM-Y TO-X TO-Y) 
  • trunk/lisp/lmwin/supdup.lisp

    r220 r221  
    668668(DEFVAR GT40-BLINKER NIL) 
    669669(DEFVAR GT40-CURRENT-ITEM-NUMBER) 
     670(DEFVAR SUDS-KBD-NEW-TABLE                      ;allows thumb keys to be used 
     671  (LET ((TBL (SI:KBD-MAKE-NEW-TABLE))) 
     672    (DOLIST (L '((176 #// #/ #// #/) (106 #/\ #/| #/\ #/|) 
     673                 (117 #/[ #/{ #/[ #/{) (17 #/] #/} #/] #/}))) 
     674      (LET ((NCH (FIRST L)) (LCH (REST1 L))) 
     675        (DOTIMES (I 5) 
     676          (ASET (CAR LCH) TBL I NCH) 
     677          (IF (REST1 LCH) (SETQ LCH (REST1 LCH)))))) 
     678    TBL)) 
    670679 
    671680;; %TDMTN is a crock for simulating GT-40's, used by DECUUO on ITS for Imlacs... 
    672681 
    673682(DEFUN SUPDUP-GT40 (SHEET &AUX (BYTE (- (NVT-NETI) 100))) 
     683  (IF ( (AREF SUDS-KBD-NEW-TABLE 0 176)        ;crock for thumb keys, only when 
     684         (AREF SI:KBD-NEW-TABLE 0 176))         ;doing GT40 simulation 
     685      (SETQ SI:KBD-NEW-TABLE SUDS-KBD-NEW-TABLE)) 
    674686  (OR (< BYTE 0) 
    675687      (FUNCALL (AREF GT40-DISPATCH (LOGAND 17 BYTE)) SHEET))) 
     
    10461058 
    10471059(DEFMETHOD (BASIC-TELNET :BUFFERED-TYO) (CH) 
    1048   (COND ((= CH NVT-IAC) 
    1049          (FUNCALL-SELF ':HANDLE-IAC))                   ;Perform new telnet negotiations. 
    1050         (( 
    1051  CH 200))                                       ;Ignore otelnet negotiations 
    1052         ((= CH 7) (TV:BEEP))                            ;^G rings the bell. 
    1053         ((= CH 12))                                     ;Ignore linefeeds 
    1054         ((AND (= CH 177) SIMULATE-IMLAC-FLAG)           ;Escape character 
    1055          (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE)) 
    1056         (T 
    1057          (AND ( 
     1060  (MULTIPLE-VALUE-BIND (IGNORE Y) (FUNCALL-SELF ':READ-CURSORPOS) 
     1061    (COND ((= CH NVT-IAC) 
     1062           (FUNCALL-SELF ':HANDLE-IAC))         ;Perform new telnet negotiations. 
     1063          (( 
     1064 CH 200))                               ;Ignore otelnet negotiations 
     1065          ((= CH 7) (TV:BEEP))                  ;^G rings the bell. 
     1066          ((= CH 15) 
     1067           (FUNCALL-SELF ':FORCE-OUTPUT) 
     1068           (FUNCALL-SELF ':SET-CURSORPOS 0 Y)) 
     1069          ((= CH 12) 
     1070           (FUNCALL-SELF ':FORCE-OUTPUT) 
     1071           (FUNCALL-SELF ':INCREMENT-CURSORPOS 0 1 ':CHARACTER) 
     1072           (FUNCALL-SELF ':CLEAR-EOL)) 
     1073          ((AND (= CH 177) SIMULATE-IMLAC-FLAG) ;Escape character 
     1074           (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE)) 
     1075          (T 
     1076           (AND ( 
    10581077 CH 10) ( 
    10591078 CH 15) ( CH 13)       ;Convert formatting controls 
    1060               (SETQ CH (+ CH 200)))             ;to Lisp machine char set. 
    1061          (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH)) 
    1062            (FUNCALL SELF ':FORCE-OUTPUT))))) 
     1079                (SETQ CH (+ CH 200)))           ;to Lisp machine char set. 
     1080           (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH)) 
     1081             (FUNCALL-SELF ':FORCE-OUTPUT)))))) 
    10631082 
    10641083;;;New telnet protocol IAC handler