;;; lpc.el -- Major mode for editing uLPC and other LPC files. ;;; Copyright (C) 1995, 1996 Per Hedbor. This file is distributed as GPL ;;; Keywords: LPC, uLPC, µLPC, highlight ;;; This file also provides a highlight-syntax table for µLPC. ;;; In fact, it more or less require that you can set the highlight ;;; table.. It require Emacs 19.30 or better ;;; How to use it: Change the lpc-manual-dir-list, if needed, ;;; and add the following lines to your .emacs: ;;; (autoload 'lpc-mode "lpc" "The major mode for editing µLPC" t) ;;; (setq auto-mode-alist ;;; (append '(("\\.ulpc$" . lpc-mode) ;;; ("\\.lpc$" . lpc-mode) ;;; It might be a good idea to byte-compile the file first: ;;; M-x byte-compile ;;; ;;; Press return ;;; Known problems: ;;; o The highlighting is at times quite bogus. ;;; o foreach is not indented correctly. ;;; o lambda functions in arrays in mappings are indented strangely. (defvar lpc-manual-dir-list '("/usr/local/lib/ulpc/doc/" "/usr/local/lib/ulpc/doc/files" "/usr/local/lib/ulpc/doc/builtin" "/usr/local/lib/ulpc/doc/lpc" "/usr/local/lib/ulpc/doc/manual" "/usr/local/lib/ulpc/doc/math" "/usr/local/lib/ulpc/doc/regexp" "/usr/local/lib/ulpc/doc/simulated" "/usr/local/lib/ulpc/doc/sprintf" "/usr/local/lib/ulpc/doc/types" "/usr/local/lib/ulpc/doc/operators" nil) "The directories in which LPC-manual pages are present.") ;; Well, to set the font-lock stuff, we have to load it now.. (require 'font-lock) ;; This one is needed because I am lazy. ;; It is available in /pub/gnu/emacs/elisp-archive on ;; archive.cis.ohio-state.edu, and probably from the same spot as lpc.el.. ;; (require 'make-regexp) ;; In this version, the 'make-regexp' results are inlined. (let ((lpc-keywords "break\\|c\\(atch\\|lass\\|ontinue\\)\\|do\\|else\\|for\\(\\|each\\)\\|i\\(f\\|n\\(herit\\|line\\)\\)\\|lambda\\|nomask\\|p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|return\\|s\\(tatic\\|witch\\)\\|throw\\|while") ;;(make-regexp '("inline" "public" "protected" "private" "static" ;; "break" "continue" "do" "else" "for" "if" "nomask" ;; "return" "switch" "while" "lambda" "class" ;; "catch" "throw" "foreach" "inherit" ))) (constant-initiators "\\(([[<{]\\|[]>}])\\)") (lpc-types ;; Types are a tad more complicated.. ;; This is where lpc differs most from C and C++. ;; This regexp can now handle: TYPE (.*) ;; It once verified that it was: TYPE (.*TYPE), but there was no real ;; gain.. (concat "\\<\\(" "array\\|f\\(loat\\|unction\\)\\|int\\|m\\(apping\\|ixed\\)\\|object\\|program\\|string\\|void" ;; (make-regexp '("string" "function" "int" "object" "float" ;; "program" "mixed" "void" "array" "mapping")) "\\>\\)" "[ \t]*\\(([a-z,:() ]*)\\)?" ))) (setq lpc-font-lock-keywords-1 (list (list constant-initiators 0 'font-lock-reference-face) ;; These are all anchored at the beginning of line for speed. ;; Fontify function name definitions (without type on line). '("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face) '("^#!.*$" 0 font-lock-comment-face) '("^\\(#[ \t]*error\\)\\(.*\\)$" (1 font-lock-reference-face) (2 font-lock-comment-face)) ;; Fontify filenames in #include <...> as strings. '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) ;; Fontify function macro names. '("^#[ \t]*define[ \t]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face) ;; Fontify symbol names in #if ... defined preprocessor directives. '("^#[ \t]*if\\>" ("\\<\\(defined\\|efun\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))) ;; Fontify otherwise as symbol names, and preprocessor directive names '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)) )) (setq lpc-font-lock-keywords-2 (append lpc-font-lock-keywords-1 (list ;; Fontify all type specifiers. (cons lpc-types 'font-lock-type-face) ;; Fontify all builtin keywords (cons (concat "\\<\\(" lpc-keywords "\\)\\>") 'font-lock-keyword-face) ;; Fontify case/default. '("^[ \t]+\\(case\\)[ \t]+\\([^:]+:\\)$" (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)) '("^[ \t]*\\(default\\)[ \t]*$:" 1 font-lock-reference-face) ))) (setq lpc-font-lock-keywords-3 (append lpc-font-lock-keywords-2 (list ;; More complicated regexps for more complete highlighting ;; This one get all the functions.... (list lpc-types '("\\(\\<[a-zA-ZåäöÅÄÖ_][0-9a-zA-ZåäöÅÄÖ_]*\\>\\)[ \t]*(" nil nil (1 font-lock-function-name-face))) ;; And this one the variables. Both global, local and ;; in function defenitions. (list lpc-types '("\\(\\<[a-zA-ZåäöÅÄÖ_][0-9a-zA-ZåäöÅÄÖ_]*\\>\\)+[ \t=,;)]+" nil nil (1 font-lock-variable-name-face))) )))) (defvar lpc-font-lock-keywords lpc-font-lock-keywords-3 "Default expressions to highlight in LPC mode.") ;(if (not (assq 'lpc-mode font-lock-defaults-alist)) ; (setq font-lock-defaults-alist ; (append font-lock-defaults-alist ; (list (cons 'lpc-mode ; '((lpc-font-lock-keywords ; lpc-font-lock-keywords-1 ; lpc-font-lock-keywords-2 ; lpc-font-lock-keywords-3) ; nil nil ; ((?_ . "å") (?_ . "ä") (?_ . "ö") ; (?_ . "Å") (?_ . "Ä") (?_ . "Ö") ; (?_ . "w")) beginning-of-defun)))))) (defvar lpc-current-lpc-man "" "Internal variable in lpc-mode") (defvar lpc-man-buffer "" "Internal variable in lpc-mode") (provide 'lpc-mode) (provide 'ulpc-mode) (defun ulpc-mode () (lpc-mode)) ;; We want 'cc-mode', not 'c++-mode'. (require 'cc-mode) (defvar lpc-mode-syntax-table c++-mode-syntax-table "Syntax table for the lpc-mode. Default is same as c++-mode syntax table.") (define-derived-mode lpc-mode c++-mode "uLPC mode" "Major mode for µLPC and, presumably, some other dialects of lpc. The major problem with other dialects are the type defenitions. They are quite, ehm, special, in µLPC. \\{lpc-mode-map}" (make-variable-buffer-local 'lpc-mode-syntax-table) (make-variable-buffer-local 'lpc-manual-dir-list) (define-key lpc-mode-map "\C-c\C-l" 'lpc-man-on-word) (define-key lpc-mode-map [down-mouse-3] 'lpc-man-on-word) (define-key lpc-mode-map "\C-c\C-h" 'lpc-manual-entry) (setq font-lock-keywords lpc-font-lock-keywords-3)) (defun lpc-find-lpc-function () (interactive) (save-excursion (while (looking-at "[^a-zA-ZåäöÅÄÖ_1-9]") (backward-char 1)) (while (looking-at "[a-zA-ZåäöÅÄÖ_1-9]") (forward-char 1)) (let ((end (point))) (backward-char 1) (while (looking-at "[a-zA-ZåäöÅÄÖ_1-9]") (backward-char 1)) (forward-char 1) (buffer-substring (point) end)))) (defun lpc-man-on-word () "Show the manual entry (If any) for the 'closest' function" (interactive) (save-excursion (lpc-manual-entry (lpc-find-lpc-function)))) (defun lpc-display-man-file () (save-excursion (with-output-to-temp-buffer (setq lpc-man-buffer (concat "*LPC Manual entry [" lpc-current-lpc-man "]*")) (set-buffer lpc-man-buffer) (local-set-key [return] 'lpc-man-on-word) (insert-file lpc-current-lpc-man) (toggle-read-only 1)))) (defun lpc-find-file-in-man-path (file rest) (if (car rest) (if (file-exists-p (concat (car rest) "/" file)) (concat (car rest) "/" file) (lpc-find-file-in-man-path file (cdr rest))))) (defun lpc-manual-entry (subject) "Display the LPC maual entry for TOPIC." (interactive "sLpc man subject: ") (if (not subject) (message "Man for what?") (message (concat "Looking for manual entry for " subject)) (if (get-buffer lpc-man-buffer) (kill-buffer lpc-man-buffer)) (if (setq lpc-current-lpc-man (lpc-find-file-in-man-path subject lpc-manual-dir-list)) (lpc-display-man-file) (message (concat "No such LPC-documentation: " subject)))))