;-*- mode:lisp; package: boxer; fonts: cptfont -*- ;;; (C) Copyright 1985 Massachusetts Institute of Technology ;;; ;;; Permission to use, copy, modify, distribute, and sell this software ;;; and its documentation for any purpose is hereby granted without fee, ;;; provided that the above copyright notice appear in all copies and that ;;; both that copyright notice and this permission notice appear in ;;; supporting documentation, and that the name of M.I.T. not be used in ;;; advertising or publicity pertaining to distribution of the software ;;; without specific, written prior permission. M.I.T. makes no ;;; representations about the suitability of this software for any ;;; purpose. It is provided "as is" without express or implied warranty. ;;; ;;; Boxer Error checking macros (DEFUN CHECK-NUMBER-ARGS (&REST NUMBER-LIST) (UNLESS (EVERY NUMBER-LIST #'NUMBERP) (FERROR "An input was not a number"))) ;;; error conditions and handlers for them... ;;; This is at the SYSTEM level ;;;; ERROR-OBJECTs (DEFFLAVOR BOXER-ERROR ((TYPE NIL) (FORMAT-CTL NIL) (FORMAT-ARG NIL)) (ERROR) :INITABLE-INSTANCE-VARIABLES) (DEFMETHOD (BOXER-ERROR :BUG-REPORT-RECIPIENT-SYSTEM) () 'BOXER) (DEFMETHOD (BOXER-ERROR :AFTER :INIT) (&REST IGNORE) (IF *BOXER-ERROR-HANDLER-P* (TELL SELF :REPORT-ERROR-TO-BUG-BOXER))) (DEFMETHOD (BOXER-ERROR :REPORT-ERROR-TO-BUG-BOXER) () NIL) (DEFMETHOD (BOXER-ERROR :REPORT) (STREAM) (COND ((AND (NOT-NULL FORMAT-CTL) (LISTP FORMAT-ARG)) (LEXPR-FUNCALL 'FORMAT STREAM FORMAT-CTL FORMAT-ARG)) ((NOT-NULL FORMAT-CTL) (FORMAT STREAM FORMAT-CTL FORMAT-ARG)) (T (FORMAT STREAM "A Boxer Error of type ~S has occured." TYPE)))) (DEFFLAVOR BOXER-INTERNAL-EDITOR-ERROR () (BOXER-ERROR)) (DEFFLAVOR BOXER-BP-ERROR () (BOXER-ERROR)) (DEFFLAVOR BOXER-UNDEFINED-FUNCTION-ERROR () (BOXER-ERROR)) (DEFFLAVOR BOXER-STACK-HACKER-ERROR () (BOXER-ERROR)) (DEFFLAVOR BOXER-SET-TYPE-ERROR ((TYPE NIL) (BOX NIL)) (BOXER-INTERNAL-EDITOR-ERROR) :INITABLE-INSTANCE-VARIABLES :GETTABLE-INSTANCE-VARIABLES :OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES) (DEFMETHOD (BOXER-SET-TYPE-ERROR :REPORT) (STREAM) (FORMAT STREAM "Cannot change the box, ~S, to the type ~S" BOX TYPE)) (DEFUN BOXER-SET-TYPE-ERROR-HANDLER (CONDITION) CONDITION ;the variable was bound but..... NIL) ; (WHEN (MEMQ (BOXER-SET-TYPE-ERROR-TYPE CONDITION) ; '(:TURTLE-BOX TURTLE-BOX :GRAPHICS-BOX GRAPHICS-BOX)) ; (TELL CONDITION :PROCEED :COMPLEX-CHANGE))) (DEFMETHOD (BOXER-SET-TYPE-ERROR :CASE :PROCEED :NEW-TYPE) (&OPTIONAL (NEW-TYPE (PROMPT-AND-READ :EXPRESSION "Type to use instead: "))) "Supply a different type. " (VALUES ':NEW-TYPE (TELL BOX :SET-TYPE NEW-TYPE))) (COMMENT ;it doesn't work (DEFMETHOD (BOXER-SET-TYPE-ERROR :CASE :PROCEED :COMPLEX-CHANGE) () "Changing flavors when all the instance variables are not the same. " ;; first we put all the essential information into the plist of the box (LET ((SCREEN-BOX (CAR (TELL BOX :DISPLAYED-SCREEN-OBJS)))) ;; we really want the actual unclipped size of the box for this (or do we ?) (TELL BOX :PUTPROP (TELL BOX :SUPERIOR-ROW) ':SUPERIOR-ROW) (WHEN (AND (NULL (TELL BOX :GET ':FIXED-WID)) (NULL (TELL BOX :GET ':FIXED-HEI))) (MULTIPLE-VALUE-BIND (CURRENT-WID CURRENT-HEI) (SCREEN-OBJ-SIZE SCREEN-BOX) (TELL BOX :PUTPROP CURRENT-WID ':FIXED-WID) (TELL BOX :PUTPROP CURRENT-HEI ':FIXED-HEI)))) ;; now we bind the plist and then we change the flavor descriptor and reinitalize changed ;; box from the bound plist (LET ((TEMP-PLIST (TELL BOX :PLIST)) (NEW-FLAVOR-DESCRIPTOR (GET TYPE 'SI:FLAVOR))) (%P-STORE-POINTER BOX NEW-FLAVOR-DESCRIPTOR) (TELL BOX :INIT TEMP-PLIST)) (VALUES ':COMPLEX-CHANGE BOX)) ) ;;; Redisplay errors (DEFFLAVOR BOXER-REDISPLAY-ERROR () (BOXER-ERROR)) (DEFMETHOD (BOXER-REDISPLAY-ERROR :REPORT) (STREAM) (COND ((AND (NOT-NULL FORMAT-CTL) (LISTP FORMAT-ARG)) (LEXPR-FUNCALL 'FORMAT STREAM FORMAT-CTL FORMAT-ARG)) ((NOT-NULL FORMAT-CTL) (FORMAT STREAM FORMAT-CTL FORMAT-ARG)) (T (FORMAT STREAM "A Boxer Redisplay Error of type ~S has occured." TYPE)))) (DEFFLAVOR BOXER-CURSOR-REDISPLAY-ERROR () (BOXER-REDISPLAY-ERROR)) (DEFFLAVOR BOXER-REGION-REDISPLAY-ERROR () (BOXER-REDISPLAY-ERROR))