+(defconst scheme-sexp-comment-syntax-table
+ (let ((st (make-syntax-table scheme-mode-syntax-table)))
+ (modify-syntax-entry ?\; "." st)
+ (modify-syntax-entry ?\n " " st)
+ (modify-syntax-entry ?# "'" st)
+ st))
+
+(put 'lambda 'scheme-doc-string-elt 2)
+;; Docstring's pos in a `define' depends on whether it's a var or fun def.
+(put 'define 'scheme-doc-string-elt
+ (lambda ()
+ ;; The function is called with point right after "define".
+ (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))
+