X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5e4ab4e4d9a98a44896c80a998111d768e959686..32a9496d8d7f87bb7695b62340e2602eb9cab615:/lisp/progmodes/scheme.el diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 14f8dd6508..32ee3c2399 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -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) @@ -147,19 +147,15 @@ (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))) + +;; 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)