home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / comsr.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  6.1 KB  |  140 lines
  1. ;; (C) Copyright 1985 Massachusetts Institute of Technology
  2. ;;
  3. ;; Permission to use, copy, modify, distribute, and sell this software
  4. ;; and its documentation for any purpose is hereby granted without fee,
  5. ;; provided that the above copyright notice appear in all copies and that
  6. ;; both that copyright notice and this permission notice appear in
  7. ;; supporting documentation, and that the name of M.I.T. not be used in
  8. ;; advertising or publicity pertaining to distribution of the software
  9. ;; without specific, written prior permission.  M.I.T. makes no
  10. ;; representations about the suitability of this software for any
  11. ;; purpose.  It is provided "as is" without express or implied warranty.
  12. ;;
  13.  
  14. ;;;; Regions
  15.  
  16. (DEFBOXER-COMMAND COM-DEFINE-REGION ()
  17.   "defines a region between the current
  18. location of the cursor and the cursor. "
  19.   (LET ((LOCAL-REGION (GET-LOCAL-REGION)))
  20.     (COND ((NOT-NULL LOCAL-REGION)        ;there already IS a region in the current box
  21.        (SETQ *REGION-BEING-DEFINED* LOCAL-REGION)
  22.        ;; we have to decide which BP of the region to replace with *POINT*
  23.        (IF (BP-< *POINT* (TELL LOCAL-REGION :START-BP))
  24.            (TELL LOCAL-REGION :SET-START-BP *POINT*)
  25.            (TELL LOCAL-REGION :SET-STOP-BP  *POINT*)))
  26.       (T                    ;There is No current region so we make one
  27.        (SETQ *REGION-BEING-DEFINED*
  28.          (MAKE-EDITOR-REGION (MAKE-INITIALIZED-BP :FIXED (POINT-ROW) (POINT-CHA-NO))))
  29.        (TELL *REGION-BEING-DEFINED* :TURN-ON)
  30.        (PUSH *REGION-BEING-DEFINED* REGION-LIST)))))
  31.  
  32. (DEFBOXER-COMMAND COM-INSTALL-REGION ()
  33.   "installs the current region"
  34.   (UNLESS (NULL *REGION-BEING-DEFINED*)
  35.     (LET ((OLD-START-BP (TELL *REGION-BEING-DEFINED* :START-BP))
  36.       (OLD-STOP-BP  (TELL *REGION-BEING-DEFINED* :STOP-BP)))
  37.     (MULTIPLE-VALUE-BIND (NEW-START-BP NEW-STOP-BP)    ;make sure the BP's are at the
  38.     (ORDER-BPS OLD-START-BP OLD-STOP-BP)
  39.       (TELL *REGION-BEING-DEFINED* :SET-START-BP NEW-START-BP)
  40.       (TELL *REGION-BEING-DEFINED* :SET-STOP-BP  NEW-STOP-BP)
  41.       (INSTALL-REGION *REGION-BEING-DEFINED*)
  42.       (UNLESS (OR (EQ *POINT* OLD-START-BP) (EQ *MOUSE-BP* OLD-START-BP))
  43.     (TELL (BP-ROW OLD-START-BP) :DELETE-BP OLD-START-BP))
  44.       (UNLESS (OR (EQ *POINT* OLD-STOP-BP) (EQ *MOUSE-BP* OLD-STOP-BP))
  45.     (TELL (BP-ROW OLD-STOP-BP) :DELETE-BP OLD-STOP-BP))))))
  46.  
  47. (DEFBOXER-COMMAND COM-FLUSH-REGION ()
  48.   "gets rid of the current region--if it exists. "
  49.   (LET ((REGION-TO-FLUSH (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION))))
  50.     (UNLESS (NULL REGION-TO-FLUSH)
  51.       (FLUSH-REGION REGION-TO-FLUSH))))
  52.  
  53.  
  54.  
  55. (DEFBOXER-COMMAND COM-KILL-REGION ()
  56.   "kills all the characters in the current region. "
  57.   (LET ((REGION-TO-KILL (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION))))
  58.     (IF (NULL REGION-TO-KILL)
  59.     (BOXER-EDITOR-ERROR "There is no region that I can find. ")
  60.     (KILL-REGION REGION-TO-KILL)
  61.     (KILL-BUFFER-PUSH REGION-TO-KILL ':FORWARD)
  62.     (FLUSH-REGION REGION-TO-KILL))))
  63.  
  64. ;;; this is really boxify at *point* for now
  65. (DEFBOXER-COMMAND COM-BOXIFY-REGION ()
  66.   "puts all of the characters in the current
  67. region into a box. "
  68.   (LET* ((REGION-TO-BOX (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION))))
  69.     (UNLESS (NULL REGION-TO-BOX)
  70.       (KILL-REGION REGION-TO-BOX)
  71.       (COM-MAKE-BOX)
  72.       (COM-ENTER-BOX)
  73.       (YANK-REGION *POINT* REGION-TO-BOX)
  74.       (FLUSH-REGION REGION-TO-BOX)
  75.       (SETQ REGION-TO-BOX NIL))))
  76.  
  77. (DEFBOXER-COMMAND COM-UNMARK-REGION ()
  78.   "unmarks the current region. "
  79.   (LET ((REGION-TO-UNMARK (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION))))
  80.     (UNLESS (NULL REGION-TO-UNMARK)
  81.       (FLUSH-REGION REGION-TO-UNMARK))))
  82.  
  83.  
  84.  
  85. ;;; mice
  86.  
  87. (DEFUN COM-MOUSE-DEFINE-REGION (WINDOW X Y)
  88.   (WITH-MOUSE-BP-BOUND (X Y WINDOW)
  89.     MOUSE-SCREEN-BOX ;the variable was bound but never used....    
  90.     (LET ((LOCAL-REGION (OR *REGION-BEING-DEFINED* (GET-CURRENT-REGION))))
  91.       (COND ((NOT-NULL LOCAL-REGION)        ;there already IS a region in the current box
  92.          (SETQ *REGION-BEING-DEFINED*   LOCAL-REGION
  93.            *FOLLOWING-MOUSE-REGION* LOCAL-REGION)
  94.          ;; we have to decide which BP of the region to replace with *POINT*
  95.          (IF (BP-< MOUSE-BP (TELL LOCAL-REGION :START-BP))
  96.          (TELL LOCAL-REGION :SET-START-BP *MOUSE-BP*)
  97.          (TELL LOCAL-REGION :SET-STOP-BP  *MOUSE-BP*)))
  98.         (T
  99.          ;; There is No current region so we make one
  100.          ;; between the *POINT* which is moved to where the mouse is and
  101.          ;; wherever it is that we let go of the mouse
  102.          (MOVE-POINT (BP-VALUES  MOUSE-BP))
  103.          (REDISPLAY-CURSOR)
  104.          (SETQ *REGION-BEING-DEFINED*
  105.            (MAKE-EDITOR-REGION *POINT* *MOUSE-BP*)
  106.            *FOLLOWING-MOUSE-REGION* *REGION-BEING-DEFINED*)
  107.          (TELL *REGION-BEING-DEFINED* :TURN-ON)
  108.          (PUSH *REGION-BEING-DEFINED* REGION-LIST))))))
  109.  
  110. (DEFUN COM-MOUSE-RELEASE-REGION (WINDOW X Y)
  111.   "Releases the mouse from the region being created. "
  112.   (WITH-MOUSE-BP-BOUND (X Y WINDOW)
  113.     MOUSE-SCREEN-BOX                ;bound but never used...
  114.     (UNLESS (NULL *REGION-BEING-DEFINED*)
  115.       (COND ((EQ *MOUSE-BP* (TELL *REGION-BEING-DEFINED* :START-BP))
  116.          (LET ((NEW-BP (MAKE-BP ':FIXED)))
  117.            (MOVE-BP NEW-BP (BP-VALUES *MOUSE-BP*))
  118.            (TELL *REGION-BEING-DEFINED* :SET-START-BP NEW-BP)))
  119.         ((EQ *MOUSE-BP* (TELL *REGION-BEING-DEFINED* :STOP-BP))
  120.          (LET ((NEW-BP (MAKE-BP ':FIXED)))
  121.            (MOVE-BP NEW-BP (BP-VALUES *MOUSE-BP*))
  122.            (TELL *REGION-BEING-DEFINED* :SET-STOP-BP NEW-BP)))))))
  123.  
  124. ;;; If you think you want to use this, then you are probably wrong
  125. ;;; look at COM-MOUSE-RELEASE-REGION instead
  126. (DEFUN COM-MOUSE-INSTALL-REGION (WINDOW X Y)
  127.   WINDOW X Y ;the variables were bound, but never...
  128.   (UNLESS (NULL *REGION-BEING-DEFINED*)
  129.     (LET ((OLD-START-BP (TELL *REGION-BEING-DEFINED* :START-BP))
  130.       (OLD-STOP-BP  (TELL *REGION-BEING-DEFINED* :STOP-BP)))
  131.       (MULTIPLE-VALUE-BIND (NEW-START-BP NEW-STOP-BP)    ;make sure the BP's are at the
  132.       (ORDER-BPS OLD-START-BP OLD-STOP-BP)
  133.     (TELL *REGION-BEING-DEFINED* :SET-START-BP NEW-START-BP)
  134.     (TELL *REGION-BEING-DEFINED* :SET-STOP-BP  NEW-STOP-BP)
  135.     (INSTALL-REGION *REGION-BEING-DEFINED*)
  136.     (UNLESS (OR (EQ *POINT* OLD-START-BP) (EQ *MOUSE-BP* OLD-START-BP))
  137.       (TELL (BP-ROW OLD-START-BP) :DELETE-BP OLD-START-BP))
  138.     (UNLESS (OR (EQ *POINT* OLD-STOP-BP) (EQ *MOUSE-BP* OLD-STOP-BP))
  139.       (TELL (BP-ROW OLD-STOP-BP) :DELETE-BP OLD-STOP-BP))))))
  140.