;;; lpc.el -- Major mode for editing uLPC and other LPC files. ;;; Copyright (C) 1995 Per Hedbor. This file is distributed as GPL ;;; Keywords: lpc, ulpc ;;; This file also provides a highlight-syntax table for ulpc. ;;; This part probably need some work.. (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" ; "/usr/local/lpc4/lib/doc/efun" ; "/usr/local/lpc4/lib/doc/lfun" ; "/usr/local/lpc4/lib/doc/operators" ; "/usr/local/lpc4/lib/doc/lib" ; "/usr/local/lpc4/lib/doc/help" ; "/usr/local/lpc4/lib/doc/types" ; "/usr/local/lpc4/lib/doc/lpc" "/usr/lpmud/lib/doc" "/usr/lpmud/lib/doc/efun" "/usr/lpmud/lib/doc/lfun" "/usr/lpmud/lib/doc/helpdir" "/usr/lpmud/lib/doc/build" "/usr/lpmud/lib/players/milamber/mapsystem/help" 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. (require 'make-regexp) (defun simple-regexp-from (var) (if (cdr var) (concat (regexp-quote (car var)) "\\|" (simple-regexp-from (cdr var))) (car var))) (let ((lpc-keywords (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 "\\<\\(" (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åäöÅÄÖ_][a-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åäöÅÄÖ_][a-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 'lpc4-mode) ;(provide 'ulpc-mode) ;(defun ulpc-mode () (lpc-mode)) ;; We want 'cc-mode', not 'c++-mode'. (require 'cc-mode) (make-variable-buffer-local 'lpc-manual-dir-list) (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 uLPC and, presumably, other dialects of lpc. \\{lpc-mode-map}" (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)))))