Function: scheme-syntax-propertize-sexp-comment

scheme-syntax-propertize-sexp-comment is a byte-compiled function defined in scheme.el.gz.

Signature

(scheme-syntax-propertize-sexp-comment END)

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/scheme.el.gz
(defun scheme-syntax-propertize-sexp-comment (end)
  (let ((state (syntax-ppss))
        ;; (beg (point))
        (checked (point)))
    (when (eq 2 (nth 7 state))
      ;; It's a sexp-comment.  Tell parse-partial-sexp where it ends.
      (named-let loop ((startpos (+ 2 (nth 8 state))))
        (let ((found nil))
          (while
              (progn
                (setq found nil)
                (condition-case nil
                    (save-restriction
                      (narrow-to-region (point-min) end)
                      (goto-char startpos)
                      (forward-sexp 1)
                      ;; (cl-assert (> (point) beg))
                      (setq found (point)))
                  (scan-error (goto-char end)))
                ;; If there's a nested `#;', the syntax-tables will normally
                ;; consider the `;' to start a normal comment, so the
                ;; (forward-sexp 1) above may have landed at the wrong place.
                ;; So look for `#;' in the text over which we jumped, and
                ;; mark those we found as nested sexp-comments.
                (let ((limit (min end (or found end))))
                  (when (< checked limit)
                    (goto-char checked)
                    (while (and (re-search-forward "\\(#\\);" limit 'move)
                                ;; Skip those #; inside comments and strings.
                                (nth 8 (save-excursion
                                         (parse-partial-sexp
                                          startpos (match-beginning 0))))))
                    (setq checked (point))
                    (when (< (point) limit)
                      (put-text-property (match-beginning 1) (match-end 1)
                                         'syntax-table
                                         (string-to-syntax "< cn"))
                      (loop (point))
                      ;; Try the `forward-sexp' with the new text state.
                      t)))))
          (when found
            (goto-char found)
            (put-text-property (1- found) found
                               'syntax-table (string-to-syntax "> cn"))))))))