archive/src/buffer2.lisp

   1 ;;;;;; -*- Mode: LISP; Package: zwei; Base: 8; Syntax: common-lisp -*-;;;;;;;;;
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;     The data in this file contains enhancments.                    ;;;;;
   4 ;;;                                                                    ;;;;;
   5 ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
   6 ;;;     All rights reserved                                            ;;;;;
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8
   9
  10 (eval-when (compile load eval)
  11 (defvar semi-colon-char  #-zlch 59. #+zlch #\; )
  12 (defvar *maxima-form-delimiters* '(#\; #\$))
  13 )
  14
  15 (DEFMAJOR COM-MACSYMA-MODE MACSYMA-MODE #+ti "MACSYMA" #-ti MACSYMA
  16           "Enter a mode for editing Macsyma code.
  17 Modifies the delimiter dispatch tables appropriately for Macsyma syntax,
  18 makes comment delimiters /* and */.  Tab is Indent-Relative." ()
  19   (SET-COMTAB *MODE-COMTAB* '(#\tab com-indent-nested
  20                               ;;this defines method :mode-forms
  21                               #\c-sh-e COM-MACSYMA-EVALUATE-REGION
  22                               #\c-sh-t com-macsyma-translate-region
  23                               #\c-sh-g com-macsyma-grind-expression
  24                               #\m-sh-d com-macsyma-display-on-typeout
  25                                #\c-sh-d com-macsyma-display-into-buffer
  26                               #\c-sh-i com-macsyma-evaluate-into-buffer
  27                               #\hyper-i  com-evaluate-with-arrow
  28                               #\control-meta-f com-forward-macsyma-expression
  29                               #\control-meta-b com-backward-macsyma-expression
  30                               #\c-sh-c com-macsyma-compile-region)
  31   (make-command-alist '(com-macsyma-evaluate-into-buffer
  32                          com-macsyma-describe
  33                          com-macsyma-evaluate-buffer    ;here is where to put
  34                          com-macsyma-compile-buffer     ;any extended commands ofr
  35                          com-macsyma-evaluate-region
  36                          com-macsyma-display-into-buffer
  37                          com-macsyma-display-on-typeout
  38                          com-macsyma-grind-expression
  39                          com-macsyma-compile-region
  40                          com-macsyma-translate-buffer
  41                          com-macsyma-translate-region-to-buffer
  42                          )))
  43   ;; Tab hacking rubout.
  44   (SETQ *SPACE-INDENT-FLAG* T)
  45   (SETQ *PARAGRAPH-DELIMITER-LIST* (list #+ti #\tab #-ti (ascii #\tab) (format nil "   ")))
  46   (SETQ *COMMENT-COLUMN* (* 40. 6))
  47   (SETQ *COMMENT-START* "/*")
  48   (SETQ *COMMENT-BEGIN* "/* ")
  49   (SETQ *COMMENT-END* "*/")
  50   (PROGN
  51     (OR (BOUNDP '*MACSYMA-LIST-SYNTAX-TABLE*)
  52         (SETQ *MACSYMA-LIST-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE *MACSYMA-LIST-SYNTAX-LIST*))))
  53   (PROGN
  54     (OR (BOUNDP '*MACSYMA-word-SYNTAX-TABLE*)
  55         (SETQ *MACSYMA-word-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE *MACSYMA-word-SYNTAX-LIST*))))
  56   (SETQ *LIST-SYNTAX-TABLE* *MACSYMA-LIST-SYNTAX-TABLE*)
  57   (setq *atom-word-syntax-table* *macsyma-word-syntax-table*)
  58   (SETQ *mode-LIST-SYNTAX-TABLE* *MACSYMA-LIST-SYNTAX-TABLE*)
  59   (SET-CHAR-SYNTAX WORD-delimiter *MODE-WORD-SYNTAX-TABLE* #\*)
  60   (SET-CHAR-SYNTAX WORD-ALPHABETIC *MODE-WORD-SYNTAX-TABLE* #\?)
  61   )
  62
  63
  64
  65 (SETQ *MACSYMA-LIST-SYNTAX-LIST*
  66     '(
  67       (40 LIST-ALPHABETIC)
  68
  69       LIST-DELIMITER            ;040 space
  70       LIST-DELIMITER            ;041 ! ***
  71       LIST-DOUBLE-QUOTE         ;042 "     "
  72       LIST-DELIMITER            ;043 # ***
  73       LIST-DELIMITER            ;044 $ ***
  74       LIST-ALPHABETIC           ;045 %
  75       LIST-DELIMITER            ;046 & ***
  76       LIST-SINGLE-QUOTE         ;047 '
  77       LIST-OPEN                 ;050 (
  78       LIST-CLOSE                ;051 )
  79       LIST-DELIMITER            ;052 * ***
  80       LIST-DELIMITER            ;053 + ***
  81       LIST-DELIMITER            ;054 , ***
  82       LIST-DELIMITER            ;055 - ***
  83       LIST-DELIMITER            ;056 . ***
  84       LIST-DELIMITER            ;057 / ***
  85       (10. LIST-ALPHABETIC)                     ;DIGITS
  86       LIST-DELIMITER            ;072 : ***
  87       LIST-DELIMITER            ;073 ; ***
  88       LIST-DELIMITER            ;074 < ***
  89       LIST-DELIMITER            ;075 = ***
  90       LIST-DELIMITER            ;076 > ***
  91       LIST-ALPHABETIC           ;077 ?
  92       LIST-DELIMITER            ;100 @ ***
  93       (26. LIST-ALPHABETIC)                     ;LETTERS
  94       LIST-OPEN                 ;133 [ ***
  95       LIST-SLASH                ;134 \ ***
  96       LIST-CLOSE                ;135 ] ***
  97       LIST-DELIMITER            ;136 ^ ***
  98       LIST-alphabetic           ;137 _ ***
  99       LIST-DELIMITER            ;140 ` ***
 100       (26. LIST-ALPHABETIC)                     ;MORE LETTERS
 101       LIST-OPEN                 ;173 { ***
 102       LIST-DELIMITER            ;174 | ***        |
 103       LIST-CLOSE                ;175 } ***
 104       LIST-DELIMITER            ;176 ~ ***
 105       LIST-ALPHABETIC           ;177 integral ???
 106
 107       LIST-ALPHABETIC           ;200 null character
 108       LIST-DELIMITER            ;201 break
 109       LIST-DELIMITER            ;202 clear
 110       LIST-DELIMITER            ;203 call
 111       LIST-DELIMITER            ;204 escape (NOT altmode!)
 112       LIST-DELIMITER            ;205 backnext
 113       LIST-DELIMITER            ;206 help
 114       LIST-DELIMITER            ;207 rubout
 115       LIST-ALPHABETIC           ;210 bs
 116       LIST-DELIMITER            ;211 tab
 117       LIST-DELIMITER            ;212 line
 118       LIST-DELIMITER            ;213 vt
 119       LIST-DELIMITER            ;214 form = newpage
 120       LIST-DELIMITER            ;215 return = newline
 121       (162 LIST-ALPHABETIC)))
 122
 123
 124
 125
 126
 127 (SETQ *MACSYMA-WORD-SYNTAX-LIST*
 128       '(
 129         (40 LIST-ALPHABETIC)
 130
 131         WORD-DELIMITER                          ;040 space
 132         WORD-DELIMITER                          ;041 ! ***
 133         WORD-DELIMITER                          ;042 "     "
 134         WORD-DELIMITER                          ;043 # ***
 135         WORD-DELIMITER                          ;044 $ ***
 136         WORD-ALPHABETIC                         ;045 %
 137         WORD-DELIMITER                          ;046 & ***
 138         WORD-DELIMITER                          ;047 '
 139         WORD-DELIMITER                          ;050 (
 140         WORD-DELIMITER                          ;051 )
 141         WORD-DELIMITER                          ;052 * ***
 142         WORD-DELIMITER                          ;053 + ***
 143         WORD-DELIMITER                          ;054 , ***
 144         WORD-DELIMITER                          ;055 - ***
 145         WORD-DELIMITER                          ;056 . ***
 146         WORD-DELIMITER                          ;057 / ***
 147         (10. LIST-ALPHABETIC)                   ;DIGITS
 148         WORD-DELIMITER                          ;072 : ***
 149         WORD-DELIMITER                          ;073 ; ***
 150         WORD-DELIMITER                          ;074 < ***
 151         WORD-DELIMITER                          ;075 = ***
 152         WORD-DELIMITER                          ;076 > ***
 153         WORD-ALPHABETIC                         ;077 ?
 154         WORD-DELIMITER                          ;100 @ ***
 155         (26. LIST-ALPHABETIC)                   ;LETTERS
 156         WORD-DELIMITER                          ;133 [ ***
 157         WORD-DELIMITER                          ;134 \ ***
 158         WORD-DELIMITER                          ;135 ] ***
 159         WORD-DELIMITER                          ;136 ^ ***
 160         WORD-ALPHABETIC                         ;137 _ ***
 161         WORD-DELIMITER                          ;140 ` ***
 162         (26. LIST-ALPHABETIC)                   ;MORE LETTERS
 163         WORD-DELIMITER                          ;173 { ***
 164         WORD-DELIMITER                          ;174 | ***        |
 165         WORD-DELIMITER                          ;175 } ***
 166         WORD-ALPHABETIC                         ;176 ~ ***
 167         WORD-ALPHABETIC                         ;177 integral ???
 168
 169         WORD-ALPHABETIC                         ;200 null character
 170         WORD-DELIMITER                          ;201 break
 171         WORD-DELIMITER                          ;202 clear
 172         WORD-DELIMITER                          ;203 call
 173         WORD-DELIMITER                          ;204 escape (NOT altmode!)
 174         WORD-DELIMITER                          ;205 backnext
 175         WORD-DELIMITER                          ;206 help
 176         WORD-DELIMITER                          ;207 rubout
 177         WORD-DELIMITER                          ;210 bs
 178         WORD-DELIMITER                          ;211 tab
 179         WORD-DELIMITER                          ;212 line
 180         WORD-DELIMITER                          ;213 vt
 181         WORD-DELIMITER                          ;214 form = newpage
 182         WORD-DELIMITER                          ;215 return = newline
 183         (162 LIST-ALPHABETIC)))
 184
 185
 186 (defun in-macsyma-comment (bp &aux tem tem2)
 187   (cond ((setq tem (search bp *comment-start*  t nil))
 188          (cond ((setq tem2 (search tem *comment-end* nil ))
 189                 (cond ((bp-< bp tem2) t)
 190                       (t nil)))
 191                (t t)))))
 192
 193 (defun end-of-macsyma-form (bp &aux tem)
 194   (loop while (setq tem (search-set bp '(#\$ #\; )))
 195         when (not (or (in-macsyma-comment tem) (in-macsyma-string tem)))
 196           do (return tem)
 197         else
 198           do (setq bp tem)
 199        finally (return (zwei::interval-last-bp *interval*))))
 200
 201 (defun end-of-previous-macsyma-form (bp &aux tem)
 202   (loop while (setq tem (search-set bp '(#\$ #\;) t))
 203         when (not (or (in-macsyma-comment tem) (in-macsyma-string tem)))
 204           do (return tem)
 205         else
 206           do (setq bp tem)
 207        finally (return (zwei::interval-first-bp *interval*))))
 208
 209 (defun mark-current-macsyma-form ()
 210   (skip-back-over-whitespace)
 211   (let ((end-of-previous-form (end-of-previous-macsyma-form  (point)))
 212         (end-of-current-form ()))
 213      (cond ((equal end-of-previous-form (zwei::interval-first-bp zwei::*interval*))
 214             (move-bp (point)  end-of-previous-form))
 215            (t (zwei::move-bp (zwei::point) (forward-char end-of-previous-form))))
 216     (point-pdl-push (point) *window* nil nil)
 217     (move-bp (mark) (point))
 218     (setq end-of-current-form (zwei::end-of-macsyma-form (zwei::point)))
 219     (cond ((null end-of-current-form)
 220            (barf "Nothing to Evaluate"))
 221           (t (move-bp (point) end-of-current-form)))))
 222
 223
 224
 225 (defun macsyma-skip-comment (bp &optional reversep stop-bp &aux found-comment answ answ2)
 226   (cond ((in-macsyma-comment bp)
 227          (macsyma-skip-present-comment bp reversep)))
 228   (cond ((null stop-bp)
 229          (cond (reversep (setq stop-bp (interval-first-bp *interval*)))
 230                (t     (interval-last-bp *interval*)))))
 231   (setq answ  (cond (reversep
 232                      (setq bp (backward-over *whitespace-chars* bp)))
 233                     (t
 234                      (setq bp (forward-over *whitespace-chars* bp)))))
 235   (setq answ2 (cond ((bp-= bp stop-bp) nil)
 236                     ((cond ( (or (and (null reversep) (looking-at bp *comment-start*))
 237                                  (and  reversep (looking-at-backward bp *comment-end*)))
 238                             (setq found-comment t)
 239                             (macsyma-skip-present-comment bp reversep))))))
 240   (values (or answ2 answ) found-comment))
 241
 242
 243
 244 (defun macsyma-skip-present-comment (bp &optional reversep &aux (times 1))
 245    (setq bp (forward-char bp times))
 246   (cond (reversep (setq times (- 1))))
 247   (let ((x (cond ((null reversep)   (search bp *comment-end*))
 248                  (t   (search bp *comment-start* (< times 0))))))
 249     (cond ((null x) (barf "Unbalanced comment."))
 250           (t x))))