Index: cl-syntax.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/cl-syntax.lisp,v
retrieving revision 1.13
diff -u -r1.13 cl-syntax.lisp
--- cl-syntax.lisp	9 May 2005 14:09:30 -0000	1.13
+++ cl-syntax.lisp	19 May 2005 09:54:36 -0000
@@ -111,10 +111,12 @@
 		    (make-instance 'other-entry))))))))
 
 
-(define-syntax cl-syntax ("Common-lisp" (basic-syntax))
+(define-syntax cl-syntax (basic-syntax)
   ((lexer :reader lexer)
    (valid-parse :initform 1)
-   (parser)))
+   (parser))
+  (:name "Common Lisp")
+  (:pathname-types "lisp" "lsp" "cl"))
 
 (defun neutralcharp (var)
   (and (characterp var)
Index: gui.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/gui.lisp,v
retrieving revision 1.139
diff -u -r1.139 gui.lisp
--- gui.lisp	19 May 2005 09:04:26 -0000	1.139
+++ gui.lisp	19 May 2005 09:54:36 -0000
@@ -699,6 +699,16 @@
       (concatenate 'string (pathname-name pathname)
 		   "." (pathname-type pathname))))
 
+(defun syntax-class-name-for-filepath (filepath)
+  (or (climacs-syntax::syntax-description-class-name
+       (find (or (pathname-type filepath)
+		 (pathname-name filepath))
+	     climacs-syntax::*syntaxes*
+	     :test (lambda (x y)
+		     (member x y :test #'string=))
+	     :key #'climacs-syntax::syntax-description-pathname-types))
+      'basic-syntax))
+
 (define-named-command com-find-file ()
   (let ((filepath (accept 'completable-pathname
 			  :prompt "Find File"))
@@ -707,8 +717,10 @@
     (setf (point (buffer pane)) (clone-mark (point pane)))
     (push buffer (buffers *application-frame*))
     (setf (buffer (current-window)) buffer)
-    (setf (syntax buffer) (make-instance
-			   'basic-syntax :buffer (buffer (point pane))))
+    (setf (syntax buffer)
+	  (make-instance
+	   (syntax-class-name-for-filepath filepath)
+	   :buffer (buffer (point pane))))
     ;; Don't want to create the file if it doesn't exist.
     (when (probe-file filepath) 
       (with-open-file (stream filepath :direction :input)
Index: html-syntax.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/html-syntax.lisp,v
retrieving revision 1.30
diff -u -r1.30 html-syntax.lisp
--- html-syntax.lisp	9 May 2005 13:12:47 -0000	1.30
+++ html-syntax.lisp	19 May 2005 09:54:36 -0000
@@ -22,10 +22,12 @@
 
 (in-package :climacs-html-syntax)
 
-(define-syntax html-syntax ("HTML" (basic-syntax))
+(define-syntax html-syntax (basic-syntax)
   ((lexer :reader lexer)
    (valid-parse :initform 1)
-   (parser)))
+   (parser))
+  (:name "HTML")
+  (:pathname-types "html" "htm"))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
Index: prolog-syntax.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/prolog-syntax.lisp,v
retrieving revision 1.18
diff -u -r1.18 prolog-syntax.lisp
--- prolog-syntax.lisp	7 May 2005 16:41:03 -0000	1.18
+++ prolog-syntax.lisp	19 May 2005 09:54:36 -0000
@@ -26,10 +26,12 @@
 (defclass prolog-parse-tree (parse-tree)
   ())
 
-(define-syntax prolog-syntax ("Prolog" (basic-syntax))
+(define-syntax prolog-syntax (basic-syntax)
   ((lexer :reader lexer)
    (valid-parse :initform 1)
-   (parser)))
+   (parser))
+  (:name "Prolog")
+  (:pathname-types "pl"))
 
 (defparameter *prolog-grammar* (grammar))
 
Index: syntax.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/syntax.lisp,v
retrieving revision 1.49
diff -u -r1.49 syntax.lisp
--- syntax.lisp	9 May 2005 13:12:47 -0000	1.49
+++ syntax.lisp	19 May 2005 09:54:36 -0000
@@ -39,6 +39,50 @@
 
 (defparameter *syntaxes* '())
 
+(defstruct (syntax-description (:type list))
+  (name (error "required argument") :type string)
+  (class-name (error "required argument") :type symbol)
+  (pathname-types nil :type list))
+
+(defmacro define-syntax (class-name superclasses slots &rest options)
+  (let ((defclass-options nil)
+	(default-initargs nil)
+	(name nil)
+	(pathname-types nil))
+    (dolist (option options)
+      (case (car option)
+	((:name)
+	 (if name
+	     (error "More than one ~S option provided to ~S"
+		    ':name 'define-syntax)
+	     (setf name (cadr option))))
+	((:pathname-types)
+	 (if pathname-types
+	     (error "More than one ~S option provided to ~S"
+		    ':pathname-types 'define-syntax)
+	     (setf pathname-types (cdr option))))
+	((:default-initargs)
+	 (if default-initargs
+	     (error "More than one ~S option provided to ~S"
+		    ':default-initargs 'define-syntax)
+	     (setf default-initargs (cdr option))))
+	(t (push (cdr option) defclass-options))))
+    (unless name
+      (error "~S not supplied to ~S" ':name 'define-syntax))
+    ;; FIXME: the :NAME initarg looks, well, a bit generic, and could
+    ;; collide with user-defined syntax initargs.  Use
+    ;; CLIMACS-SYNTAX::%NAME instead.
+    (setf default-initargs (list* :name name default-initargs))
+    `(progn
+      (push (make-syntax-description
+	     :name ,name :class-name ',class-name
+	     :pathname-types ',pathname-types)
+       *syntaxes*)
+      (defclass ,class-name ,superclasses ,slots
+	(:default-initargs ,@default-initargs)
+	,@defclass-options))))
+
+#+nil
 (defmacro define-syntax (class-name (name superclasses) &body body)
   `(progn (push '(,name . ,class-name) *syntaxes*)
 	  (defclass ,class-name ,superclasses
@@ -52,8 +96,8 @@
 		      (lambda (so-far action)
 			(complete-from-possibilities
 			 so-far *syntaxes* '() :action action
-			 :name-key #'car
-			 :value-key #'cdr))
+			 :name-key #'syntax-description-name
+			 :value-key #'syntax-description-class-name))
 		      :partial-completers '(#\Space)
 		      :allow-any-input t)
     (declare (ignore success string))
@@ -63,8 +107,11 @@
 ;;;
 ;;; Basic syntax
 
-(define-syntax basic-syntax ("Basic" (syntax))
-  ())
+;;; FIXME: this is a really bad name.  It's even worse if it's
+;;; case-insensitive.  Emacs' "Fundamental" isn't too bad.
+(define-syntax basic-syntax (syntax)
+  ()
+  (:name "Basic"))
 
 (defmethod update-syntax (buffer (syntax basic-syntax))
   (declare (ignore buffer))
Index: text-syntax.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/text-syntax.lisp,v
retrieving revision 1.6
diff -u -r1.6 text-syntax.lisp
--- text-syntax.lisp	13 Mar 2005 20:51:48 -0000	1.6
+++ text-syntax.lisp	19 May 2005 09:54:36 -0000
@@ -57,8 +57,10 @@
             (setf low-position (floor (+ low-position 1 high-position) 2)))
      finally (return low-position)))
 
-(define-syntax text-syntax ("Text" (basic-syntax))
-  ((paragraphs :initform (make-instance 'standard-flexichain))))
+(define-syntax text-syntax (basic-syntax)
+  ((paragraphs :initform (make-instance 'standard-flexichain)))
+  (:name "Text")
+  (:pathname-types "text" "txt" "README"))
 
 (defmethod update-syntax (buffer (syntax text-syntax))
   (let* ((high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer)))
