[climacs-cvs] CVS update: climacs/cl-syntax.lisp climacs/gui.lisp climacs/html-syntax.lisp climacs/prolog-syntax.lisp climacs/syntax.lisp climacs/text-syntax.lisp climacs/ttcn3-syntax.lisp
Christophe Rhodes
crhodes at common-lisp.net
Thu May 26 08:31:57 UTC 2005
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 at 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 , at default-initargs)
+ , at 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))
More information about the Climacs-cvs
mailing list