casl-mode.el revision b66e97d7d836d878bbaf31abc81c3b88bd3397f6
55cf6e01272ec475edea32aa9b7923de2d36cb42Christian Maeder;;;###autoload
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(autoload 'turn-on-casl-indent "casl-indent" "Turn on CASL indentation." t)
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens Elkner
e071fb22ea9923a2a4ff41184d80ca46b55ee932Till Mossakowski;; Version number
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(defconst casl-mode-version "0.2"
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu Prodescu "Version of CASL-Mode")
2eeec5240b424984e3ee26296da1eeab6c6d739eChristian Maeder
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(defgroup casl nil
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski "Major mode for editing (heterogeneous) CASL programs."
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski :group 'languages
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder :prefix "casl-")
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(defvar casl-mode-hook nil)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(defvar casl-mode-map (let ((keymap (make-keymap)))
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (define-key keymap "\C-c\C-c" 'comment-region)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (define-key keymap "\C-c\C-r" 'casl-run-hets-r)
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder (define-key keymap "\C-c\C-g" 'casl-run-hets-g)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (define-key keymap "\C-c\C-n" 'casl-compile-goto-next-error)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski keymap)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski "Keymap for CASL major mode")
b565cd55a13dbccc4e66c344316da525c961e4caTill Mossakowski
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder;; Are we running FSF Emacs or XEmacs?
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(defvar casl-running-xemacs
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder (string-match "Lucid\\|XEmacs" emacs-version)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski "non-nil if we are running XEmacs, nil otherwise.")
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder;; ====================== S Y N T A X T A B L E ==================
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder;; Syntax table for CASL major mode
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder(defvar casl-mode-syntax-table nil
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder "Syntax table for CASL mode.")
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder(if casl-mode-syntax-table
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder ()
51a666669b5ab3963613f3e331633b7913833027mscodescu (let ((table (make-syntax-table)))
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder ;; Indicate that underscore may be part of a word
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (modify-syntax-entry ?_ "w" table)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (modify-syntax-entry ?\t " " table)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (modify-syntax-entry ?\" "\"" table)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (modify-syntax-entry ?\' "\'" table)
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder ;; Commnets
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder (if casl-running-xemacs
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski ((modify-syntax-entry ?% ". 58" table)
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder (modify-syntax-entry ?\[ "(] 6" table)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (modify-syntax-entry ?\] ")[ 7" table))
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (modify-syntax-entry ?% ". 14nb" table)
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder (modify-syntax-entry ?\[ "(] 2n" table)
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder (modify-syntax-entry ?\] ")[ 3n" table))
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder ;; commenting-out plus including other kinds of comment
a65c6747c9acbbebc93baba7bae94d2e3d8cdafbTill Mossakowski (modify-syntax-entry ?\( "()" table)
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder (modify-syntax-entry ?\) ")(" table)
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder (modify-syntax-entry ?{ "(}" table)
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder (modify-syntax-entry ?} "){" table)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (mapcar (lambda (x)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (modify-syntax-entry x "_" table))
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski ;; Some of these are actually OK by default.
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder "!#$&*+.,/\\\\:<=>?@^|~()[]{}")
f7d2e793728bbb7fd185e027eb9dfd7b9dd11c21Christian Maeder (setq casl-mode-syntax-table table))
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder )
f7d2e793728bbb7fd185e027eb9dfd7b9dd11c21Christian Maeder
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder;; Various mode variables.
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder(defun casl-vars ()
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder (kill-all-local-variables)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder (make-local-variable 'comment-start)
f7d2e793728bbb7fd185e027eb9dfd7b9dd11c21Christian Maeder (setq comment-start "%[")
f7d2e793728bbb7fd185e027eb9dfd7b9dd11c21Christian Maeder (make-local-variable 'comment-padding)
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich (setq comment-padding 0)
f7d2e793728bbb7fd185e027eb9dfd7b9dd11c21Christian Maeder (make-local-variable 'comment-start-skip)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (setq comment-start-skip "%[%{[] *")
51a666669b5ab3963613f3e331633b7913833027mscodescu (make-local-variable 'comment-column)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (setq comment-column 40)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (make-local-variable 'comment-indent-function)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (setq comment-indent-function 'casl-comment-indent)
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich (make-local-variable 'comment-end)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski (setq comment-end "]%"))
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder;; Find the indentation level for a comment.
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(defun casl-comment-indent ()
fbf1cdad9a9775bd7332e85f01b6a307d7dbb1cfChristian Maeder (skip-chars-backward " \t")
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder ;; if the line is blank, put the comment at the beginning,
d6c6b2543c509ec7f6213e4cba675d96304a7fd6Christian Maeder ;; else at comment-column
d6c6b2543c509ec7f6213e4cba675d96304a7fd6Christian Maeder (if (bolp) 0 (max (1+ (current-column)) comment-column)))
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski;; ============= K E Y W O R D H I G H L I G H T I N G ============
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(defface casl-black-komma-face
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski `((t (:foreground "black")))
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder ""
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski :group 'basic-faces)
4aa35aadcb28f8a962096efc70d3bdb58ab7d9faChristian Maeder(defvar casl-black-komma-face 'casl-black-komma-face
4aa35aadcb28f8a962096efc70d3bdb58ab7d9faChristian Maeder "Face name to use for black komma.")
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder(defvar casl-annotation-face 'casl-annotation-face
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder "CASL mode face for Annotations")
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder(setq casl-annotation-face 'font-lock-constant-face)
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder(defvar casl-name-face 'casl-name-face)
fbf1cdad9a9775bd7332e85f01b6a307d7dbb1cfChristian Maeder(setq casl-name-face 'font-lock-variable-name-face)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder(defvar casl-keyword-face 'casl-keyword-face)
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski(setq casl-keyword-face 'font-lock-keyword-face)
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder(defvar casl-library-name-face 'casl-library-name-face)
b565cd55a13dbccc4e66c344316da525c961e4caTill Mossakowski(setq casl-library-name-face 'font-lock-type-face)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder(defvar casl-builtin-face 'casl-builtin-face)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder(setq casl-builtin-face 'font-lock-builtin-face)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder(defvar casl-comment-face 'casl-comment-face)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder(setq casl-comment-face 'font-lock-comment-face)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder(defvar casl-other-name-face 'casl-other-name-face)
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder(setq casl-other-name-face 'font-lock-function-name-face)
1dfd1687e9ee6a45e2cb5268a701ead79c1c1f79Christian Maeder
1dfd1687e9ee6a45e2cb5268a701ead79c1c1f79Christian Maeder(defvar casl-string-char-face 'casl-string-char-face)
1dfd1687e9ee6a45e2cb5268a701ead79c1c1f79Christian Maeder(setq casl-string-char-face 'font-lock-string-face)
549e39da3e3234118ed35cbe11de91ee3fc62934Christian Maeder
fbf1cdad9a9775bd7332e85f01b6a307d7dbb1cfChristian Maeder;; Syntax highlighting of CASL
549e39da3e3234118ed35cbe11de91ee3fc62934Christian Maeder(defconst casl-font-lock-keywords
549e39da3e3234118ed35cbe11de91ee3fc62934Christian Maeder (list
549e39da3e3234118ed35cbe11de91ee3fc62934Christian Maeder ;; Keywords of loading Library
549e39da3e3234118ed35cbe11de91ee3fc62934Christian Maeder '("\\(\\<\\|\\s-+\\)\\(logic\\|from\\|get\\|library\\|version\\)[ :\t\n]+"
549e39da3e3234118ed35cbe11de91ee3fc62934Christian Maeder (2 casl-builtin-face keep t))
549e39da3e3234118ed35cbe11de91ee3fc62934Christian Maeder;; '("\\(\\<\\|\\s-+\\)\\(%authors\\|%date\\|%display\\|%prec\\|%left_assoc\\|%number\\|%floating\\|%LATEX\\|%implies\\)[ :\t\n]+"
b565cd55a13dbccc4e66c344316da525c961e4caTill Mossakowski;; (2 casl-annotation-face keep t))
b565cd55a13dbccc4e66c344316da525c961e4caTill Mossakowski ;; Library and Logic name
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski '("\\(\\<\\|\\s-+\\)\\(library\\|logic\\)\\s-+\\(\\(\\w\\|/\\)+\\)[ \t\n]*"
179581802dda2f071129f542a2c10e28b35c45b9Christian Maeder (3 casl-library-name-face keep t))
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski ;; name of from, get and given
ab419eb9bb19c32515fb35793f1192a86c74712eTill Mossakowski '("\\(\\<\\|[ \t]+\\)\\(get\\|given\\)[ \t\n]+\\(\\(\\sw+\\s-*\\(,[ \t\n]*\\|$\\)\\)+\\)\\(=\\|:\\|$\\)"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (3 casl-name-face t t))
cdcf5d3f1e79d8798d77efa29e6193af94ea0604Till Mossakowski '("\\(\\<\\|\\s-+\\)from[ \t]+\\(.+\\)\\(get\\|$\\)"
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder (2 casl-library-name-face keep t))
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder ;; after forall don't highlight
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder '("\\bforall\\b\\(.*\\)"
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder (1 casl-black-komma-face t t))
4aa35aadcb28f8a962096efc70d3bdb58ab7d9faChristian Maeder ;; the name of specification and view
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder '("\\(\\<\\|\\[\\)\\(spec\\|view\\)\\s-+\\(\\w+\\)[ \t]*\\(\\[\\s-*\\([A-Z]\\w*\\).*\\s-*\\]\\)?\\s-*.*\\([]=:]\\|::=\\)"
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder (3 casl-name-face keep t) (5 casl-name-face keep t))
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder ;; then, and + name
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder '("\\(\\<\\|\\s-+\\)\\(and\\|then\\)[ \t\n]*\\([A-Z]\\w*\\)\\s-*\\(\\[\\([A-Z]\\sw*\\).*\\]\\)?"
71bf376677866b4735ae3c13ee08a863d25c1188Christian Maeder (3 casl-name-face keep t) (5 casl-name-face keep t))
;; names before and after to
'("[ \t\n]*\\(\\sw+\\)[ \t\n]+to[ \t\n]+\\(\\(\\sw+\\)\\s-*\\(\\[\\([A-Z]\\sw*\\).*\\]\\)?[, \t]*\\)?"
(1 casl-name-face keep t) (3 casl-name-face keep t) (5 casl-name-face keep t))
;; instance name of specification
'("\\<spec.+=\\s-*\\(%\\sw+\\s-*\\)?[ \t\n]*\\([A-Z]\\w*\\)\\s-*\\(\\[\\s-*\\([A-Z]\\w*\\).*\\s-*\\]\\)?"
(2 casl-name-face keep t) (4 casl-name-face keep t))
;; Basic signature: sort X, Y, Z
'("\\(\\<\\|\\s-+\\)sorts?[ \t\n]+\\(\\(\\sw+\\s-*\\(\\[\\s-*\\(\\sw\\|,\\)+\\s-*\\]\\s-*\\)?\\(,\\(\\s-\\)*\\|$\\|<\\|;\\|=\\)\\(=\\|<\\|;\\|,\\)*[ \t\n]*\\)+\\)"
(2 casl-other-name-face keep t))
;; Basic signature: op ,pred and var name
'("\\(\\(^[^.{%]\\)\\s-*\\|\\bops?\\b\\|\\bpreds?\\b\\|\\bvars?\\b\\)\\([^:{()]*\\)\\(\(.*\)\\)?:\\??[^?.:=%].*;?[ \t]*$"
(2 casl-other-name-face keep t) (3 casl-other-name-face keep t))
;; highlight a line with , an end
'("^\\(\\(\\(__\\s-*[^_\n]+\\s-*__\\|[^.,:\n]+\\)\\s-*,\\s-*\\)+\\)$"
(0 casl-other-name-face keep t))
;; names before and after '|->'
'("[ \t\n]*\\(__[^|_]+__\\|[^[ \t\n]+\\)\\s-*\\(\\[\\([A-Z]\\w*\\).*\\]\\)?[ \t\n]*|->[ \t\n]*\\(__[^|_]+__\\|[^[ \t\n]+\\)\\s-*\\(\\[\\([A-Z]\\w*\\).*\\]\\)?[, \t]*"
(1 casl-other-name-face keep t) (3 casl-other-name-face keep t)
(4 casl-other-name-face keep t) (6 casl-other-name-face keep t))
;; type name
'("\\(\\btype\\|\\bfree type\\)?\\s-+\\(\\sw+\\)\\s-+\\(\\sw*\\|\\[\\(\\s-*\\sw+\\s-*\\)\\]\\)[ \t\n]*::?=[ \t\n]*\\(\\(\_\_[^_]+\_\_\\|[^|][^(|]+\\)\\s-*\\(\(.*\)\\)?\\)"
(2 casl-other-name-face keep t) (4 casl-other-name-face keep t)
(6 casl-other-name-face keep t))
;; constructor
'("\|\\s-+\\(\_\_[^|_]+\_\_\\|[^|][^(|]+\\)\\s-*\\(\([^|]+\)\\)?[ \t\n]*"
(1 casl-other-name-face keep t))
;; in ()1
'("\(\\(\\(\\sw\\|,\\)*\\)\\s-*:\\??[^)]*\)"
(1 casl-other-name-face keep t))
;; in ()2
'("\([^;]*;\\s-*\\(\\sw+\\)\\s-*:\\??.*\)"
(1 casl-other-name-face keep t))
;; reserved keyword
'("\\(\\<\\|\\s-+\\)\\(/\\\\\\|\\\\/\\|=>\\|<=>\\|and\\|arch\\|assoc\\|behaviourally\\|closed\\|comm\\|else\\|end\\|exists\\|fit\\|forall\\|free\\|generated\\|given\\|hide\\|idem\\|if\\|local\\|not\\|refined\\|refinement\\|reveal\\|spec\\|then\\|to\\|unit\\|via\\|view\\|when\\|within\\|with\\|\\(\\(op\\|pred\\|var\\|type\\|sort\\)s?\\)\\)[,;]?[ \t\n]"
(2 casl-keyword-face t t))
'("[][,;.]" (0 casl-black-komma-face t t))
)
"Reserved keywords highlighting")
;; String and Char
(defconst casl-font-lock-string
(append casl-font-lock-keywords
(list '("\\(\\(\"\\|^>[ \t]*\\\\\\)\\([^\"\\\\\n]\\|\\\\.\\)*\\(\"\\|\\\\[ \t]*$\\)\\|'\\([^'\\\\\n]\\|\\\\.[^'\n]*\\)'\\)" (0 casl-string-char-face t t))
))
"Syntax highlighting of String and Char")
;; Alternativ for Annotation
(defconst casl-font-lock-annotations
(append casl-font-lock-string
(list
;; %word(...)\n
'("%\\sw+\([^%\n]+\)$" (0 casl-annotation-face t t))
;; %word{...}\n
'("%\\sw+{[^%\n]+}$" (0 casl-annotation-face t t))
;; %words \n
'("%\\w+[^\n]*$" (0 casl-annotation-face t t))
;; %( ... )%
'("%\(\\([^%]\\|[\t\n]\\)*\)%[ \t\n]*" (0 casl-annotation-face t t))
;; %{ ... }%
'("%{\\(.\\|[\t\n]\\)*}%[ \t\n]*" (0 casl-annotation-face t t))
;; %[ ... ]%
'("%\\[\\(.\\|[\t\n]\\)*\\]%[ \t\n]*" (0 casl-annotation-face t t))
;; %word( ... )%
'("%\\sw+\(\\(.\\|[\t\n]\\)*\)%[ \t\n]*" (0 casl-annotation-face t t))
;; %word{ ... }%
'("%\\sw+{\\(.\\|[\t\n]\\)*}%[ \t\n]*" (0 casl-annotation-face t t))
;; %word[ ... ]%
'("%\\sw+\\[\\(.\\|[\t\n]\\)*\\]%[ \t\n]*" (0 casl-annotation-face t t))
))
"Annotation")
;; Comment
(defconst casl-font-lock-specialcomment
(append casl-font-lock-annotations
(list '("\\(%%.*$\\)" (0 casl-comment-face t t))
'("\\(%{\\(.\\|[\t\n]\\)*}%\\)[ \t\n]*" (1 casl-comment-face t t))
))
"Special Comment")
;; Define default highlighting level
;; (defvar casl-font-lock-syntax-highligthing casl-font-lock-keywords
(defvar casl-font-lock-syntax-highligthing casl-font-lock-specialcomment
"Default syntax highlighting level in CASL mode")
;; ======================= R U N H E T S =======================
(require 'compile)
(setq casl-error-list nil)
(defvar hets-program nil)
(defvar old-buffer nil)
(defvar casl-hets-options '()
"*the options of run hets.")
(defun casl-run-hets (&rest opt)
"Run hets process to compile the current CASL file."
(interactive)
(save-buffer nil)
(setq old-buffer (current-buffer))
(let* ((option " ")
(casl-hets-file-name (buffer-file-name))
(outbuf (get-buffer-create "*hets-run*")))
(if hets-program
(setq casl-hets-program hets-program)
(setq casl-hets-program "hets"))
(if opt
(dolist (current opt option)
(setq option (concat option current " "))))
(setq hets-command (concat casl-hets-program option casl-hets-file-name))
;; Pop up the compilation buffer.
(set-buffer outbuf)
(setq buffer-read-only nil)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(buffer-enable-undo (current-buffer))
(set-buffer-modified-p nil)
(insert hets-command "\n")
(pop-to-buffer outbuf)
(goto-char (point-max))
;; (display-buffer outbuf nil t)
(save-excursion
;; (set-buffer outbuf)
(compilation-mode "hets-compile")
;; Start the compilation.
(if (fboundp 'start-process)
(let* ((process-environment
(append
(if (and (boundp 'system-uses-terminfo)
system-uses-terminfo)
(list "TERM=dumb" "TERMCAP="
(format "COLUMNS=%d" (window-width)))
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:"
(window-width))))
;; Set the EMACS variable, but
;; don't override users' setting of $EMACS.
(if (getenv "EMACS")
process-environment
(cons "EMACS=t" process-environment))))
(proc (start-process-shell-command "hets-compile" outbuf
hets-command)))
(setq buffer-read-only nil)
(set-process-sentinel proc 'casl-compilation-sentinel)
(set-process-filter proc 'casl-compilation-filter)
(set-marker (process-mark proc) (point) outbuf))
))
(pop-to-buffer old-buffer)))
(defun casl-run-hets-r (&rest opt)
"Run hets process with options (from casl-hets-options) to compile the
current CASL file."
(interactive)
(setq option1 nil)
(setq option2 nil)
(if casl-hets-options
(dolist (current casl-hets-options option1)
(setq option1 (concat option1 current " ")))
)
(if opt
(dolist (current opt option2)
(setq option2 (concat option2 current " ")))
)
(setq option (concat option1 " " option2))
(casl-run-hets option)
)
(defun casl-run-hets-g ()
"Run hets process with -g and other options (from variable casl-hets-options)
to compile the current CASL file."
(interactive)
(casl-run-hets-r "-g")
)
;; sentinel and filter of asynchronous process of hets
;; Called when compilation process changes state.
(defun casl-compilation-sentinel (proc msg)
"Sentinel for compilation buffers."
(let ((buffer (process-buffer proc)))
(if (memq (process-status proc) '(signal exit))
(progn
(if (null (buffer-name buffer))
;; buffer killed
(set-process-buffer proc nil)
(let ((obuf (current-buffer)))
;; save-excursion isn't the right thing if
;; process-buffer is current-buffer
(unwind-protect
(progn
;; Write something in the compilation buffer
;; and hack its mode line.
(set-buffer buffer)
(casl-compilation-handle-exit (process-status proc)
(process-exit-status proc)
msg)
;; Since the buffer and mode line will show that the
;; process is dead, we can delete it now. Otherwise it
;; will stay around until M-x list-processes.
(delete-process proc))
(set-buffer obuf))))
;; (setq compilation-in-progress (delq proc compilation-in-progress))
))))
;; show the message from hets compile direct on *hets-run* buffer
(defun casl-compilation-filter (proc string)
(display-buffer (process-buffer proc))
(unless (equal (buffer-name) "*hets-run*")
(progn
(pop-to-buffer "*hets-run*")
(goto-char (point-max))
))
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
(save-excursion
;; Insert the text, advancing the process marker.
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc)))))
(pop-to-buffer old-buffer))
(defun casl-compilation-handle-exit (process-status exit-status msg)
"Write msg in the current buffer and hack its mode-line-process."
(let ((buffer-read-only nil)
(status (cons msg exit-status))
(omax (point-max))
(opoint (point)))
;; Record where we put the message, so we can ignore it
;; later on.
;; (goto-char omax)
(goto-char (point-max))
(insert ?\n mode-name " " (car status))
(if (bolp)
(forward-char -1))
(insert " at " (substring (current-time-string) 0 19))
(goto-char (point-max))
(setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
;; Force mode line redisplay soon.
(force-mode-line-update)
(if (and opoint (< opoint omax))
(goto-char opoint))
;; Automatically parse (and mouse-highlight) error messages:
(if (zerop exit-status)
(setq casl-error-list nil)
(setq casl-error-list nil)
(casl-parse-error)
(message "%s errors have been found." (length casl-error-list)))
(pop-to-buffer old-buffer)
))
;; also functions with old hets-program?
(defun casl-parse-error ()
"Error Parser"
(interactive)
(setq casl-error-list nil)
;;;(pop-to-buffer compiler-buffer)
(pop-to-buffer "*hets-run*")
(goto-char (point-min))
(while (not (eobp))
(if (not (or (looking-at "Fail") (looking-at "\\*\\*\\*")))
(forward-line 1)
(skip-chars-forward "a-zA-Z*,/._\\- ")
(if (not (search-forward ":" (save-excursion (end-of-line) (point)) t 1))
(forward-line 1)
(re-search-backward "\\(\(\\|\\s-+\\)\\([^.]+\\.\\(casl\\|het\\)\\)" nil t 1)
(setq file-name (match-string-no-properties 2))
(re-search-forward ":\\([0-9]+\\)\\.\\([0-9]+\\)\\(-[0-9]+\\.[0-9]*\\)?[:,]" (save-excursion (end-of-line) (point)) t 1)
(when (not (string= (match-string-no-properties 0) ""))
(setq error-line (match-string-no-properties 1))
(setq error-colnum (match-string-no-properties 2))
(setq error-window-point (point))
(setq casl-error-list
(nconc casl-error-list (list (list file-name error-line error-colnum error-window-point))))
)
(forward-line 1)))))
(defun casl-compile-goto-next-error ()
"search the next error position from error-list, and move to it."
(interactive)
;; if error-list is empty ...
(if (null casl-error-list)
(casl-parse-error))
(if (null casl-error-list)
(if (member (get-buffer "*hets-run*") (buffer-list))
(message "no error.")
(message "this file have not yet been compiled."))
(let* ((this-error (pop casl-error-list))
(error-file-name (nth 0 this-error))
(error-line (nth 1 this-error))
(error-column (nth 2 this-error))
(error-window-point (nth 3 this-error)))
;; (message "DEBUG<Goto Error>: file: %s, line: %s, column: %s" error-file-name error-line error-column)
;; if the file already opened ...
(if (get-file-buffer error-file-name)
(pop-to-buffer (get-file-buffer error-file-name))
(generate-new-buffer error-file-name)
(pop-to-buffer error-file-name)
(insert-file-contents error-file-name))
;; switch to hets-run window to jump to next error message
(setq file-buffer (current-buffer))
(pop-to-buffer "*hets-run*")
(goto-char error-window-point)
;; return to current file
(pop-to-buffer file-buffer)
(goto-line (string-to-number error-line))
(move-to-column (- (string-to-number error-column) 1))
(message "goto next error... line: %s column: %s" error-line error-column)
(setq casl-error-list (nconc casl-error-list (list this-error)))
)))
;; ================= C A S L M A J O R M O D E ===============
;; casl major mode setup
;; Definition of CASL major mode
(defun casl-mode ()
"Major mode for editing CASL models"
(interactive)
(casl-vars)
(setq major-mode 'casl-mode)
(setq mode-name "CASL")
;; Load keymap
(use-local-map casl-mode-map)
;; Load syntax table
(set-syntax-table casl-mode-syntax-table)
;; (casl-create-syntax-table)
;; Highlight CASL keywords
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults
'(casl-font-lock-syntax-highligthing))
;; Support for compile.el
;; We just substitute our own functions to go to the error.
(add-hook 'compilation-mode-hook
(lambda()
(set (make-local-variable 'compile-auto-highlight) 40)
;; FIXME: This has global impact! -stef
(define-key compilation-minor-mode-map [mouse-2]
'casl-compile-mouse-goto-error)
(define-key compilation-minor-mode-map "\C-m"
'casl-compile-goto-next-error)))
(run-hooks 'casl-mode-hook)
)
(provide 'casl-mode)
;; CASL-mode ends here