Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

290 lines (250 sloc) 10.431 kb
; cg.el -- major mode for editing Constraint Grammar files
; See http://beta.visl.sdu.dk/constraint_grammar.html
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program 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 General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Author: Kevin Brubeck Unhammer <unhammer hos gmail punktum com>
;;; Usage:
;; (add-to-list 'load-path "/path/to/cg.el")
;; (require 'cg)
;;; I recommend using pabbrev-mode for tab-completion, and
;;; paredit-mode if you're used to it. However, if you have set names
;;; with hashes in them, like m#foo, paredit-mode may tell you that
;;; your parens are unbalenced since if you have it in a mode
;;; hook. The reason is that such exceptions to the rule that # starts
;;; a comment are handled in font-lock, and fontification happens
;;; after run-mode-hooks. To get paredit-mode to turn on automatically
;;; in cg-mode, you could use this hack:
;; (add-hook 'cg-mode-hook
;; (lambda nil
;; (run-with-idle-timer 1 nil (lambda nil (paredit-mode 1)))))
;;; sh-mode has the same problem, so I don't feel up to fixing it...
;;; TODO:
;;; - different syntax highlighting for sets and tags (difficult)
;;; - use something like prolog-clause-start to define M-a/e etc.
;;; - run vislcg3 --show-unused-sets and buttonise with line numbers (like Occur does)
;;; - indentation function (based on prolog again?)
;;; - the rest of the keywords
;;; - keyword tab-completion
(defconst cg-version "2010-03-04" "Version of cg-mode")
;;;============================================================================
;;;
;;; Define the formal stuff for a major mode named cg.
;;;
(defvar cg-mode-map (make-sparse-keymap)
"Keymap for cg minor mode.")
(defgroup cg nil
"Major mode for editing VISL CG-3 Constraint Grammar files."
:tag "CG"
:group 'languages)
(defcustom cg-indentation 8
"The width for indentation in Constraint Grammar mode."
:type 'integer
:group 'cg)
(put 'cg-indentation 'safe-local-variable 'integerp)
(defvar cg-font-lock-keywords-1
(let ((<word>? "\\(?:\"<\\(\\s_\\|\\sw\\)+>\"\\)?"))
`(("^[ \t]*\\(LIST\\|SET\\|TEMPLATE\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)"
(1 font-lock-keyword-face)
(2 font-lock-variable-name-face))
("^[ \t]*\\(MAPPING-PREFIX\\|DELIMITERS\\|SOFT-DELIMITERS\\)"
1 font-lock-keyword-face)
("^[ \t]*\\(SECTION\\|AFTER-SECTIONS\\|BEFORE-SECTIONS\\|MAPPINGS\\|CONSTRAINTS\\|CORRECTIONS\\)"
1 font-lock-warning-face)
(,(concat "^[ \t]*" <word>? "[ \t]*\\(SETPARENT\\|SETCHILD\\|ADDRELATIONS?\\|SETRELATIONS?\\|REMRELATIONS?\\|SUBSTITUTE\\|ADD\\|MAP\\|SELECT\\|REMOVE\\)\\(\\(:\\(\\s_\\|\\sw\\)+\\)?\\)")
(2 font-lock-keyword-face)
(3 font-lock-variable-name-face))
("[ \t\n]\\([+-]\\)[ \t\n]"
1 font-lock-function-name-face)))
"Subdued level highlighting for CG mode.")
(defconst cg-font-lock-keywords-2
(append cg-font-lock-keywords-1
'(("\\<\\(\\$\\$\\(\\s_\\|\\sw\\)+\\)\\>"
(1 font-lock-variable-name-face))
("\\<\\(NOT\\|NEGATE\\|NONE\\|LINK\\|BARRIER\\|CBARRIER\\|OR\\|TARGET\\|IF\\|TO\\|[psc]\\)\\>"
1 font-lock-function-name-face)
("\\B\\(\\^\\)" ; fail-fast
1 font-lock-function-name-face)))
"Gaudy level highlighting for CG modes.")
(defvar cg-font-lock-keywords cg-font-lock-keywords-1
"Default expressions to highlight in CG modes.")
(defvar cg-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?# "<" table)
(modify-syntax-entry ?\n ">#" table)
;; todo: better/possible to conflate \\s_ and \\sw into one class?
(modify-syntax-entry ?@ "_" table)
table))
;;;###autoload
(defun cg-mode ()
"Major mode for editing Constraint Grammar files.
Only does basic syntax highlighting at the moment."
(interactive)
(kill-all-local-variables)
(setq major-mode 'cg-mode
mode-name "CG")
(use-local-map cg-mode-map)
(make-local-variable 'comment-start)
(make-local-variable 'comment-start-skip)
(make-local-variable 'font-lock-defaults)
(make-local-variable 'indent-line-function)
(setq comment-start "#"
comment-start-skip "#+[\t ]*"
font-lock-defaults
`((cg-font-lock-keywords cg-font-lock-keywords-1 cg-font-lock-keywords-2)
nil ; KEYWORDS-ONLY
nil ; CASE-FOLD
((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w"))
nil ; beginning-of-line ; SYNTAX-BEGIN
(font-lock-syntactic-keywords . cg-font-lock-syntactic-keywords)
(font-lock-syntactic-face-function . cg-font-lock-syntactic-face-function)))
(make-local-variable 'cg-mode-syntax-table)
(set-syntax-table cg-mode-syntax-table)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(setq indent-line-function 'cg-indent-line)
(easy-mmode-pretty-mode-name 'cg-mode " cg")
(when font-lock-mode
(setq font-lock-set-defaults nil)
(font-lock-set-defaults)
(font-lock-fontify-buffer))
(run-mode-hooks 'cg-mode-hook))
(defconst cg-font-lock-syntactic-keywords
;; A `#' begins a comment when it is unquoted and at the beginning
;; of a word; otherwise it is a symbol.
;; For this to work, we also add # into the syntax-table as a
;; comment, with \n to turn it off, and also need
;; (set (make-local-variable 'parse-sexp-lookup-properties) t)
;; to avoid parser problems.
'(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_")
;; fail-fast, at the beginning of a word:
("[( \t\n]\\(\\^\\)" 1 "'")))
(defun cg-font-lock-syntactic-face-function (state)
"Determine which face to use when fontifying syntactically. See
`font-lock-syntactic-face-function'.
TODO: something like
((= 0 (nth 0 state)) font-lock-variable-name-face)
would be great to differentiate SETs from their members, but it
seems this function only runs on comments and strings..."
(cond ((nth 3 state) font-lock-string-face)
(t font-lock-comment-face)))
;;; Indentation
(defvar cg-kw-list
'("SUBSTITUTE"
"MAP" "ADD"
"SELECT" "REMOVE"
"LIST" "SET"
"SETPARENT" "SETCHILD"
"ADDRELATION" "REMRELATION"
"ADDRELATIONS" "REMRELATIONS"
";"))
(defun cg-calculate-indent ()
"Return the indentation for the current line."
;;; idea from sh-mode, use font face?
;; (or (and (boundp 'font-lock-string-face) (not (bobp))
;; (eq (get-text-property (1- (point)) 'face)
;; font-lock-string-face))
;; (eq (get-text-property (point) 'face) sh-heredoc-face))
(let ((origin (point))
(old-case-fold-search case-fold-search))
(setq case-fold-search nil) ; for re-search-backward
(save-excursion
(let ((kw-pos (progn
(goto-char (1- (or (search-forward ";" (line-end-position) t)
(line-end-position))))
(re-search-backward (regexp-opt cg-kw-list) nil 'noerror))))
(setq case-fold-search old-case-fold-search)
(when kw-pos
(let* ((kw (match-string-no-properties 0)))
(if (and (not (equal kw ";"))
(> origin (line-end-position)))
cg-indentation
0)))))))
(defun cg-indent-line ()
"Indent the current line. Very simple indentation: lines with
keywords from `cg-kw-list' get zero indentation, others get one
indentation."
(interactive)
(let ((indent (cg-calculate-indent))
(pos (- (point-max) (point))))
(when indent
(beginning-of-line)
(skip-chars-forward " \t")
(indent-line-to indent)
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos))))))
;;; Interactive functions:
(defvar cg-occur-history nil)
(defvar cg-occur-prefix-history nil)
(defun cg-permute (input)
"From http://www.emacswiki.org/emacs/StringPermutations"
(require 'cl)
(if (null input)
(list input)
(mapcan '(lambda (elt)
(mapcan '(lambda (p)
(list (cons elt p)))
(cg-permute (remove* elt input :count 1))))
input)))
(defun cg-read-arg (prompt history)
(let* ((default (car history))
(input
(read-from-minibuffer
(concat prompt
(if default
(format " (default: %s): " (query-replace-descr default))
": "))
nil
nil
nil
(quote history)
default)))
(if (equal input "")
default
input)))
(defun cg-occur-list (&optional prefix words)
"Do an occur-check for the left-side of a LIST/SET
assignment. `words' is a space-separated list of words which
*all* must occur between LIST/SET and =. Optional prefix argument
`prefix' lets you specify a prefix to the name of LIST/SET.
This is useful if you have a whole bunch of this stuff:
LIST subst-mask/fem = (n m) (np m) (n f) (np f) ;
LIST subst-mask/fem-eint = (n m sg) (np m sg) (n f sg) (np f sg) ;
etc."
(interactive (list (when current-prefix-arg
(cg-read-arg
"Word to occur between LIST/SET and disjunction"
cg-occur-prefix-history))
(cg-read-arg
"Words to occur between LIST/SET and ="
cg-occur-history)))
(let* ((words-perm (cg-permute (split-string words " " 'omitnulls)))
;; can't use regex-opt because we need .* between the words
(perm-disj (mapconcat '(lambda (word)
(mapconcat 'identity word ".*"))
words-perm
"\\|")))
(setq cg-occur-history (cons words cg-occur-history))
(setq cg-occur-prefix-history (cons prefix cg-occur-prefix-history))
(let ((tmp regexp-history))
(occur (concat "\\(LIST\\|SET\\) +" prefix ".*\\(" perm-disj "\\).*="))
(setq regexp-history tmp))))
;;; Keybindings --------------------------------------------------------------
(define-key cg-mode-map (kbd "C-c o") 'cg-occur-list)
;;; Run hooks -----------------------------------------------------------------
(run-hooks 'cg-load-hook)
(provide 'cg)
;;;============================================================================
;;; cg.el ends here
Jump to Line
Something went wrong with that request. Please try again.