;;; pike.el -- Font lock definitions for Pike and other LPC files. ;;; $Id: pike.el,v 1.15 2000/11/17 16:47:36 mast Exp $ ;;; Copyright (C) 1995, 1996, 1997, 1998, 1999 Per Hedbor. ;;; This file is distributed as GPL ;;; Keywords: Pike, LPC, uLPC, �LPC, highlight ;;; To use: ;;; ;;; (require 'pike) ;;; ;;; Older Emacs versions doesn't come with a Pike-aware CC Mode (M-x ;;; c-version should report 5.23 or later), so you might have to ;;; upgrade that (see http://www.python.org/emacs/cc-mode/). You ;;; probably want this too in that case: ;;; ;;; (setq auto-mode-alist ;;; (append '(("\\.pike$" . pike-mode)) auto-mode-alist) (require 'font-lock) (require 'custom) ;; Added in later font-lock versions. Copied here for backward ;; compatibility. (defvar font-lock-preprocessor-face 'font-lock-keyword-face "Don't even think of using this.") (defvar pike-font-lock-refdoc-face 'pike-font-lock-refdoc-face) (defvar pike-font-lock-refdoc-init-face 'pike-font-lock-refdoc-init-face) (defvar pike-font-lock-refdoc-init2-face 'pike-font-lock-refdoc-init2-face) (defvar pike-font-lock-refdoc-keyword-face 'pike-font-lock-refdoc-keyword-face) (defvar pike-font-lock-refdoc-error-face 'pike-font-lock-refdoc-error-face) (defconst pike-font-lock-keywords-1 nil "For consideration as a value of `pike-font-lock-keywords'. This does fairly subdued highlighting.") (defconst pike-font-lock-keywords-2 nil "For consideration as a value of `pike-font-lock-keywords'. This adds highlighting of types and identifier names.") (defconst pike-font-lock-keywords-3 nil "For consideration as a value of `pike-font-lock-keywords'. Highlight some constructs differently") (defgroup pike-faces nil "Faces used by the pike color highlighting mode." :group 'font-lock :group 'faces) (defface pike-font-lock-refdoc-face '((t)) "Face to use for normal text in Pike documentation comments. It's overlaid over the `font-lock-comment-face'." :group 'pike-faces) (defface pike-font-lock-refdoc-init-face '((t (:bold t))) "Face to use for the magic init char of Pike documentation comments. It's overlaid over the `font-lock-comment-face'." :group 'pike-faces) (defface pike-font-lock-refdoc-init2-face '((t)) "Face to use for the comment starters Pike documentation comments. It's overlaid over the `font-lock-comment-face'." :group 'pike-faces) (defface pike-font-lock-refdoc-keyword-face '((t)) "Face to use for markup keywords Pike documentation comments. It's overlaid over the `font-lock-reference-face'." :group 'pike-faces) (defface pike-font-lock-refdoc-error-face '((((class color) (background light)) (:foreground "red")) (((class color)) (:foreground "hotpink")) (((background light)) (:foreground "white" :background "black")) (t (:foreground "black" :background "white"))) "Face to use for invalid markup in Pike documentation comments." :group 'pike-faces) (defconst pike-font-lock-type-regexp (concat "\\<\\(" "mixed\\|" "float\\|" "int\\|" "program\\|" "string\\|" "function\\|" "function(.*)\\|" "array\\|" "array(.*)\\|" "mapping\\|" "mapping(.*)\\|" "multiset\\|" "multiset(.*)\\|" "object\\|" "object(.*)\\|" "void\\|" "constant\\|" "class" "\\)\\>)*") "Regexp which should match a primitive type.") ; Problems: We really should allow all unicode characters... (let ((capital-letter "A-Z\300-\326\330-\337") (letter "a-zA-Z\241-\377_") (digit "0-9") ) (defconst pike-font-lock-identifier-regexp (concat "\\<\\([" letter "][" letter digit "]*\\)\\>") "Regexp which should match all Pike identifiers.") (defconst pike-font-lock-class-name-regexp (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>") "Regexp which should match a class name. The name is assumed to begin with a capital letter.") (defun pike-font-lock-hack-file-coding-system-perhaps ( foo ) (interactive) (message "charset %s" (buffer-substring (match-beginning 2) (match-end 2))) (condition-case fel (if (and (fboundp 'set-buffer-file-coding-system) (fboundp 'symbol-concat)) (let ((coding (buffer-substring (match-beginning 2) (match-end 2)))) (set-buffer-file-coding-system (symbol-concat coding)))) (t nil))) (defconst pike-modifier-regexp (concat "\\<\\(public\\|inline\\|final\\|static\\|protected\\|" "local\\|optional\\|private\\|nomask\\|variant\\)\\>")) (defconst pike-operator-identifiers (concat "``?\\(!=\\|->=?\\|<[<=]\\|==\\|>[=>]\\|\\[\\]=?\\|\(\)" "\\|[!%&+*/<>^|~-]\\)")) ;; Basic font-lock support: (setq pike-font-lock-keywords-1 (list ;; Keywords: (list (concat "\\<\\(" "predef\\|" "import\\|" "default\\|" "case\\|" "class\\|" "break\\|" "continue\\|" "do\\|" "else\\|" "for\\|" "if\\|" "return\\|" "switch\\|" "while\\|" "lambda\\|" "catch\\|" "throw\\|" "foreach\\|" "inherit" "\\)\\>") 1 'font-lock-keyword-face) ;; Modifiers: (list pike-modifier-regexp 1 font-lock-preprocessor-face) ;; Class names: (list (concat "\\(\\<class\\>\\)\\s *" pike-font-lock-identifier-regexp) (list 1 'font-lock-keyword-face) (list 2 'font-lock-function-name-face)) ;; Methods: (list (concat (concat "^\\s *\\(" pike-font-lock-type-regexp "\\|" pike-font-lock-class-name-regexp "\\)") "\\s *" ;;"\\s *\\(\\[\\s *\\]\\s *\\)*" (concat "\\(" pike-font-lock-identifier-regexp "\\|" pike-operator-identifiers "\\)") "\\s *(") 4 'font-lock-function-name-face) ;; Case statements: ;; Any constant expression is allowed. '("\\<case\\>\\s *\\(.*\\):" 1 font-lock-reference-face))) ;; Types and declared variable names: (setq pike-font-lock-keywords-2 (append (list '("^#!.*$" 0 font-lock-comment-face) '("^#[ \t]*error\\(.*\\)$" (1 font-lock-string-face)) ;; #charset char-set-name ;; Defines the file charset. '("^\\(#[ \t]*charset\\)[ \t]*\\(.*\\)$" (2 font-lock-keyword-face) (pike-font-lock-hack-file-coding-system-perhaps )) ;; Fontify filenames in #include <...> as strings. '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) '("^#[ \t]*define[ \t]+\\(\\sw+\\)\(" 1 font-lock-function-name-face) '("^#[ \t]*define[ \t]+\\(\\sw+\\)" 1 font-lock-variable-name-face) ;; Fontify symbol names in #if ...defined ;; etc preprocessor directives. '("^#[ \t]*if\\>" ("\\<\\(defined\\|efun\\|constant\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))) '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(.*\\)?" (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)) ) pike-font-lock-keywords-1 (list ;; primitive types, can't be confused with anything else. (list pike-font-lock-type-regexp '(1 font-lock-type-face) '(font-lock-match-pike-declarations (goto-char (match-end 1)) (goto-char (match-end 0)) (0 font-lock-variable-name-face))) ;; Declarations, class types and capitalized variables: (list (concat (concat "\\(" ; 1 pike-font-lock-class-name-regexp ; 2 "\\|" (concat "object(" "\\(\\sw+\\.\\)*" ; 3 pike-font-lock-identifier-regexp ; 4 ")") "\\)") (concat "\\(" "[,:|\)]" "\\|" (concat "\\(\\s *\\.\\.\\.\\)?" "\\(\\s \\|/\\*\\([^*]\\|\\*[^/]\\)*\\*/\\)*" "\\(`\\|\\<\\)") "\\)")) '(font-lock-match-pike-types (goto-char (or (match-beginning 2) (match-beginning 4))) (goto-char (match-end 1)) (1 font-lock-type-face)) (list (concat "\\=" pike-font-lock-identifier-regexp "\\.") '(progn (goto-char (or (match-beginning 2) (match-beginning 4))) (while (or (= (preceding-char) ?.) (= (char-syntax (preceding-char)) ?w)) (backward-char))) '(goto-char (match-end 0)) '(1 font-lock-reference-face) '(0 nil)) ; Workaround for bug in XEmacs. '(font-lock-match-pike-declarations (goto-char (match-end 1)) nil (1 font-lock-variable-name-face))) ))) ;; Modifier keywords (setq pike-font-lock-keywords-3 (append (list ;; Feature scoping: ;; These must come first or the Modifiers from keywords-1 will ;; catch them. We don't want to use override fontification here ;; because then these terms will be fontified within comments. '("\\<public\\>" 0 font-lock-preprocessor-face) '("\\<inline\\>" 0 font-lock-preprocessor-face) '("\\<final\\>" 0 font-lock-preprocessor-face) '("\\<static\\>" 0 font-lock-preprocessor-face) '("\\<protected\\>" 0 font-lock-preprocessor-face) '("\\<local\\>" 0 font-lock-preprocessor-face) '("\\<private\\>" 0 font-lock-preprocessor-face) '("\\<nomask\\>" 0 font-lock-preprocessor-face) '("^.*\\(//\\)\\([.!|]\\)\\([^\n\r]*\\)" (1 pike-font-lock-refdoc-init2-face prepend) (2 pike-font-lock-refdoc-init-face prepend) (3 pike-font-lock-refdoc-face prepend) ((lambda (limit) (if (looking-at "[ \t]*@decl") (progn (put-text-property (match-end 0) limit 'face nil) (goto-char limit) t))) (goto-char (match-end 2)) nil) ("\\(@\\(\\w+{?\\|\\[[^\]]*\\]\\|[@}]\\|$\\)\\)\\|\\(@.\\)" (goto-char (match-end 2)) nil (1 font-lock-reference-face t t) (1 pike-font-lock-refdoc-keyword-face prepend t) (3 pike-font-lock-refdoc-error-face t t)) ) ) pike-font-lock-keywords-2 ))) (defvar pike-font-lock-keywords pike-font-lock-keywords-1 "Additional expressions to highlight in Pike mode.") (defun font-lock-match-pike-types (limit) "Match and skip over types." (prog1 (and (looking-at pike-font-lock-identifier-regexp) (save-restriction (narrow-to-region (save-excursion (beginning-of-line) (point)) limit) (save-match-data (let ((pos (point))) (while (and (condition-case nil (progn (up-list -1) t) (error nil)) (eq (following-char) ?\() (save-excursion (skip-syntax-backward " ") (skip-syntax-backward "w") (looking-at pike-font-lock-type-regexp))) (setq pos (point))) (goto-char pos))) (condition-case nil (progn (while (save-match-data (forward-sexp) (if (looking-at (concat "\\s *|" "\\(" pike-font-lock-class-name-regexp "\\|" pike-font-lock-type-regexp "\\s *\(?\\)")) (progn (if (eq (char-after (1- (match-end 0))) ?\() (forward-sexp)) t)))) (save-match-data (looking-at "\\s *\\(`\\|\\<\\|$\\)"))) (error nil)))) (goto-char limit))) ;; Match and move over any declaration/definition item after ;; point. Does not match items which look like a type declaration ;; (primitive types and class names, i.e. capitalized words.) ;; Should the variable name be followed by a comma, we reposition ;; the cursor to fontify more identifiers. (defun font-lock-match-pike-declarations (limit) "Match and skip over variable definitions." (while (and (looking-at ")") (condition-case nil (save-excursion (up-list -1) (skip-syntax-backward " ") (skip-syntax-backward "w") (looking-at pike-font-lock-type-regexp)) (error nil))) (forward-char 1)) (looking-at "\\(\\s *\\.\\.\\.\\)?\\(\\s \\|/\\*\\([^*]\\|\\*[^/]\\)*\\*/\\)*") (goto-char (match-end 0)) (and (looking-at pike-font-lock-identifier-regexp) (save-match-data (not (string-match pike-font-lock-type-regexp (buffer-substring (match-beginning 1) (match-end 1))))) (save-match-data (save-excursion (goto-char (match-beginning 1)) (not (looking-at (concat "\\(\\sw+\\.\\)*" pike-font-lock-class-name-regexp "\\s *\\(\\<\\||\\)"))))) (save-match-data (let ((start (match-end 0))) (condition-case nil (save-restriction (narrow-to-region (point-min) limit) (goto-char start) ;; Note: Both `scan-sexps' and the second goto-char can ;; generate an error which is caught by the ;; `condition-case' expression. (while (not (looking-at "\\s *\\(\\(,\\)\\|;\\|$\\)")) (goto-char (or (scan-sexps (point) 1) (point-max)))) (goto-char (match-end 2))) ; non-nil (error (goto-char start) (if (not (looking-at "\\s *(")) (goto-char limit) t))))))) ;; XEmacs way. (put 'pike-mode 'font-lock-defaults '((pike-font-lock-keywords pike-font-lock-keywords-1 pike-font-lock-keywords-2 pike-font-lock-keywords-3) nil nil ((?_ . "w")) beginning-of-defun (font-lock-mark-block-function . mark-defun))) ;; GNU Emacs way. (if (and (boundp 'font-lock-defaults-alist) (not (assq 'pike-mode font-lock-defaults-alist))) (setq font-lock-defaults-alist (cons (cons 'pike-mode '((pike-font-lock-keywords pike-font-lock-keywords-1 pike-font-lock-keywords-2 pike-font-lock-keywords-3) nil nil ((?_ . "w")) beginning-of-defun (font-lock-mark-block-function . mark-defun))) font-lock-defaults-alist))) ;; Autoload spec for older emacsen that doesn't come with a Pike aware ;; CC Mode. Doesn't do any harm in later emacsen. (autoload 'pike-mode "cc-mode" "Major mode for editing Pike code.") (provide 'pike)