Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29479
Modified Files: cl-syntax.lisp gui.lisp html-syntax.lisp prolog-syntax.lisp syntax.lisp text-syntax.lisp ttcn3-syntax.lisp Log Message: OK, no-one complained too much, so I'm going ahead with the syntax file-type changes discussed in sqmzqrhbma.fsf@cam.ac.uk: DEFINE-SYNTAX's syntax is changed incompatibly.
Date: Thu May 26 10:31:53 2005 Author: crhodes
Index: climacs/cl-syntax.lisp diff -u climacs/cl-syntax.lisp:1.13 climacs/cl-syntax.lisp:1.14 --- climacs/cl-syntax.lisp:1.13 Mon May 9 16:09:30 2005 +++ climacs/cl-syntax.lisp Thu May 26 10:31:53 2005 @@ -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: climacs/gui.lisp diff -u climacs/gui.lisp:1.139 climacs/gui.lisp:1.140 --- climacs/gui.lisp:1.139 Thu May 19 11:04:26 2005 +++ climacs/gui.lisp Thu May 26 10:31:53 2005 @@ -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: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.30 climacs/html-syntax.lisp:1.31 --- climacs/html-syntax.lisp:1.30 Mon May 9 15:12:47 2005 +++ climacs/html-syntax.lisp Thu May 26 10:31:53 2005 @@ -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: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.18 climacs/prolog-syntax.lisp:1.19 --- climacs/prolog-syntax.lisp:1.18 Sat May 7 18:41:03 2005 +++ climacs/prolog-syntax.lisp Thu May 26 10:31:53 2005 @@ -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: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.49 climacs/syntax.lisp:1.50 --- climacs/syntax.lisp:1.49 Mon May 9 15:12:47 2005 +++ climacs/syntax.lisp Thu May 26 10:31:53 2005 @@ -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: climacs/text-syntax.lisp diff -u climacs/text-syntax.lisp:1.6 climacs/text-syntax.lisp:1.7 --- climacs/text-syntax.lisp:1.6 Sun Mar 13 21:51:48 2005 +++ climacs/text-syntax.lisp Thu May 26 10:31:53 2005 @@ -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)))
Index: climacs/ttcn3-syntax.lisp diff -u climacs/ttcn3-syntax.lisp:1.1 climacs/ttcn3-syntax.lisp:1.2 --- climacs/ttcn3-syntax.lisp:1.1 Mon May 23 03:00:24 2005 +++ climacs/ttcn3-syntax.lisp Thu May 26 10:31:53 2005 @@ -119,10 +119,12 @@ (make-instance 'identifier)) (t (fo) (make-instance 'other-entry)))))))))
-(define-syntax ttcn3-syntax ("TTCN3" (basic-syntax)) +(define-syntax ttcn3-syntax (basic-syntax) ((lexer :reader lexer) (valid-parse :initform 1) - (parser))) + (parser)) + (:name "TTCN3") + (:pathname-types "ttcn" "ttcn3"))
(defparameter *ttcn3-grammar* (grammar))