Commit 8d0ae3a0 authored by Christophe Rhodes's avatar Christophe Rhodes

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.
parent b331de64
......@@ -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)
......
......@@ -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)
......
......@@ -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"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
......
......@@ -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))
......
......@@ -39,6 +39,50 @@ the mark, according to the specified syntax."))
(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 @@ the mark, according to the specified syntax."))
(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 @@ the mark, according to the specified syntax."))
;;;
;;; 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))
......
......@@ -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)))
......
......@@ -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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment