(scheme-mode-syntax-table): Mark ; as being also the

second char of a comment-start sequence.
(scheme-sexp-comment-syntax-table): New var.
(lambda, define): Set their scheme-doc-string-elt property.
(scheme-font-lock-syntactic-face-function): Handle sexp-comments.
Use lisp-font-lock-syntactic-face-function now that it properly
handles |...| symbols.
(scheme-mode-variables): Set lisp-doc-string-elt-property,
parse-sexp-lookup-properties and font-lock-extra-managed-props.

2 files changed, 82 insertions, 19 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b713d5d2df9..a9d8a3923d6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,34 @@
+2005-10-05  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * progmodes/scheme.el (scheme-mode-syntax-table): Mark ; as being
+        also the second char of a comment-start sequence.
+        (scheme-sexp-comment-syntax-table): New var.
+        (lambda, define): Set their scheme-doc-string-elt property.
+        (scheme-font-lock-syntactic-face-function): Handle sexp-comments.
+        Use lisp-font-lock-syntactic-face-function now that it properly
+        handles |...| symbols.
+        (scheme-mode-variables): Set lisp-doc-string-elt-property,
+        parse-sexp-lookup-properties and font-lock-extra-managed-props.
+
+        * emacs-lisp/lisp-mode.el (lisp-mode-syntax-table): Move the nesting
+        bit from # to |.
+        (lisp-font-lock-syntactic-face-function): Distinguish |...| symbols.
+
+        * emacs-lisp/lisp-mode.el (lambda): Add its doc-string-elt property.
+        (lisp-doc-string-elt-property): New var.
+        (lisp-font-lock-syntactic-face-function): Use it.
+        Rewrite to recognize docstrings even for forms not at toplevel.
+
+        * progmodes/scheme.el (scheme-mode-syntax-table): Put the nested
+        annotation on the | part of #| rather than on the # part.
+        (scheme-font-lock-syntactic-face-function): New function, to
+        distinguish strings from |...| symbols.
+        (scheme-mode-variables): Use it.  Also fix up the font-lock-time
+        syntax-table so that #|...|# is properly highlighted.
+
+        * emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function):
+        Don't mark as docstring the 3rd elem of an unknown toplevel form.
+
 2005-10-04  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * bindings.el (global-map): Resync [home] and [end] bindings with C-a
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index cae3ac582ef..15ab8edaadc 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -100,8 +100,9 @@
     ;; Other atom delimiters
     (modify-syntax-entry ?\( "()  " st)
     (modify-syntax-entry ?\) ")(  " st)
-    (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)
 
@@ -168,15 +169,18 @@
   (setq imenu-generic-expression scheme-imenu-generic-expression)
   (set (make-local-variable 'imenu-syntax-alist)
         '(("+-*/.<>=?!$%_&~^:" . "w")))
-  (make-local-variable 'font-lock-defaults)
-  (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))))
+  (set (make-local-variable '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)))
+  (set (make-local-variable 'lisp-doc-string-elt-property)
+       'scheme-doc-string-elt))
 
 (defvar scheme-mode-line-process "")
 
@@ -352,15 +356,43 @@ See `run-hooks'."
 (defvar scheme-font-lock-keywords scheme-font-lock-keywords-1
   "Default expressions to highlight in Scheme modes.")
 
+(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)
-  (if (nth 3 state)
-      ;; In a string.
-      (if (eq (char-after (nth 8 state)) ?|)
-          ;; This is not a string, but a |...| symbol.
-          nil
-        font-lock-string-face)
-    ;; In a comment.
-    font-lock-comment-face))
+  (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))
 
 ;;;###autoload
 (define-derived-mode dsssl-mode scheme-mode "DSSSL"