site-lisp/4gl-mode_font.el

   1 (cond
   2  ((featurep 'font-lock)
   3   (or (boundp 'font-lock-variable-name-face)
   4       (setq font-lock-variable-name-face font-lock-type-face))
   5
   6   (setq 4gl-font-lock-syntactic-keywords
   7         '(
   8           ;; #{ }, #$hoge, #@foo are not comments
   9           ("\\(#\\)[{$@]" 1 (1 . nil))
  10           ;; the last $', $", $` in the respective string is not variable
  11           ;; the last ?', ?", ?` in the respective string is not ascii code
  12           ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
  13            (2 (7 . nil))
  14            (4 (7 . nil)))
  15           ;; $' $" $` .... are variables
  16           ;; ?' ?" ?` are ascii codes
  17           ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
  18           ;; regexps
  19           ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
  20            (4 (7 . ?/))
  21            (6 (7 . ?/)))
  22           ("^\\(=\\)begin\\(\\s \\|$\\)" 1 (7 . nil))
  23           ("^\\(=\\)end\\(\\s \\|$\\)" 1 (7 . nil))))
  24
  25   (cond ((featurep 'xemacs)
  26          (put '4gl-mode 'font-lock-defaults
  27               '((4gl-font-lock-keywords)
  28                 nil nil nil
  29                 beginning-of-line
  30                 (font-lock-syntactic-keywords
  31                  . 4gl-font-lock-syntactic-keywords))))
  32         (t
  33          (add-hook '4gl-mode-hook
  34             '(lambda ()
  35                (make-local-variable 'font-lock-defaults)
  36                (make-local-variable 'font-lock-keywords)
  37                (make-local-variable 'font-lock-syntax-table)
  38                (make-local-variable 'font-lock-syntactic-keywords)
  39                (setq font-lock-defaults '((4gl-font-lock-keywords) nil nil))
  40                (setq font-lock-keywords 4gl-font-lock-keywords)
  41                (setq font-lock-syntax-table 4gl-font-lock-syntax-table)
  42                (setq font-lock-syntactic-keywords 4gl-font-lock-syntactic-keywords)))))
  43
  44   (defun 4gl-font-lock-docs (limit)
  45     (if (re-search-forward "^=begin\\(\\s \\|$\\)" limit t)
  46         (let (beg)
  47           (beginning-of-line)
  48           (setq beg (point))
  49           (forward-line 1)
  50           (if (re-search-forward "^=end\\(\\s \\|$\\)" limit t)
  51               (progn
  52                 (set-match-data (list beg (point)))
  53                 t)))))
  54
  55   (defun 4gl-font-lock-maybe-docs (limit)
  56     (let (beg)
  57       (save-excursion
  58         (if (and (re-search-backward "^=\\(begin\\|end\\)\\(\\s \\|$\\)" nil t)
  59                  (string= (match-string 1) "begin"))
  60             (progn
  61               (beginning-of-line)
  62               (setq beg (point)))))
  63       (if (and beg (and (re-search-forward "^=\\(begin\\|end\\)\\(\\s \\|$\\)" nil t)
  64                         (string= (match-string 1) "end")))
  65           (progn
  66             (set-match-data (list beg (point)))
  67             t)
  68         nil)))
  69
  70   (defvar 4gl-font-lock-syntax-table
  71     (let* ((tbl (copy-syntax-table 4gl-mode-syntax-table)))
  72       (modify-syntax-entry ?_ "w" tbl)
  73       tbl))
  74
  75   (defun 4gl-font-lock-here-docs (limit)
  76     (if (re-search-forward 4gl-here-doc-beg-re limit t)
  77         (let (beg)
  78           (beginning-of-line)
  79           (forward-line)
  80           (setq beg (point))
  81           (if (re-search-forward (4gl-here-doc-end-match) nil t)
  82               (progn
  83                 (set-match-data (list beg (point)))
  84                 t)))))
  85
  86   (defun 4gl-font-lock-maybe-here-docs (limit)
  87     (let (beg)
  88       (save-excursion
  89         (if (re-search-backward 4gl-here-doc-beg-re nil t)
  90             (progn
  91               (beginning-of-line)
  92               (forward-line)
  93               (setq beg (point)))))
  94       (if (and beg
  95                (let ((end-match (4gl-here-doc-end-match)))
  96                  (and (not (re-search-backward end-match beg t))
  97                       (re-search-forward end-match nil t))))
  98           (progn
  99             (set-match-data (list beg (point)))
 100             t)
 101           nil)))
 102
 103   (defvar 4gl-font-lock-keywords
 104     (list
 105      ;; functions
 106      '("^\\s *def\\s +\\([^( \t\n]+\\)"
 107        1 font-lock-function-name-face)
 108      ;; keywords
 109      (cons (concat
 110             "\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(defined\\?\\|\\("
 111             (mapconcat
 112              'identity
 113              '("alias"
 114                "and"
 115                "begin"
 116                "break"
 117                "case"
 118                "catch"
 119                "class"
 120                "def"
 121                "do"
 122                "elsif"
 123                "else"
 124                "fail"
 125                "ensure"
 126                "for"
 127                "end"
 128                "if"
 129                "in"
 130                "module"
 131                "next"
 132                "not"
 133                "or"
 134                "raise"
 135                "redo"
 136                "rescue"
 137                "retry"
 138                "return"
 139                "then"
 140                "throw"
 141                "super"
 142                "unless"
 143                "undef"
 144                "until"
 145                "when"
 146                "while"
 147                "yield"
 148                )
 149              "\\|")
 150             "\\)\\>\\)")
 151            2)
 152      ;; variables
 153      '("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>"
 154        2 font-lock-variable-name-face)
 155      ;; variables
 156      '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W"
 157        1 font-lock-variable-name-face)
 158      '("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+"
 159        0 font-lock-variable-name-face)
 160      ;; embedded document
 161      '(4gl-font-lock-docs
 162        0 font-lock-comment-face t)
 163      '(4gl-font-lock-maybe-docs
 164        0 font-lock-comment-face t)
 165      ;; "here" document
 166      '(4gl-font-lock-here-docs
 167        0 font-lock-string-face t)
 168      '(4gl-font-lock-maybe-here-docs
 169        0 font-lock-string-face t)
 170      `(,4gl-here-doc-beg-re
 171        0 font-lock-string-face t)
 172      ;; general delimited string
 173      '("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)"
 174        (2 font-lock-string-face))
 175      ;; constants
 176      '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)"
 177        2 font-lock-type-face)
 178      ;; symbols
 179      '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|\\[\\]=?\\|\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
 180        2 font-lock-reference-face)
 181      ;; expression expansion
 182      '("#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)"
 183        0 font-lock-variable-name-face t)
 184      ;; warn lower camel case
 185      ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)"
 186      ;  0 font-lock-warning-face)
 187      )
 188     "*Additional expressions to highlight in 4gl mode."))