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