Add M-x describe-syntax.

diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index ab7c7d3c41361026b47dfb92e30212b31221bfaa..a02bff879dc4885b37201acf9cf2ee35e503f72e 100644 (file)
--- a/v7/src/edwin/modefs.scm
+++ b/v7/src/edwin/modefs.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: modefs.scm,v 1.141 1992/10/20 20:03:14 jinx Exp $
+;;;    $Id: modefs.scm,v 1.142 1992/11/13 22:43:45 cph Exp $
 ;;;
 ;;;    Copyright (c) 1985, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -238,6 +238,7 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental '(#\c-h #\k) 'describe-key)
 (define-key 'fundamental '(#\c-h #\l) 'view-lossage)
 (define-key 'fundamental '(#\c-h #\m) 'describe-mode)
+(define-key 'fundamental '(#\c-h #\s) 'describe-syntax)
 (define-key 'fundamental '(#\c-h #\t) 'help-with-tutorial)
 (define-key 'fundamental '(#\c-h #\v) 'describe-variable)
 (define-key 'fundamental '(#\c-h #\w) 'where-is)
@@ -299,7 +300,7 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental '(#\c-x #\q) 'kbd-macro-query)
 (define-key 'fundamental '(#\c-x #\r) 'copy-rectangle-to-register)
 (define-key 'fundamental '(#\c-x #\s) 'save-some-buffers)
-;(define-key 'fundamental '(#\c-x #\t) 'transpose-regions)
+;;(define-key 'fundamental '(#\c-x #\t) 'transpose-regions)
 (define-key 'fundamental '(#\c-x #\u) 'undo)
 (define-key 'fundamental '(#\c-x #\w) 'widen)
 (define-key 'fundamental '(#\c-x #\x) 'copy-to-register)

diff --git a/v7/src/edwin/syntax.scm b/v7/src/edwin/syntax.scm
index 5bd12318d147f0ee1867e5a2382bde7990c3cac9..a12cbdfa86feabe75b8d3b5a053aa081c8390eb4 100644 (file)
--- a/v7/src/edwin/syntax.scm
+++ b/v7/src/edwin/syntax.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/syntax.scm,v 1.75 1992/07/09 15:55:19 arthur Exp $
+;;;    $Id: syntax.scm,v 1.76 1992/11/13 22:43:33 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -104,6 +104,23 @@
   ((ucode-primitive char->syntax-code) (syntax-table/entries syntax-table)
                                       char))
 
+(define (syntax-entry->string entry)
+  (let ((code (fix:and #xff entry)))
+    (if (> code 12)
+       "invalid"
+       (string-append
+        (vector-ref '#(" " "." "w" "_" "(" ")" "'" "\"" "$" "\\" "/" "<" ">")
+                    code)
+        (let ((match (fix:and #xff (fix:lsh -8 entry))))
+          (if (zero? match)
+              " "
+              (emacs-key-name (ascii->char match) false)))
+        (if (fix:= 0 (fix:and #x10000 entry)) "" "1")
+        (if (fix:= 0 (fix:and #x20000 entry)) "" "2")
+        (if (fix:= 0 (fix:and #x40000 entry)) "" "3")
+        (if (fix:= 0 (fix:and #x80000 entry)) "" "4")
+        (if (fix:= 0 (fix:and #x100000 entry)) "" "p")))))
+\f
 (define (substring-find-next-char-of-syntax string start end
                                            syntax-table syntax)
   (let loop ((index start))
@@ -124,6 +141,79 @@
             (loop (+ index 1))
             index))))
 \f
+(define-command describe-syntax
+  "Describe the syntax specifications in the syntax table.
+The descriptions are inserted in a buffer,
+which is selected so you can see it."
+  ()
+  (lambda ()
+    (with-output-to-help-display
+     (lambda ()
+       (newline)
+       (let ((table (syntax-table/entries (ref-variable syntax-table))))
+        (let ((table-end (vector-length table))
+              (describe-char-range
+               (lambda (bottom top)
+                 (let ((describe-char
+                        (lambda (ascii)
+                          (emacs-key-name (ascii->char ascii) false)))
+                       (top (- top 1)))
+                   (if (= bottom top)
+                       (describe-char bottom)
+                       (string-append (describe-char bottom)
+                                      " .. "
+                                      (describe-char top)))))))
+          (let loop ((start 0))
+            (if (< start table-end)
+                (let* ((entry (vector-ref table start))
+                       (end
+                        (let loop ((index (+ start 1)))
+                          (if (and (< index table-end)
+                                   (eqv? entry (vector-ref table index)))
+                              (loop (+ index 1))
+                              index))))
+                  (let ((range-desc (describe-char-range start end)))
+                    (write-string range-desc)
+                    (write-char #\tab)
+                    (if (< (string-length range-desc) 8)
+                        (write-char #\tab)))
+                  (describe-syntax-entry entry)
+                  (loop end))))))))))
+
+(define (describe-syntax-entry entry)
+  (let ((code (fix:and #xff entry)))
+    (if (> code 12)
+       (write-string "invalid")
+       (begin
+         (write-string (syntax-entry->string entry))
+         (write-string "\twhich means: ")
+         (write-string
+          (vector-ref '#("whitespace" "punctuation" "word" "symbol" "open"
+                                      "close" "quote" "string" "math"
+                                      "escape" "charquote" "comment"
+                                      "endcomment" "invalid")
+                      code))
+         (let ((match (fix:and #xff (fix:lsh -8 entry))))
+           (if (not (zero? match))
+               (begin
+                 (write-string ", matches ")
+                 (write-string (emacs-key-name (ascii->char match) false)))))
+         (if (not (fix:= 0 (fix:and #x10000 entry)))
+             (write-string
+              ",\n\t  is the first character of a comment-start sequence"))
+         (if (not (fix:= 0 (fix:and #x20000 entry)))
+             (write-string
+              ",\n\t  is the second character of a comment-start sequence"))
+         (if (not (fix:= 0 (fix:and #x40000 entry)))
+             (write-string
+              ",\n\t  is the first character of a comment-end sequence"))
+         (if (not (fix:= 0 (fix:and #x80000 entry)))
+             (write-string
+              ",\n\t  is the second character of a comment-end sequence"))
+         (if (not (fix:= 0 (fix:and #x100000 entry)))
+             (write-string ",\n\t  is a prefix character")))))
+  (newline))
+\f
 ;;;; Word Parsing
 
 (define-variable syntax-table