;; LPC mode
;;
;; Emacs Lisp Archive Entry
;; Package: lpc-mode
;; Filename: lpc-mode.el
;; Version: 0.08
;; Keywords: languages, LPC
;; Author: Vivek Dasmohapatra <vivek@etla.org>
;; Maintainer: Vivek Dasmohapatra <vivek@etla.org>
;; Created: 2002-08-31
;; Description: syntax highlighting/indentation for LPC
;; URL: http://rtfm.etla.org/emacs/lpc-mode/
;; Compatibility: Emacs21
;; Last-Updated: Fri 2002-09-06 14:53:12 +0100

;; This file is NOT part of GNU Emacs

;; 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;; Copyright (C) 2002 Vivek Dasmohapatra <vivek@etla.org>

;; 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 of the License, or
;; (at your option) any later version.

;; OK Nick: first stab at LPC mode:
;; 0.01: 'foo and 'C' should be handled correctly.
;; 0.02 ... 0.06: intermediates.
;; 0.07: ultra-hairy ({#'[][,&] syntax now scanned for. Bleurgh.
;; 0.08: ({ ... }) syntax added as brace-list

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HOW TO INSTALL:
;;
;; ;; either put lpc-mode.el in your load path and use:
;; (autoload 'lpc-mode  "lpc-mode" t)
;;
;; ;; or have:
;; (autoload 'lpc-mode  "/path/to/lpc-mode.el" t)
;;
;; ;; then:
;; (setq auto-mode-alist
;;       (append '(("\\.lpc$" . lpc-mode)) auto-mode-alist)) )
;;
;; Nick: You'll have to do similar things to handler.el to get that to
;; work, let me know if you need this done.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; elisp-dep-block >>
(require 'cc-mode);
(require 'cc-cmds);(c-electric-brace)
(require 'cc-defs);(c-identifier-re)
(require 'derived);(define-derived-mode)
(require 'custom );(defface)
(require 'font-lock);
;;(font-lock-mode font-lock-add-keywords font-lock-fontify-region)
;; elisp-dep-block <<

(defun lpc-join (sep strings)
  (cond ((= 1 (length strings)) (car strings))
        ((= 0 (length strings)) "")
        ((< 1 (length strings))
         (lpc-join sep
                   (cons (concat (car strings) sep (cadr strings))
                         (cddr strings)) )) ))

(defconst lpc-type-keywds
  (list "mapping" "string" "object" "closure" "status" "mixed"))

(defconst lpc-keywords
  (lpc-join "\\|" (cons c-C++-keywords lpc-type-keywds)))

(defconst lpc-font-lock-extra-types
  (append c++-font-lock-extra-types lpc-type-keywds))

(defconst lpc-font-lock-keywords
  (list (cons (c-identifier-re lpc-keywords) font-lock-keyword-face)))

(defconst lpc-special-brace-lists '((?{ . ?})) )

(defconst lpc-extra-font-lock-map
  '( ("\\('.'\\|'\\\\.'\\)"             1 font-lock-string-face  keep)
     ("{\\s-*\\(#\\)"                   1 font-lock-builtin-face keep)
     ("'\\([^}, \t;]+\\)"               1 lpc-reference-face     keep)
     ("'\\(,\\)[,} \t\n]"               1 lpc-reference-face     keep)
     ("\\(\\binherit\\)\\s-+\\s\".+\";" 1 font-lock-builtin-face    t)
     ("\\b\\(varargs\\|nomask\\)\\b"    1 font-lock-keyword-face    t) ) )

(defconst lpc-magic-quote-comma '(9))
(defconst lpc-magic-symbol-name '(3))

(defvar lpc-reference-face 'lpc-reference-face)

(defface lpc-reference-face
  '((((class color) (background  dark)) (:foreground "bisque"   ))
    (((class color) (background light)) (:foreground "dark blue")))
  "LPC mode face for quoted symbols")

(define-derived-mode lpc-mode c++-mode "LPC"
  "Major mode for editing LPC, a member of the C/C++ family of languages"
  (make-variable-buffer-local 'parse-sexp-lookup-properties)
  ;; Do not introduce variable if not needed, we check it!
  (set 'parse-sexp-lookup-properties t)
  (c-common-init)
  (setq c-keywords            (c-identifier-re lpc-keywords)
        c-special-brace-lists lpc-special-brace-lists
        )
  ;;(lpc-mangle-c++-mode)
  (lpc-set-font-lock-defaults)
  (lpc-scan-magic-quotes)
  (font-lock-add-keywords nil lpc-extra-font-lock-map)
  ;; lie like a flatfish, or font-lock-mode will refuse to run in batch mode:
  (if noninteractive
      (let ((font-lock-mode t) (noninteractive nil))
        (turn-on-font-lock) (font-lock-fontify-buffer))
    (turn-on-font-lock)
    )
  )

(defun lpc-modify-syntax-at (beg end syntax)
  "Apply a syntax-property value syntax from beg to end."
  (if (<= (point-max) end) nil; noop
    (progn
      ;;(message "(%d x %d) => %S" beg end syntax)
      (put-text-property beg      end 'syntax-table   syntax)
      (put-text-property (1- end) end 'rear-nonsticky t     ))))

(defun lpc-set-font-lock-defaults ()
  "Set up LPC mode as a modified version of `c++-mode'"
  (let ((major-mode                'c++-mode)
        (c++-font-lock-extra-types  lpc-font-lock-extra-types))
    (font-lock-set-defaults)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Code by Seth Golub <seth AT cs DOT wustl DOT edu>, 1996-02-01, no licence.
(defun lpc-maybe-electric-brace (arg)
  "Insert character and maybe correct line's indentation."
  (interactive "P")
  (if (= last-command-char ?{)
      (if (= (preceding-char) ?\()
          (self-insert-command (prefix-numeric-value arg))
        (c-electric-brace arg))
    ;; (= last-command-char ?})
    (let (start-point state containing-sexp)
      (save-excursion (beginning-of-defun)
                      (setq start-point (point)))
      (save-excursion (setq state (parse-partial-sexp (point) start-point 0)))
      (setq containing-sexp (car (cdr state)))
      (if (and containing-sexp (save-excursion
                                 (goto-char (1- containing-sexp))
                                 (looking-at "(")))
          (progn
            (self-insert-command (prefix-numeric-value arg))
            (lpc-scan-magic-quote))
        (c-electric-brace arg)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst lpc-magic-quote-regex "({\\s-*#'\\([^\\s-\n,}]+\\|,\\)\\s-*[,}]")

(defun lpc-magic-comma-p (pt)
  (let ((bol nil) (eol nil) (pos nil) (ret nil))
    (save-excursion
      (goto-char pt)
      (end-of-line)
      (setq eol (point))
      (beginning-of-line)
      (setq bol (point))
      (while (and (not ret)
                  (setq pos (re-search-forward lpc-magic-quote-regex eol t)))
        ;;(message "magic pattern at %d/%d" (1- pos) pt)
        (if (/= (1- pos) pt) nil
          (setq ret (list (- (match-beginning 1) 1)
                          (match-beginning       1)
                          (match-end             1)
                          bol)) ) )) ret))

(defun lpc-scan-magic-quotes ()
  (save-excursion
    (let ((qpos nil) (wbeg nil) (wend nil))
      (while (re-search-forward lpc-magic-quote-regex nil t)
        (setq qpos (+ (match-beginning 0) 3)
              wbeg (match-beginning       1)
              wend (match-end             1))
        (lpc-modify-syntax-at qpos (1+ qpos) lpc-magic-quote-comma)
        (lpc-modify-syntax-at wbeg wend      lpc-magic-symbol-name)
        )
      )
    )
  )

(defun lpc-scan-magic-quote ()
  (save-excursion
    (let ((coord nil) (qpos nil) (wbeg nil) (wend nil) (bol nil))
      (if (setq coord (lpc-magic-comma-p (1- (point))))
          (progn
            (setq qpos  (car         coord)
                  wbeg  (cadr        coord)
                  wend  (car  (cddr coord))
                  bol   (cadr (cddr coord)))
            ;;(message "magic pattern at (%d %d %d)" qpos wbeg wend)
            (lpc-modify-syntax-at qpos (1+ qpos) lpc-magic-quote-comma)
            (lpc-modify-syntax-at wbeg wend      lpc-magic-symbol-name)
            (font-lock-fontify-region bol wend) )
        )
      )
    )
  )

(defun lpc-maybe-quote-ref (arg)
  "Kludge to work around multiple syntactic meanings of `,' `[' et al in LPC."
  (interactive "P")
  (self-insert-command (prefix-numeric-value arg))
  (lpc-scan-magic-quote) )

(define-key lpc-mode-map "\C-c:" 'c-scope-operator)
(define-key lpc-mode-map "{"     'lpc-maybe-electric-brace)
(define-key lpc-mode-map "}"     'lpc-maybe-electric-brace)
(define-key lpc-mode-map ","     'lpc-maybe-quote-ref)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(modify-syntax-entry ?\' "'" lpc-mode-syntax-table)

(provide 'lpc-mode)
;; lpc-mode.el ends here