[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Fri Apr 27 21:39:24 UTC 2007
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv19821
Modified Files:
packages.lisp climacs.asd
Added Files:
c-syntax.lisp c-syntax-commands.lisp
Log Message:
Added splittist's in-progress (but very screenshotable!) C syntax
module.
--- /project/climacs/cvsroot/climacs/packages.lisp 2006/11/12 21:07:59 1.122
+++ /project/climacs/cvsroot/climacs/packages.lisp 2007/04/27 21:39:23 1.123
@@ -149,6 +149,16 @@
:drei-syntax :flexichain :drei :drei-fundamental-syntax)
(:export))
+(defpackage :climacs-c-syntax
+ (:use :clim-lisp :clim :clim-extensions :drei-buffer :drei-base
+ :drei-syntax :drei-fundamental-syntax :flexichain :drei
+ :drei-motion :drei-editing :esa-utils :esa :drei-core :esa-io
+ :drei-lr-syntax)
+ (:shadow clim:form)
+ (:export #:c-syntax)
+ (:documentation "Implementation of the syntax module used for
+editing C code."))
+
(defpackage :climacs
(:use :clim-lisp :clim :clim-sys :clim-extensions :climacs-gui :drei)
(:export #:climacs
--- /project/climacs/cvsroot/climacs/climacs.asd 2007/01/17 12:21:29 1.58
+++ /project/climacs/cvsroot/climacs/climacs.asd 2007/04/27 21:39:23 1.59
@@ -41,6 +41,8 @@
(:file "ttcn3-syntax" :depends-on ("packages"))
(:file "climacs-lisp-syntax" :depends-on ("core" #+nil groups))
(:file "climacs-lisp-syntax-commands" :depends-on ("climacs-lisp-syntax" "misc-commands"))
+ (:file "c-syntax" :depends-on ("core"))
+ (:file "c-syntax-commands" :depends-on ("c-syntax" "misc-commands"))
(:file "gui" :depends-on ("packages" "text-syntax"))
(:file "core" :depends-on ("gui"))
(:file "io" :depends-on ("packages" "gui"))
--- /project/climacs/cvsroot/climacs/c-syntax.lisp 2007/04/27 21:39:24 NONE
+++ /project/climacs/cvsroot/climacs/c-syntax.lisp 2007/04/27 21:39:24 1.1
;; -*- Mode: Lisp; Package: CLIMACS-C-SYNTAX -*-
;;; (c) copyright 2005 by
;;; Robert Strandh (strandh at labri.fr)
;;; (c) copyright 2006 by
;;; Troels Henriksen (athas at sigkill.dk)
;;; (c) copyright 2007 by
;;; John Q Splittist (splittist at gmail.com)
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
;;; Syntax module for analysing C
(in-package :climacs-c-syntax)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The command table.
(define-syntax-command-table c-table
:errorp nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; the syntax object
(define-syntax c-syntax (lr-syntax-mixin fundamental-syntax)
()
(:name "C")
(:pathname-types "c" "h")
(:command-table c-table)
(:default-initargs :initial-state |initial-state |))
(defmethod name-for-info-pane ((syntax c-syntax) &key pane)
(declare (ignore pane))
(format nil "C"))
(defmethod display-syntax-name ((syntax c-syntax)
(stream extended-output-stream) &key pane)
(declare (ignore pane))
(princ "C" stream))
;;; Lexing
(define-lexer-state lexer-preprocessor-state ()
()
(:documentation "In this state, the lexer is working inside a
preprocessing directive."))
(define-lexer-state lexer-escaped-preprocessor-state (lexer-preprocessor-state)
()
(:documentation "In this state, the lexer is working inside a
preprocessing directive and an escaped newline has been seen."))
(define-lexer-state lexer-string-state ()
()
(:documentation "In this state, the lexer is working inside a string
delimited by double quote characters."))
(define-lexer-state lexer-line-comment-state ()
()
(:documentation "In this state, the lexer is working inside a line
comment starting with //."))
(define-lexer-state lexer-long-comment-state ()
()
(:documentation "In this state, the lexer is working inside a long
comment delimited by /* and */."))
(define-lexer-state lexer-character-state ()
()
(:documentation "In this state, the lexer is working inside a
character constant delimited by single quote characters."))
(defclass c-nonterminal (nonterminal) ())
(defclass form (c-nonterminal) ())
(defclass complete-form-mixin () ())
(defclass incomplete-form-mixin () ())
(defclass comment (c-nonterminal) ())
(defclass line-comment (c-comment) ())
(defclass long-comment (c-comment) ())
(defclass preprocessor-directive (c-nonterminal) ())
(defclass error-symbol (c-nonterminal) ())
(defclass c-lexeme (lexeme)
((ink)
(face)))
(defclass form-lexeme (form c-lexeme) ())
(defclass keyword-lexeme (form-lexeme) ())
(defclass storage-class-specifier () ())
(defclass type-specifier () ())
(defclass type-qualifier () ())
(defclass function-specifier () ())
(defclass operator () ())
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun spelling-to-symbol (name)
(intern (concatenate 'string name "-LEXEME") #.*package*)))
(defmacro define-keywords (&rest keyword-names)
`(progn
,@(loop for (name . supers) in keyword-names
for real-name = (spelling-to-symbol name)
collecting `(defclass ,real-name (,@ supers keyword-lexeme) ())
into defclasses
collecting name into names
finally (return (cons `(defparameter *keyword-spellings* ',names)
defclasses)))))
(define-keywords
("auto" storage-class-specifier)
("break" operator)
("case" operator)
("char" type-specifier)
("const" type-qualifier)
("continue" operator)
("default" operator)
("do" operator)
("double" type-specifier)
("else" operator)
("enum" type-specifier)
("extern" storage-class-specifier)
("float" type-specifier)
("for" operator)
("goto" operator)
("if" operator)
("inline" function-specifier)
("int" type-specifier)
("long" type-specifier)
("register" storage-class-specifier)
("restrict" type-qualifier)
("return" operator)
("short" type-specifier)
("signed" type-specifier)
("sizeof" operator)
("static" storage-class-specifier)
("struct" type-specifier)
("switch" operator)
("typedef" storage-class-specifier)
("union" type-specifier)
("unsigned" type-specifier)
("void" type-specifier)
("volatile" type-qualifier)
("while" operator)
("_Bool" type-specifier)
("_Complex" type-specifier)
("_Imaginary" type-specifier))
(defclass identifier-lexeme (form-lexeme) ())
(defclass constant-lexeme (form-lexeme) ())
(defclass string-literal-lexeme (form-lexeme) ())
(defclass punctuator-lexeme (form-lexeme) ())
#|
[ ] ( ) { } . ->
++ -- & * + - ~ !
/ % << >> < > <= >= == != ^ | && ||
? : ; ...
= *= /= %= += -= <<= >>= &= ^= |=
, # ##
<: :> <% %> %: %:%:
|#
(defmacro define-punctuators (&rest punctuator-names)
`(progn
,@(loop for name in punctuator-names
for real-name =
(intern (concatenate 'string
(string name) "-LEXEME")
#.*package*)
collecting `(defclass ,real-name (punctuator-lexeme) ()))))
(define-punctuators
;; left-bracket right-bracket left-parenthesis
;; right-parenthesis left-brace right-brace
dot dereference
increment decrement ampersand asterisk plus minus tilde
exclamation slash percent left-shift right-shift
left-angle-bracket right-angle-bracket leq geq eq neq
circumflex pipe and-and or-or question colon semi-colon ellipsis
equal asterisk-equal slash-equal percent-equal plus-equal minus-equal
left-shift-equal right-shift-equal ampersand-equal circumflex-equal
pipe-equal comma hash hash-hash)
(defclass delimiter-mixin () ())
(defclass opening-delimiter-mixin (delimiter-mixin) ())
(defclass closing-delimiter-mixin (delimiter-mixin) ())
(defclass left-bracket-lexeme (punctuator-lexeme opening-delimiter-mixin) ())
(defclass right-bracket-lexeme (punctuator-lexeme closing-delimiter-mixin) ())
(defclass left-parenthesis-lexeme (punctuator-lexeme opening-delimiter-mixin) ())
(defclass right-parenthesis-lexeme (punctuator-lexeme closing-delimiter-mixin) ())
(defclass left-brace-lexeme (punctuator-lexeme opening-delimiter-mixin) ())
(defclass right-brace-lexeme (punctuator-lexeme closing-delimiter-mixin) ())
(defclass integer-constant-lexeme (constant-lexeme) ())
(defclass floating-constant-lexeme (constant-lexeme) ())
;; (defclass enumeration-constant-lexeme (constant-lexeme) ())
;; (defclass character-constant-lexeme (constant-lexeme) ())
(defclass error-lexeme (c-lexeme) ())
(defclass line-comment-start-lexeme (c-lexeme) ())
(defclass long-comment-start-lexeme (c-lexeme) ())
(defclass comment-end-lexeme (c-lexeme) ())
(defclass string-start-lexeme (c-lexeme) ())
(defclass wide-string-start-lexeme (c-lexeme) ())
(defclass string-end-lexeme (c-lexeme) ())
(defclass preprocessor-start-lexeme (c-lexeme) ())
(defclass preprocessor-end-lexeme (c-lexeme) ())
(defclass escaped-newline-lexeme (c-lexeme) ())
(defclass word-lexeme (c-lexeme) ())
(defclass delimiter-lexeme (c-lexeme) ())
(defclass text-lexeme (c-lexeme) ())
(defclass character-start-lexeme (c-lexeme) ())
(defclass wide-character-start-lexeme (c-lexeme) ())
(defclass character-end-lexeme (c-lexeme) ())
(defun alpha-or-underscore-p (ch)
(and (characterp ch)
(or (alpha-char-p ch)
(char= ch #\_))))
;; todo - other chars in identifiers etc.
(defun c-constituentp (ch)
(and (characterp ch)
(or (alphanumericp ch)
(char= ch #\_))))
(defmethod skip-inter ((syntax c-syntax) state scan)
(macrolet ((fo () `(forward-object scan)))
(loop when (end-of-buffer-p scan)
do (return nil)
until (not (whitespacep syntax (object-after scan)))
do (fo)
finally (return t))))
(defmethod lex ((syntax c-syntax) (state lexer-toplevel-state) scan)
(macrolet ((fo () `(forward-object scan)))
(let ((object (object-after scan)))
(case object
(#\" (fo) (make-instance 'string-start-lexeme))
(#\' (fo) (make-instance 'character-start-lexeme))
(#\# (let ((bolp (beginning-of-line-p scan)))
(fo)
(if bolp
(make-instance 'preprocessor-start-lexeme)
(make-instance 'error-lexeme))))
(#\[ (fo) (make-instance 'left-bracket-lexeme))
(#\] (fo) (make-instance 'right-bracket-lexeme))
(#\( (fo) (make-instance 'left-parenthesis-lexeme))
(#\) (fo) (make-instance 'right-parenthesis-lexeme))
(#\{ (fo) (make-instance 'left-brace-lexeme))
(#\} (fo) (make-instance 'right-brace-lexeme))
(#\. (fo) (if (end-of-buffer-p scan)
(make-instance 'dot-lexeme)
(cond ((eql (object-after scan) #\.)
(fo)
(cond ((or (end-of-buffer-p scan)
(not (eql (object-after scan) #\.)))
(backward-object scan)
(make-instance 'dot-lexeme))
(t (fo) (make-instance 'ellipsis-lexeme))))
((and (characterp (object-after scan))
(digit-char-p (object-after scan)))
(backward-object scan)
(lex-token syntax scan))
(t (make-instance 'dot-lexeme)))))
(#\- (fo) (if (end-of-buffer-p scan)
(make-instance 'minus-lexeme)
(case (object-after scan)
(#\- (fo) (make-instance 'decrement-lexeme))
(#\= (fo) (make-instance 'minus-equal-lexeme))
(#\> (fo) (make-instance 'dereference-lexeme))
(t (make-instance 'minus-lexeme)))))
(#\+ (fo) (if (end-of-buffer-p scan)
(make-instance 'plus-lexeme)
(case (object-after scan)
(#\+ (fo) (make-instance 'increment-lexeme))
(#\= (fo) (make-instance 'plus-equal-lexeme))
(t (make-instance 'plus-lexeme)))))
(#\& (fo) (if (end-of-buffer-p scan)
(make-instance 'ampersand-lexeme)
(case (object-after scan)
(#\& (fo) (make-instance 'and-and-lexeme))
(#\= (fo) (make-instance 'ampersand-equal-lexeme))
(t (make-instance 'ampersand-lexeme)))))
(#\* (fo) (if (end-of-buffer-p scan)
(make-instance 'asterisk-lexeme)
(cond ((eql (object-after scan) #\=)
(fo)
(make-instance 'asterisk-equal-lexeme))
(t (make-instance 'asterisk-lexeme)))))
(#\~ (fo) (make-instance 'tilde-lexeme))
(#\! (fo) (if (end-of-buffer-p scan)
(make-instance 'exclamation-lexeme)
(cond ((eql (object-after scan) #\=)
(fo)
(make-instance 'neq-lexeme))
(t (make-instance 'exclamation-lexeme)))))
(#\/ (fo) (if (end-of-buffer-p scan)
(make-instance 'slash-lexeme)
(case (object-after scan)
(#\= (fo) (make-instance 'slash-equal-lexeme))
(#\* (fo) (make-instance 'long-comment-start-lexeme))
(#\/ (fo) (make-instance 'line-comment-start-lexeme))
(t (make-instance 'slash-lexeme)))))
(#\% (fo) (if (end-of-buffer-p scan)
(make-instance 'percent-lexeme)
(case (object-after scan)
(#\= (fo) (make-instance 'percent-equal-lexeme))
(#\> (fo) (make-instance 'right-brace-lexeme))
(#\: (fo)
(cond ((eql (object-after scan) #\%)
(fo)
(cond ((eql (object-after scan) #\:)
(make-instance 'hash-hash-lexeme))
(t
(backward-object scan)
(make-instance 'preprocessor-start-lexeme))))
(t (make-instance 'preprocessor-start-lexeme
))))
(t (make-instance 'percent-lexeme)))))
(#\< (fo) (if (end-of-buffer-p scan)
(make-instance 'left-angle-bracket-lexeme)
(case (object-after scan)
(#\= (fo) (make-instance 'leq-lexeme))
(#\: (fo) (make-instance 'left-bracket-lexeme))
(#\% (fo) (make-instance 'left-brace-lexeme))
(#\< (fo)
(cond ((eql (object-after scan) #\=)
(fo)
(make-instance 'left-shift-equal-lexeme))
(t (make-instance 'left-shift-lexeme))))
(t (make-instance 'left-angle-bracket-lexeme)))))
(#\> (fo) (if (end-of-buffer-p scan)
(make-instance 'right-angle-bracket-lexeme)
(case (object-after scan)
(#\= (fo) (make-instance 'geq-lexeme))
(#\> (fo)
(cond ((eql (object-after scan) #\=)
(fo)
(make-instance 'right-shift-equal-lexeme))
(t (make-instance 'right-shift-lexeme))))
(t (make-instance 'right-angle-bracket-lexeme)))))
(#\= (fo) (if (end-of-buffer-p scan)
(make-instance 'equal-lexeme)
(cond ((eql (object-after scan) #\=)
(fo)
(make-instance 'eq-lexeme))
(t (make-instance 'equal-lexeme)))))
(#\^ (fo) (if (end-of-buffer-p scan)
(make-instance 'circumflex-lexeme)
(cond ((eql (object-after scan) #\=)
(fo)
(make-instance 'circumflex-equal-lexeme))
(t (make-instance 'circumflex-lexeme)))))
(#\| (fo) (if (end-of-buffer-p scan)
(make-instance 'pipe-lexeme)
(case (object-after scan)
(#\| (fo) (make-instance 'or-or-lexeme))
(#\= (fo) (make-instance 'pipe-equal-lexeme))
(t (make-instance 'pipe-lexeme)))))
(#\? (fo) (make-instance 'question-lexeme))
(#\: (fo) (if (end-of-buffer-p scan)
(make-instance 'colon-lexeme)
(cond ((eql (object-after scan) #\>)
(fo)
(make-instance 'right-bracket-lexeme))
(t (make-instance 'colon-lexeme)))))
[986 lines skipped]
--- /project/climacs/cvsroot/climacs/c-syntax-commands.lisp 2007/04/27 21:39:24 NONE
+++ /project/climacs/cvsroot/climacs/c-syntax-commands.lisp 2007/04/27 21:39:24 1.1
[1130 lines skipped]
More information about the Climacs-cvs
mailing list