;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base:8. ; Fonts:cptfont, cptfontb -*- #| 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. +-Data--+ This file is part of the | BOXER | system +-------+ This file contains Macros and Variable Declarations for BOXER Editor Commands |# (DEFVAR *BOXER-EDITOR-COMMANDS* NIL "A list of all the commands used in the editor. ") (DEFUN INITIALIZE-EDITOR () (SETQ *COLUMN* 0) (RESET-EDITOR-NUMERIC-ARG) (UNLESS (NULL (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION))) (FLUSH-REGION (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION))))) ;;;; Utilities for Numeric args (DEFVAR *EDITOR-NUMERIC-ARGUMENT* NIL "Stores the value of whatever numeric argument for an editor function has accumalated. ") (DEFMACRO WITH-MULTIPLE-EXECUTION (&BODY BODY) ;; this is for turning single execution coms into ones that will take numeric arguments `(UNWIND-PROTECT (IF (NULL *EDITOR-NUMERIC-ARGUMENT*) (PROGN ,@BODY) (DOTIMES (I *EDITOR-NUMERIC-ARGUMENT*) . ,BODY)) (RESET-EDITOR-NUMERIC-ARG))) (DEFUN RESET-EDITOR-NUMERIC-ARG () (SETQ *EDITOR-NUMERIC-ARGUMENT* NIL) (REDRAW-STATUS-LINE)) (DEFUN SET-EDITOR-NUMERIC-ARG (NEW-ARG) (SETQ *EDITOR-NUMERIC-ARGUMENT* NEW-ARG) (REDRAW-STATUS-LINE)) (DEFUN BOXER-KEY-NAME? (NAME) (OR (STRING-SEARCH "-KEY" (STRING NAME)) (STRING-SEARCH "MOUSE-" (STRING NAME)))) (DEFUN BOXER-EDITOR-COMMAND? (COM) (MEMQ COM *BOXER-EDITOR-COMMANDS*)) (DEFUN BOXER-COMMAND-DEFINE (COM-NAME DOC-STRING) (UNLESS (BOXER-EDITOR-COMMAND? COM-NAME) (PUSH COM-NAME *BOXER-EDITOR-COMMANDS*)) (IF (STRINGP DOC-STRING) (PUTPROP COM-NAME DOC-STRING 'EDITOR-DOCUMENTATION) (FERROR "Boxer Editor Commands Require a Documentation String. "))) (DEFMACRO DEFBOXER-COMMAND (COM-NAME ARGS DOC-STRING . BODY) `(PROGN 'COMPILE (BOXER-COMMAND-DEFINE ',COM-NAME ',DOC-STRING) (DEFUN ,COM-NAME ,ARGS ,DOC-STRING (*CATCH 'BOXER-EDITOR-TOP-LEVEL . ,BODY)))) ;;; Editor no nos ;;; beeps for now but should be more informative in the future ;;; in the future, should do something with a string arg ;;; Use BOXER-EDITOR-ERROR for unanticipated problems with allowed usage ;;; for example, a string search that fails (DEFUN BOXER-EDITOR-ERROR (STRING) STRING ;bound but never used.... (BEEP)) (DEFMACRO EDITOR-BARF (STRING . ARGS) `(FERROR ,STRING . ,ARGS)) ;;;; Useful information about where you are (DEFUN BOX-POINT-IS-IN() ;returns the box the bp part of (BP-BOX *POINT*)) ;*point* refers to (DEFUN SCREEN-BOX-POINT-IS-IN () ;returns the screen box the *point* is in (POINT-SCREEN-BOX)) (DEFUN BOX-SCREEN-POINT-IS-IN () ;returns the box that the screen part of (TELL (POINT-SCREEN-BOX) :ACTUAL-OBJ)) ;*point* refers to (DEFUN BOX-POINT-IS-NEAR () (LET* ((ROW (BP-ROW *POINT*)) (CHA-NO (BP-CHA-NO *POINT*)) (CHA-BEFORE-BP (TELL ROW :CHA-AT-CHA-NO (- CHA-NO 1))) (CHA-AFTER-BP (TELL ROW :CHA-AT-CHA-NO CHA-NO))) (COND ((BOX? CHA-AFTER-BP) CHA-AFTER-BP) ((BOX? CHA-BEFORE-BP) CHA-BEFORE-BP) (T NIL)))) (DEFUN SCREEN-BOX-POINT-IS-NEAR () (TELL (BOX-POINT-IS-NEAR) :ALLOCATE-SCREEN-OBJ-FOR-USE-IN (SCREEN-BOX-POINT-IS-IN))) ;;;; Macros iterating over characters in a row (DEFMACRO MAP-OVER-CHAS ((START-BP DIRECTION) &BODY BODY) `(DO* ((ROW (BP-ROW ,START-BP) ROW) (NEXT-OR-PREVIOUS-ROW (IF (PLUSP ,DIRECTION) (TELL-CHECK-NIL ROW :NEXT-ROW) (TELL-CHECK-NIL ROW :PREVIOUS-ROW)) (IF (PLUSP ,DIRECTION) (TELL-CHECK-NIL ROW :NEXT-ROW) (TELL-CHECK-NIL ROW :PREVIOUS-ROW))) (CHA-NO (BP-CHA-NO ,START-BP) (+ CHA-NO ,DIRECTION)) (CHA (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO (- CHA-NO 1))) (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO (- CHA-NO 1))))) (NIL) (COND ((AND (NULL CHA) (NOT-NULL NEXT-OR-PREVIOUS-ROW)) (SETQ ROW NEXT-OR-PREVIOUS-ROW CHA-NO (IF (PLUSP DIRECTION) 0 (TELL NEXT-OR-PREVIOUS-ROW :LENGTH-IN-CHAS)))) (T . ,BODY)))) (COMPILER:MAKE-OBSOLETE MAP-OVER-CHAS "Use MAP-OVER-CHAS-IN-LINE Instead. ") (DEFMACRO MAP-OVER-CHAS-IN-LINE ((START-BP DIRECTION) &BODY BODY) `(DO* ((ROW (BP-ROW ,START-BP) ROW) (NEXT-OR-PREVIOUS-ROW (IF (PLUSP ,DIRECTION) (TELL-CHECK-NIL ROW :NEXT-ROW) (TELL-CHECK-NIL ROW :PREVIOUS-ROW)) (IF (PLUSP ,DIRECTION) (TELL-CHECK-NIL ROW :NEXT-ROW) (TELL-CHECK-NIL ROW :PREVIOUS-ROW))) (CHA-NO (BP-CHA-NO ,START-BP) (+ CHA-NO ,DIRECTION)) (CHA (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO (- CHA-NO 1))) (TELL ROW :CHA-AT-CHA-NO (IF (PLUSP ,DIRECTION) CHA-NO (- CHA-NO 1))))) (NIL) (COND ((AND (NULL NOT-FIRST-CHA?) (NULL CHA) (NOT-NULL NEXT-OR-PREVIOUS-ROW)) (SETQ ROW NEXT-OR-PREVIOUS-ROW CHA-NO (IF (PLUSP DIRECTION) 0 (1+ (TELL NEXT-OR-PREVIOUS-ROW :LENGTH-IN-CHAS))))) (T . ,BODY)))) ;;; For Killing stuff ;for control-y (DEFSUBST KILL-BUFFER-TOP () (CAR *KILL-BUFFER*)) ;;;; Variables... ;;; Used by the Kill stuff (defvar *kill-buffer-last-direction* nil) (defvar *kill-buffer* (make-list 8)) (defvar *number-of-non-kill-commands-executed* 0) ;;; Used by search (DEFVAR *CASE-AFFECTS-STRING-SEARCH* NIL) ;;; Documantations VArs (DEFVAR *TOP-LEVEL-HELP-BOX* (MAKE-BOX '(("Type one of the following:") ("A (Display commands with a given string)") ("C (Document a Particular Command)") ("")))) (DEFVAR *COMMAND-DOCUMENTATION-HELP-BOX* (MAKE-BOX '(("Type a key to be documented: ") ("") ("")))) (DEFVAR *APROPOS-DOCUMENTATION-HELP-BOX* (MAKE-BOX `(("APROPOS (Substring): ") ("") ("")))) ;;; Sprite commands use this one (DEFMACRO BOXER-TELLING (BOX-TO-DO IN-BOX) `(WITH-STATIC-ROOT-BOUND (GET-LEXICAL-ROOT ,IN-BOX) (EVAL-BOX-ROWS ,BOX-TO-DO)))