scheme interaction mode
[bpt/emacs.git] / lisp / progmodes / scheme.el
index 14f8dd6..32ee3c2 100644 (file)
@@ -99,7 +99,7 @@
     (modify-syntax-entry ?\( "()  " st)
     (modify-syntax-entry ?\) ")(  " st)
     ;; It's used for single-line comments as well as for #;(...) sexp-comments.
-    (modify-syntax-entry ?\; "< 2 " st)
+    (modify-syntax-entry ?\; "<"    st)
     (modify-syntax-entry ?\" "\"   " st)
     (modify-syntax-entry ?' "'   " st)
     (modify-syntax-entry ?` "'   " st)
   (setq-local lisp-indent-function 'scheme-indent-function)
   (setq mode-line-process '("" scheme-mode-line-process))
   (setq-local imenu-case-fold-search t)
-  (setq imenu-generic-expression scheme-imenu-generic-expression)
-  (setq-local imenu-syntax-alist
-       '(("+-*/.<>=?!$%_&~^:" . "w")))
+  (setq-local imenu-generic-expression scheme-imenu-generic-expression)
+  (setq-local imenu-syntax-alist '(("+-*/.<>=?!$%_&~^:" . "w")))
+  (setq-local syntax-propertize-function #'scheme-syntax-propertize)
   (setq font-lock-defaults
        '((scheme-font-lock-keywords
           scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
          nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
          beginning-of-defun
-         (font-lock-mark-block-function . mark-defun)
-         (font-lock-syntactic-face-function
-          . scheme-font-lock-syntactic-face-function)
-         (parse-sexp-lookup-properties . t)
-         (font-lock-extra-managed-props syntax-table)))
+         (font-lock-mark-block-function . mark-defun)))
   (setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt))
 
 (defvar scheme-mode-line-process "")
@@ -354,28 +350,28 @@ See `run-hooks'."
        (forward-comment (point-max))
        (if (eq (char-after) ?\() 2 0)))
 
-(defun scheme-font-lock-syntactic-face-function (state)
-  (when (and (null (nth 3 state))
-             (eq (char-after (nth 8 state)) ?#)
-             (eq (char-after (1+ (nth 8 state))) ?\;))
-    ;; It's a sexp-comment.  Tell parse-partial-sexp where it ends.
-    (save-excursion
-      (let ((pos (point))
-            (end
-             (condition-case err
-                 (let ((parse-sexp-lookup-properties nil))
-                   (goto-char (+ 2 (nth 8 state)))
-                   ;; FIXME: this doesn't handle the case where the sexp
-                   ;; itself contains a #; comment.
-                   (forward-sexp 1)
-                   (point))
-               (scan-error (nth 2 err)))))
-        (when (< pos (- end 2))
-          (put-text-property pos (- end 2)
-                             'syntax-table scheme-sexp-comment-syntax-table))
-        (put-text-property (- end 1) end 'syntax-table '(12)))))
-  ;; Choose the face to use.
-  (lisp-font-lock-syntactic-face-function state))
+(defun scheme-syntax-propertize (beg end)
+  (goto-char beg)
+  (scheme-syntax-propertize-sexp-comment (point) end)
+  (funcall
+   (syntax-propertize-rules
+    ("\\(#\\);" (1 (prog1 "< cn"
+                     (scheme-syntax-propertize-sexp-comment (point) end)))))
+   (point) end))
+
+(defun scheme-syntax-propertize-sexp-comment (_ end)
+  (let ((state (syntax-ppss)))
+    (when (eq 2 (nth 7 state))
+      ;; It's a sexp-comment.  Tell parse-partial-sexp where it ends.
+      (condition-case nil
+          (progn
+            (goto-char (+ 2 (nth 8 state)))
+            ;; FIXME: this doesn't handle the case where the sexp
+            ;; itself contains a #; comment.
+            (forward-sexp 1)
+            (put-text-property (1- (point)) (point)
+                               'syntax-table (string-to-syntax "> cn")))
+        (scan-error (goto-char end))))))
 
 ;;;###autoload
 (define-derived-mode dsssl-mode scheme-mode "DSSSL"
@@ -592,6 +588,67 @@ indentation."
       (put 'unassigned\?-components 'scheme-indent-function 1)
       (put 'unbound\?-components 'scheme-indent-function 1)
       (put 'variable-components 'scheme-indent-function 1)))
+\f
+;; Scheme Interaction Mode
+
+(defun scheme-eval-defun ()
+  (interactive)
+  (let ((debug-on-error eval-expression-debug-on-error)
+        (print-length eval-expression-print-length)
+        (print-level eval-expression-print-level))
+    (let* ((value (eval-scheme (thing-at-point 'defun t)))
+           (str (eval-expression-print-format value)))
+      (prin1 value t)
+      (if str (princ str))
+      value)))
+
+(defun scheme-eval-print-last-sexp (arg)
+  (interactive "P")
+  (setq arg (or arg t))
+  (let ((standard-output (current-buffer)))
+    (terpri)
+    (let ((standard-output (if arg (current-buffer) t))
+          (form (buffer-substring-no-properties
+                 (save-excursion (backward-sexp) (point))
+                 (point))))
+      (eval-last-sexp-print-value (eval-scheme form) arg))
+    (terpri)))
+
+(defvar scheme-interaction-mode-map
+  (let ((map (make-sparse-keymap))
+       (menu-map (make-sparse-keymap "Scheme-Interaction")))
+    (set-keymap-parent map lisp-mode-shared-map)
+    (define-key map "\e\C-x" 'scheme-eval-defun)
+    (define-key map "\n" 'scheme-eval-print-last-sexp)
+    (bindings--define-key map [menu-bar scheme-interaction]
+      (cons "Scheme-Interaction" menu-map))
+    (bindings--define-key menu-map [eval-defun]
+      '(menu-item "Evaluate Defun" scheme-eval-defun
+                 :help "Evaluate the top-level form containing point, or after point"))
+    (bindings--define-key menu-map [print-last-sexp]
+      '(menu-item "Evaluate and Print" scheme-eval-print-last-sexp
+                 :help "Evaluate sexp before point; print value into current buffer"))
+    (bindings--define-key menu-map [indent-sexp]
+      '(menu-item "Indent" indent-sexp
+                 :help "Indent each line of the list starting just after point"))
+    map)
+  "Keymap for Scheme Interaction mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
+
+(define-derived-mode scheme-interaction-mode scheme-mode "Scheme Interaction"
+  "Major mode for typing and evaluating Scheme forms.
+Like Scheme mode except that \\[scheme-eval-print-last-sexp] evals the
+Scheme expression before point, and prints its value into the
+buffer, advancing point.  Note that printing is controlled by
+`eval-expression-print-length' and `eval-expression-print-level'.
+
+Commands:
+Delete converts tabs to spaces as it moves back.
+Paragraphs are separated only by blank lines.
+Semicolons start comments.
+
+\\{scheme-interaction-mode-map}"
+  :abbrev-table nil)
 
 (provide 'scheme)