climacs-cvs

Download

climacs-cvs@common-lisp.net

April 2007

1 participants
1 discussions

[climacs-cvs] CVS climacs
by thenriksen 27 Apr '07

27 Apr '07

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(a)labri.fr) ;;; (c) copyright 2006 by ;;; Troels Henriksen (athas(a)sigkill.dk) ;;; (c) copyright 2007 by ;;; John Q Splittist (splittist(a)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]

1 0