Changeset 221


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

Update.

Location:
trunk/lisp/lmwin
Files:
6 edited

Legend:

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

    r220 r221  
    956956;;; no windows will be re-exposed before the cadr is called.
    957957(DEFFLAVOR MOMENTARY-MENU ((LABEL NIL)) (BASIC-MOMENTARY-MENU TEMPORARY-WINDOW-MIXIN
    958                                          TOP-LABEL-MIXIN BORDERS-MIXIN
     958                                         BORDERS-MIXIN TOP-BOX-LABEL-MIXIN
    959959                                         MINIMUM-WINDOW)
    960   (:DOCUMENTATION :COMBINATION "Temporary menu that goes away after item it chosen"))
     960  (:DOCUMENTATION :COMBINATION "Temporary menu that goes away after item is chosen"))
    961961
    962962
  • trunk/lisp/lmwin/mouse.lisp

    r220 r221  
    557557(DEFUN MOUSE-BUTTONS-DEFAULT (BD &OPTIONAL (WINDOW SELF))
    558558  (COND ((BIT-TEST 1 BD) (PROCESS-RUN-FUNCTION "Mouse Select" #'MOUSE-SELECT WINDOW))
    559         ((BIT-TEST 2 BD) (FUNCALL WINDOW ':DOCUMENT))
     559        ;((BIT-TEST 2 BD) (FUNCALL WINDOW ':DOCUMENT))  ;just causes grief
    560560        ((BIT-TEST 4 BD) (MOUSE-CALL-SYSTEM-MENU))))
    561561
     
    563563  (OR (FUNCALL WINDOW ':MOUSE-SELECT NIL)
    564564      (BEEP)))
    565 
    566 (DEFMETHOD (ESSENTIAL-MOUSE :DOCUMENT) () (BEEP))
    567565
    568566(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  
    339339                (SHEET-CHARACTER-WIDTH SHEET STRING (SHEET-CURRENT-FONT SHEET))
    340340                (SHEET-STRING-LENGTH SHEET STRING START END)))
    341   (SHEET-DELETE-CHAR LEN ':PIXEL))
     341  (SHEET-DELETE-CHAR SHEET LEN ':PIXEL))
    342342
    343343
  • 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  
    671671(DEFVAR GT40-BLINKER NIL)
    672672(DEFVAR GT40-CURRENT-ITEM-NUMBER)
     673(DEFVAR SUDS-KBD-NEW-TABLE                      ;allows thumb keys to be used
     674  (LET ((TBL (SI:KBD-MAKE-NEW-TABLE)))
     675    (DOLIST (L '((176 #// #/ #// #/) (106 #/\ #/| #/\ #/|)
     676                 (117 #/[ #/{ #/[ #/{) (17 #/] #/} #/] #/})))
     677      (LET ((NCH (FIRST L)) (LCH (REST1 L)))
     678        (DOTIMES (I 5)
     679          (ASET (CAR LCH) TBL I NCH)
     680          (IF (REST1 LCH) (SETQ LCH (REST1 LCH))))))
     681    TBL))
    673682
    674683;; %TDMTN is a crock for simulating GT-40's, used by DECUUO on ITS for Imlacs...
    675684
    676685(DEFUN SUPDUP-GT40 (SHEET &AUX (BYTE (- (NVT-NETI) 100)))
     686  (IF ( (AREF SUDS-KBD-NEW-TABLE 0 176)        ;crock for thumb keys, only when
     687         (AREF SI:KBD-NEW-TABLE 0 176))         ;doing GT40 simulation
     688      (SETQ SI:KBD-NEW-TABLE SUDS-KBD-NEW-TABLE))
    677689  (OR (< BYTE 0)
    678690      (FUNCALL (AREF GT40-DISPATCH (LOGAND 17 BYTE)) SHEET)))
     
    10511063
    10521064(DEFMETHOD (BASIC-TELNET :BUFFERED-TYO) (CH)
    1053   (COND ((= CH NVT-IAC)
    1054          (FUNCALL-SELF ':HANDLE-IAC))                   ;Perform new telnet negotiations.
    1055         ((
    1056  CH 200))                                       ;Ignore otelnet negotiations
    1057         ((= CH 7) (TV:BEEP))                            ;^G rings the bell.
    1058         ((= CH 12))                                     ;Ignore linefeeds
    1059         ((AND (= CH 177) SIMULATE-IMLAC-FLAG)           ;Escape character
    1060          (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE))
    1061         (T
    1062          (AND (
     1065  (MULTIPLE-VALUE-BIND (IGNORE Y) (FUNCALL-SELF ':READ-CURSORPOS)
     1066    (COND ((= CH NVT-IAC)
     1067           (FUNCALL-SELF ':HANDLE-IAC))         ;Perform new telnet negotiations.
     1068          ((
     1069 CH 200))                               ;Ignore otelnet negotiations
     1070          ((= CH 7) (TV:BEEP))                  ;^G rings the bell.
     1071          ((= CH 15)
     1072           (FUNCALL-SELF ':FORCE-OUTPUT)
     1073           (FUNCALL-SELF ':SET-CURSORPOS 0 Y))
     1074          ((= CH 12)
     1075           (FUNCALL-SELF ':FORCE-OUTPUT)
     1076           (FUNCALL-SELF ':INCREMENT-CURSORPOS 0 1 ':CHARACTER)
     1077           (FUNCALL-SELF ':CLEAR-EOL))
     1078          ((AND (= CH 177) SIMULATE-IMLAC-FLAG) ;Escape character
     1079           (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE))
     1080          (T
     1081           (AND (
    10631082 CH 10) (
    10641083 CH 15) ( CH 13)       ;Convert formatting controls
    1065               (SETQ CH (+ CH 200)))             ;to Lisp machine char set.
    1066          (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH))
    1067            (FUNCALL SELF ':FORCE-OUTPUT)))))
     1084                (SETQ CH (+ CH 200)))           ;to Lisp machine char set.
     1085           (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH))
     1086             (FUNCALL-SELF ':FORCE-OUTPUT))))))
    10681087
    10691088;;;New telnet protocol IAC handler
Note: See TracChangeset for help on using the changeset viewer.