(defvar hilit-quietly nil
"* If non-nil, this inhibits progress indicators during highlighting")
(defvar hilit-auto-highlight t
"* t if we should highlight all buffers as we find 'em, nil to disable
automatic highlighting by the find-file hook.")
(defvar hilit-auto-highlight-maxout 60000 "* auto-highlight is disabled in buffers larger than this")
(defvar hilit-auto-rehighlight t
"* If this is non-nil, then hilit-redraw and hilit-recenter will also
rehighlight part or all of the current buffer. t will rehighlight the
whole buffer, a NUMBER will rehighlight that many lines before and after
the cursor, and the symbol 'visible' will rehighlight only the visible
portion of the current buffer. This variable is buffer-local.")
(make-variable-buffer-local 'hilit-auto-rehighlight)
(defvar hilit-auto-rehighlight-fallback '(20000 . 100)
"* Cons of the form (THRESHOLD . FALLBACK), where FALLBACK is assigned to
hilit-auto-rehighlight if the size of a newly opened buffer is larger than
THRESHOLD.")
(defvar hilit-face-check t
"* t slows down highlighting but permits the user to change fonts without
losing bold and italic faces... t causes hilit-lookup-face-create to dig
through the frame parameters for the current window every time it's called.
If you never change fonts in emacs, set this to nil.")
(defvar hilit-inhibit-rebinding nil
"If non-nil, this inhibits replacement of recenter, yank, and yank-pop.")
(defvar hilit-inhibit-hooks nil
"If non-nil, this inhibits installation of hooks for Info, gnus, & vm.")
(defvar hilit-background-mode 'light
"'mono inhibits color, 'dark or 'light indicate the background brightness.")
(defvar hilit-mode-enable-list nil
"If a list of modes to exclusively enable or specifically disable.
The sense of the list is negated if it begins with the symbol 'not'.
Set this variable before you load hilit19.
Ex: (perl-mode jargon-mode c-mode) ; just perl, C, and jargon modes
(not text-mode) ; all modes except text mode")
(defvar hilit-parser-alist nil
"alist of major-mode values and parsers called by hilit-rehighlight-buffer.
Parsers for a given mode are IGNORED for partial rehighlights...maybe you'd
like to make this more universal?")
(defvar hilit-patterns-alist nil
"alist of major-mode values and default highlighting patterns
A highlighting pattern is a list of the form (start end face), where
start is a regex, end is either a regex or a match number for start, and face
is the name of an entry in hilit-face-translation-table, the name of a face,
or nil (which disables the pattern).
Each entry in the alist is of the form:
(mode . (case-fold pattern [pattern ...]))
See the hilit-lookup-face-create documentation for valid face names.")
(defvar hilit-predefined-face-list (face-list)
"List of faces with which hilit-lookup-face-create will NOT tamper.
If hilit19 is dumped into emacs at your site, you may have to set this in
your init file.")
(eval-when-compile (require 'reporter))
(defun hilit-submit-feedback ()
"Submit feedback on hilit19 to hilit@hackvan.com"
(interactive)
(require 'reporter)
(and (y-or-n-p "Do you really want to submit a report on hilit19? ")
(reporter-submit-bug-report
"Jonathan Stigelman <hilit@hackvan.com>"
"hilit19.el (Release 2.19)"
(and (y-or-n-p "Do you need to include a dump hilit variables? ")
(append
'(
hilit-quietly hilit-inhibit-hooks
hilit-background-mode hilit-mode-enable-list
hilit-auto-highlight hilit-auto-highlight-maxout
hilit-auto-rehighlight hilit-auto-rehighlight-fallback
hilit-face-check
)
(and (y-or-n-p "Have you modified the standard patterns? ")
(yes-or-no-p "Are your patterns *REALLY* relevant? ")
'(hilit-parser-alist
hilit-patterns-alist
hilit-predefined-face-list
))))
(function
(lambda ()
(and (y-or-n-p "Is this a problem with font display? ")
(insert "\nFrame Configuration:\n====================\n"
(prin1-to-string (frame-configuration-to-register ?F))
"\n"
))))
nil
(concat
"This is (check all that apply, and delete what's irrelevant):\n"
" [ ] a _MASSIVE_THANK_YOU_ for writing hilit19.el\n"
" [ ] An invitation to attend the next Hackers Conference\n"
" [ ] You're a RIGHTEOUS HACKER, what are your rates?\n"
" [ ] I've used the force and read the source, but I'M CONFUSED\n"
" [ ] a PATCH. (output of 'diff -uw old.el new.el' or 'diff -cw')\n"
" [ ] a SERIOUS AND REPRODUCIBLE BUG that is not an EMACS bug\n"
" - I *swear* that it's not already mentioned in the KNOWN BUGS\n"
" - I HAVE CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hilit19.el.gz\n"
" for a newer release that fixes the problem.\n"
" >> I HAVE ALSO CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hl319.el.gz\n"
" This is the alpha version...what will become hilit19 (Beta 3.0).\n"
"\n"
"Hey Stig, I *know* you're busy but...\n"))))
(defconst hilit-default-face-table
'(
(comment firebrick-italic moccasin italic)
(include purple Plum1 bold-italic)
(define ForestGreen-bold green bold)
(defun blue-bold cyan-bold bold-italic)
(decl RoyalBlue cyan bold)
(type nil yellow nil)
(keyword RoyalBlue cyan bold-italic)
(label red-underline orange-underlined underline)
(string grey40 orange underline)
(struct black-bold white-bold bold)
(glob-struct magenta Plum1 default-bold-underline)
(named-param DarkGoldenrod Goldenrod underline)
(crossref DarkGoldenrod Goldenrod underline)
(formula Goldenrod DarkGoldenrod underline)
(active-error default/pink-bold default/DeepPink-bold default-underline)
(error red-bold yellow bold)
(warning blue-italic green italic)
(rule blue-bold-underline cyan-underline default-bold-underline)
(msg-subject blue-bold yellow bold)
(msg-from purple-bold green bold)
(msg-header firebrick-bold cyan italic)
(msg-separator black/tan-bold black/lightblue nil)
(msg-quote ForestGreen pink italic)
(summary-seen grey40 white nil)
(summary-killed grey50 white nil)
(summary-Xed OliveDrab2 green nil)
(summary-deleted firebrick white italic)
(summary-unread RoyalBlue yellow bold)
(summary-new blue-bold yellow-bold bold-italic)
(summary-current default/skyblue-bold green/dimgrey-bold reverse-default)
(gnus-group-unsubscribed grey50 white nil)
(gnus-group-empty nil nil nil)
(gnus-group-full ForestGreen green italic)
(gnus-group-overflowing firebrick red bold-italic)
(dired-directory blue-bold cyan bold)
(dired-link firebrick-italic green italic)
(dired-ignored ForestGreen moccasin nil)
(dired-deleted red-bold-italic orange bold-italic)
(dired-marked purple Plum1 nil)
(jargon-entry blue-bold cyan bold)
(jargon-xref purple-bold Plum1 italic)
(jargon-keyword firebrick-underline yellow underline)
)
"alist of default faces (face . (light-default dark-default mono-default))
There is no way for the user to modify this table such that it will have any
effect upon the translations used by hilit19. Instead, use the function
hilit-translate AFTER hilit19 has been loaded.
See also the documentation for hilit-lookup-face-create.")
(defconst hilit-face-translation-table
(let ((index (or (and (x-display-color-p)
(cdr (assq hilit-background-mode
'((light . 1) (dark . 2)))))
3)))
(mapcar (function (lambda (x) (cons (car x) (nth index x))))
hilit-default-face-table))
"alist that maps symbolic face-names to real face names")
(defmacro hilit-translate (&rest args)
"(hilit-translate FROM TO FROM TO ...): translate each face FROM to the
value of its TO face. This is like setq for faces.
The function hilit-lookup-face-create will repeatedly translate until no more
translations for the face exist in the translation table.
See the documentation for hilit-lookup-face-create for names of valid faces."
(or (zerop (% (length args) 2))
(error "wrong number of args"))
(let (cmdl from to)
(while args
(setq from (car args) to (nth 1 args) args (nthcdr 2 args)
cmdl (cons (list 'hilit-associate ''hilit-face-translation-table
(list 'quote from) to)
cmdl)))
(cons 'progn cmdl)))
(defun hilit-lookup-face-create (face &optional force)
"Get a FACE, or create it if it doesn't exist. In order for it to
properly create the face, the following naming convention must be used:
[reverse-](fgcolor[/bgcolor])[-bold][-italic][-underline]
Example: (hilit-lookup-face-create 'comment-face) might create and return 'red
Each color is either the name of an X color (see .../X11/lib/X11/rgb.txt),
a hexadecimal specification of the form \"hex-[0-9A-Fa-f]+\", or \"default\".
An optional argument, FORCE, will cause the face to be recopied from the
default...which is probably of use only if you've changed fonts.
See the documentation for hilit-translate and hilit-face-translation-table."
(let ((trec t) visited)
(while trec
(cond ((memq face visited) (error "face translation loop: %S" visited))
(t (setq visited (cons face visited)
trec (assq face hilit-face-translation-table))
(and trec (setq face (cdr trec)))))))
(let* ((fn (symbol-name face))
(frame (selected-frame))
(basefont (cdr (assq 'font (frame-parameters frame))))
error fgcolor bgcolor)
(cond
((or (null face)
(memq face hilit-predefined-face-list))
)
((or force
(not (memq face (face-list)))
(and hilit-face-check
(not (string= (get face 'basefont) basefont))))
(copy-face 'default 'scratch-face)
(if (string-match "^reverse-?" fn)
(progn (invert-face 'scratch-face)
(setq fn (substring fn (match-end 0)))))
(if (string-match "^\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn)
(setq fgcolor (concat
(if (match-beginning 1) "#")
(substring fn (match-beginning 2) (match-end 2)))
fn (substring fn (match-end 0)))
(error "bad face name %S" face))
(if (string-match "^/\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn)
(setq bgcolor (concat
(and (match-beginning 1) "#")
(substring fn (match-beginning 2) (match-end 2)))
fn (substring fn (match-end 0))))
(and (string= "default" fgcolor) (setq fgcolor nil))
(and (string= "default" bgcolor) (setq bgcolor nil))
(condition-case nil
(progn (and fgcolor (set-face-foreground 'scratch-face fgcolor))
(and bgcolor (set-face-background 'scratch-face bgcolor))
(copy-face 'scratch-face face)
(put face 'basefont basefont))
(error (message "couldn't allocate color for '%s'"
(symbol-name face))
(setq face 'default)
(setq error t)))
(or error
(progn
(when (display-graphic-p frame)
(set-face-font face basefont frame))
(set-face-underline-p face (string-match "underline" fn))
(if (string-match ".*bold" fn)
(make-face-bold face nil 'noerr))
(if (string-match ".*italic" fn)
(make-face-italic face nil 'noerr))
))
)))
face)
(defsubst hilit-region-set-face (start end face-name &optional prio prop)
"Highlight region from START to END using FACE and, optionally, PRIO.
The optional 5th arg, PROP is a property to set instead of 'hilit."
(let ((overlay (make-overlay start end)))
(overlay-put overlay 'face face-name)
(overlay-put overlay (or prop 'hilit) t)
(and prio (overlay-put overlay 'priority prio))))
(defun hilit-unhighlight-region (start end &optional quietly)
"Unhighlights the region from START to END, optionally in a QUIET way"
(interactive "r")
(or quietly hilit-quietly (message "Unhighlighting"))
(let ((lstart 0))
(while (and start (> start lstart) (< start end))
(mapcar (function (lambda (ovr)
(and (overlay-get ovr 'hilit) (delete-overlay ovr))))
(overlays-at start))
(setq lstart start start (next-overlay-change start))))
(or quietly hilit-quietly (message "Done unhighlighting")))
(defun hilit-highlight-region (start end &optional patterns quietly)
"Highlights the area of the buffer between START and END (the region when
interactive). Without the optional PATTERNS argument, the pattern for
major-mode is used. If PATTERNS is a symbol, then the patterns associated
with that symbol are used. QUIETLY suppresses progress messages if
non-nil."
(interactive "r")
(cond ((null patterns)
(setq patterns (cdr (assq major-mode hilit-patterns-alist))))
((symbolp patterns)
(setq patterns (cdr (assq patterns hilit-patterns-alist)))))
(let ((case-fold-search (car patterns))
(prio (1- (length patterns)))
p pstart pend face mstart (puke-count 0))
(setq patterns (cdr patterns)) (save-excursion
(save-restriction
(narrow-to-region start end)
(while patterns
(setq p (car patterns))
(setq pstart (car p)
pend (nth 1 p)
face (hilit-lookup-face-create (nth 2 p)))
(if (not face) nil
(or quietly hilit-quietly
(message "highlighting %d: %s%s" prio pstart
(if (stringp pend) (concat " ... " pend) "")))
(goto-char (point-min))
(condition-case msg
(cond
((symbolp pstart)
(let (region)
(while (setq region (funcall pstart pend))
(hilit-region-set-face (car region) (cdr region)
face prio))))
((stringp pend)
(while (re-search-forward pstart nil t nil)
(goto-char (setq mstart (match-beginning 0)))
(if (re-search-forward pend nil t nil)
(hilit-region-set-face mstart (match-end 0)
face prio)
(forward-char 1))))
((numberp pend)
(while (re-search-forward pstart nil t nil)
(goto-char (match-end pend))
(hilit-region-set-face (match-beginning pend)
(match-end pend) face prio)))
(t (error "malformed pattern")))
(error (if (> (setq puke-count (1+ puke-count)) 1)
(error msg)
(message "Error: '%s'" msg)
(ding) (sit-for 4)))))
(setq prio (1- prio)
patterns (cdr patterns)))
))
(or quietly hilit-quietly (message "")) ))
(defun hilit-rehighlight-region (start end &optional quietly)
"Re-highlights the region, optionally in a QUIET way"
(interactive "r")
(save-restriction
(widen)
(setq start (apply 'min start (mapcar 'overlay-start (overlays-at start)))
end (apply 'max end (mapcar 'overlay-end (overlays-at end))))
(hilit-unhighlight-region start end quietly)
(hilit-highlight-region start end nil quietly)))
(defun hilit-rehighlight-buffer (&optional quietly)
"Re-highlights the buffer, optionally in a QUIET way"
(interactive "")
(let ((parse-fn (cdr (assq major-mode hilit-parser-alist))))
(if parse-fn
(funcall parse-fn quietly)
(hilit-rehighlight-region (point-min) (point-max) quietly)))
nil)
(defun hilit-rehighlight-buffer-quietly ()
(hilit-rehighlight-buffer t))
(defun hilit-rehighlight-message (quietly)
"Highlight a buffer containing a news article or mail message."
(save-excursion
(goto-char (point-min))
(re-search-forward "^\\(\\|--text follows this line--\\)$" nil 'noerr)
(hilit-unhighlight-region (point-min) (point-max) quietly)
(hilit-highlight-region (point-min) (point) 'msg-header quietly)
(hilit-highlight-region (point) (point-max) 'msg-body quietly)))
(defalias 'hilit-highlight-buffer 'hilit-rehighlight-buffer)
(defun hilit-find-file-hook ()
"Find-file hook for hilit package. See the variable hilit-auto-highlight."
(cond ((and hilit-auto-highlight
(assq major-mode hilit-patterns-alist))
(if (> buffer-saved-size (car hilit-auto-rehighlight-fallback))
(setq hilit-auto-rehighlight
(cdr hilit-auto-rehighlight-fallback)))
(if (> buffer-saved-size hilit-auto-highlight-maxout)
nil
(let ((bm (buffer-modified-p)))
(hilit-rehighlight-buffer)
(set-buffer-modified-p bm))))))
(defun hilit-repaint-command (arg)
"Rehighlights according to the value of hilit-auto-rehighlight, or the
prefix argument if that is specified.
\t\\[hilit-repaint-command]\t\trepaint according to hilit-auto-rehighlight
\t^U \\[hilit-repaint-command]\trepaint entire buffer
\t^U - \\[hilit-repaint-command]\trepaint visible portion of buffer
\t^U n \\[hilit-repaint-command]\trepaint n lines to either side of point"
(interactive "P")
(let (st en quietly)
(or arg (setq arg hilit-auto-rehighlight))
(cond ((or (eq arg 'visible) (eq arg '-))
(setq st (window-start) en (window-end) quietly t))
((numberp arg)
(setq st (save-excursion (forward-line (- arg)) (point))
en (save-excursion (forward-line arg) (point))))
(arg
(hilit-rehighlight-buffer)))
(if st
(hilit-rehighlight-region st en quietly))))
(defun hilit-recenter (arg)
"Recenter, then rehighlight according to hilit-auto-rehighlight. If called
with an unspecified prefix argument (^U but no number), then a rehighlight of
the entire buffer is forced."
(interactive "P")
(recenter arg)
(sit-for 0)
(hilit-repaint-command (consp arg)))
(defun hilit-yank (arg)
"Yank with rehighlighting"
(interactive "*P")
(let ((transient-mark-mode nil))
(yank arg)
(and hilit-auto-rehighlight
(hilit-rehighlight-region (region-beginning) (region-end) t))
(setq this-command 'yank)))
(defun hilit-yank-pop (arg)
"Yank-pop with rehighlighting"
(interactive "*p")
(let ((transient-mark-mode nil))
(yank-pop arg)
(and hilit-auto-rehighlight
(hilit-rehighlight-region (region-beginning) (region-end) t))
(setq this-command 'yank)))
(define-minor-mode hilit-mode
"Obsolete minor mode. Use `global-font-lock-mode' instead."
:global t
(unless (and hilit-inhibit-rebinding hilit-mode)
(substitute-key-definition
(if hilit-mode 'yank 'hilit-yank)
(if hilit-mode 'hilit-yank 'yank)
(current-global-map))
(substitute-key-definition
(if hilit-mode 'yank-pop 'hilit-yank-pop)
(if hilit-mode 'hilit-yank-pop 'yank-pop)
(current-global-map))
(substitute-key-definition
(if hilit-mode 'recenter 'hilit-recenter)
(if hilit-mode 'hilit-recenter 'recenter)
(current-global-map)))
(if hilit-mode
(global-set-key [?\C-\S-l] 'hilit-repaint-command)
(global-unset-key [?\C-\S-l]))
(if hilit-mode
(add-hook 'find-file-hook 'hilit-find-file-hook t)
(remove-hook 'find-file-hook 'hilit-find-file-hook))
(unless (and hilit-inhibit-hooks hilit-mode)
(condition-case c
(progn
(mapcar (lambda (hook)
(if hilit-mode
(add-hook hook 'hilit-rehighlight-buffer-quietly)
(remove-hook hook 'hilit-rehighlight-buffer-quietly)))
'(
Info-selection-hook
vm-summary-pointer-hook
vm-preview-message-hook
vm-show-message-hook
rmail-show-message-hook
mail-setup-hook
mh-show-mode-hook
dired-after-readin-hook
))
)
(error (message "Error loading highlight hooks: %s" c)
(ding) (sit-for 1)))))
(eval-when-compile (require 'gnus))
(setq hilit-patterns-alist nil)
(defun hilit-associate (alist key val)
"creates, or destructively replaces, the pair (key . val) in alist"
(let ((oldentry (assq key (eval alist))))
(if oldentry
(setcdr oldentry val)
(set alist (cons (cons key val) (eval alist))))))
(defun hilit-set-mode-patterns (modelist patterns
&optional parse-fn case-fold)
"Sets the default highlighting patterns for MODE to PATTERNS.
See the variable hilit-mode-enable-list.
Takes optional arguments PARSE-FN and CASE-FOLD."
(mapcar (function (lambda (p)
(and (stringp (car p))
(null (nth 1 p))
(setcar (cdr p) 0))))
patterns)
(setq patterns (cons case-fold patterns))
(or (consp modelist) (setq modelist (list modelist)))
(let (ok (flip (eq (car hilit-mode-enable-list) 'not)))
(mapcar (function
(lambda (m)
(setq ok (or (null hilit-mode-enable-list)
(memq m hilit-mode-enable-list)))
(and flip (setq ok (not ok)))
(and ok
(progn
(and parse-fn
(hilit-associate 'hilit-parser-alist m parse-fn))
(hilit-associate 'hilit-patterns-alist m patterns)))))
modelist)))
(defun hilit-add-pattern (pstart pend face &optional mode first)
"Highlight pstart with face for the current major-mode.
Optionally, place the new pattern first in the pattern list"
(interactive "sPattern start regex: \nsPattern end regex (default none): \nxFace: ")
(and (equal pstart "") (error "Must specify starting regex"))
(cond ((equal pend "") (setq pend 0))
((string-match "^[0-9]+$" pend) (setq pend (string-to-number pend))))
(or mode (setq mode major-mode))
(let ((old-patterns (cdr (assq mode hilit-patterns-alist)))
(new-pat (list pstart pend face)))
(cond ((not old-patterns)
(hilit-set-mode-patterns mode (list new-pat)))
(first
(setcdr old-patterns (cons new-pat (cdr old-patterns))))
(t
(nconc old-patterns (list new-pat)))))
(and (interactive-p) (hilit-rehighlight-buffer)))
(defun hilit-string-find (qchar)
"Looks for a string and returns (start . end) or nil. The argument QCHAR
is the character that would precede a character constant double quote.
Finds strings delimited by double quotes. The first double quote may not be
preceded by QCHAR and the closing double quote may not be preceded by an odd
number of backslashes."
(let (st en)
(while (and (search-forward "\"" nil t)
(eq qchar (char-after (1- (setq st (match-beginning 0)))))))
(while (and (search-forward "\"" nil t)
(save-excursion
(setq en (point))
(forward-char -1)
(skip-chars-backward "\\\\")
(forward-char 1)
(not (zerop (% (- en (point)) 2))))))
(and en (cons st en))))
(let ((comments '(("/\\*" "\\*/" comment)))
(c++-comments '(("//.*$" nil comment)
("^/.*$" nil comment)))
(strings '((hilit-string-find ?' string)))
(preprocessor '(("^#[ \t]*\\(undef\\|define\\).*$" "[^\\]$" define)
("^#.*$" nil include))))
(hilit-set-mode-patterns
'(c-mode c++-c-mode elec-c-mode)
(append
comments strings preprocessor
'(
("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl)
("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type)
("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>[^_]" 1 keyword)
)))
(hilit-set-mode-patterns
'c++-mode
(append
comments c++-comments strings preprocessor
'(
("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl)
("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type)
("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>[^_]"
1 keyword))))
(hilit-set-mode-patterns
'(objc-mode objective-C-mode)
(append
comments c++-comments strings preprocessor
'(
("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl)
("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type)
("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|interface\\|implementation\\|end\\|super\\|self\\)\\>[^_]"
1 keyword))))
)
(hilit-set-mode-patterns
'perl-mode
'(("\\s #.*$" nil comment)
("^#.*$" nil comment)
("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string)
("^\\(__....?__\\|\\s *\\sw+:\\)" nil label)
("^require.*$" nil include)
("^package.*$" nil decl)
("^\\s *sub\\s +\\(\\w\\|[_']\\)+" nil defun)
("\\b\\(do\\|if\\|unless\\|while\\|until\\|else\\|elsif\\|for\\|foreach\\|continue\\|next\\|redo\\|last\\|goto\\|return\\|die\\|exit\\)\\b" nil keyword)))
(hilit-set-mode-patterns
'ada-mode
'( ("--.*$" nil comment)
("[ \t\n]procedure[ \t]" "\\([ \t]\\(is\\|renames\\)\\|);\\)" glob-struct)
("[ \t\n]task[ \t]" "[ \t]is" glob-struct)
("[ \t\n]function[ \t]" "return[ \t]+[A-Za-z_0-9]+[ \t]*\\(is\\|;\\|renames\\)" glob-struct)
("[ \t\n]package[ \t]" "[ \t]\\(is\\|renames\\)" glob-struct)
("^[ \t]*private[ \t\n]" nil glob-struct)
("^end.*$" ";" glob-struct)
("[ \n\t]\\(in\\|out\\|select\\|if\\|else\\|case\\|when\\|and\\|or\\|not\\|accept\\|loop\\|do\\|then\\|elsif\\|else\\|for\\|while\\|exit\\)[ \n\t;]" nil struct)
("[ \n\t]\\(begin\\|end\\|declare\\|exception\\|generic\\|raise\\|return\\|package\\|body\\)[ \n\t;]" nil struct)
("^[ \t]*\\(type\\|subtype\\).*$" ";" decl)
("[ \t]+is record.*$" "end record;" decl)
("^[ \t]*\\(with\\|pragma\\|use\\)" ";" include)
("[A-Za-z_0-9.]+[ \t]*=>" nil named-param)
("\"" ".*\"" string)))
(hilit-set-mode-patterns
'fortran-mode
'(("^[*Cc].*$" nil comment)
("'[^'\n]*'" nil string)
("\\(^[ \t]*[0-9]+\\|[ \t]continue[ \t\n]\\|format\\)" nil define)
("[ \t]\\(do\\|do[ \t]*[0-9]+\\|go[ \t]*to[ \t]*[0-9]+\\|end[ \t]*do\\|if\\|else[ \t]*if\\|then\\|else\\|end[ \t]*if\\)[ \t\n(]" nil define)
("[ \t]\\(call\\|program\\|subroutine\\|function\\|stop\\|return\\|end\\|include\\)[ \t\n]" nil include)
("[ \t]\\(parameter[\t\n ]*([^)]*)\\|data\\|save\\|common[ \t\n]*/[^/]*/\\)"
nil decl)
("^ ." nil type)
("implicit[ \t]*none" nil decl)
("\\([ \t]\\|implicit[ \t]*\\)\\(dimension\\|integer\\|real\\|double[ \t]*precision\\|character\\|logical\\|complex\\|double[ \t]*complex\\)\\([*][0-9]*\\|[ \t\n]\\)" nil keyword)
)
nil 'case-insensitive)
(hilit-set-mode-patterns
'(m2-mode modula-2-mode)
'(("(\\*" "\\*)" comment)
(hilit-string-find ?\\ string)
("^[ \t]*PROCEDURE[ \t]+\\w+[^ \t(;]*" nil defun)
("\\<\\(RECORD\\|ARRAY\\|OF\\|POINTER\\|TO\\|BEGIN\\|END\\|FOR\\|IF\\|THEN\\|ELSE\\|ELSIF\\|CASE\\|WHILE\\|DO\\|MODULE\\|FROM\\|RETURN\\|IMPORT\\|EXPORT\\|VAR\\|LOOP\\|UNTIL\\|\\DEFINITION\\|IMPLEMENTATION\\|AND\\|OR\\|NOT\\|CONST\\|TYPE\\|QUALIFIED\\)\\>" nil keyword)
)
nil 'case-insensitive)
(hilit-set-mode-patterns 'prolog-mode
'(("/\\*" "\\*/" comment)
("%.*$" nil comment)
(":-" nil defun)
("!" nil label)
("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string)
("\\b\\(is\\|mod\\)\\b" nil keyword)
("\\(->\\|-->\\|;\\|==\\|\\\\==\\|=<\\|>=\\|<\\|>\\|=\\|\\\\=\\|=:=\\|=\\\.\\\.\\|\\\\\\\+\\)" nil decl)
("\\(\\\[\\||\\|\\\]\\)" nil include)))
(hilit-set-mode-patterns
'(
LaTeX-mode japanese-LaTeX-mode SliTeX-mode
japanese-SliTeX-mode FoilTeX-mode latex-mode
)
'(
("[^\\]%.*$" nil comment)
("\\\\\\(sub\\)*\\(paragraph\\|section\\)\\(\*\\|\\[.*\\]\\)?{" "}"
keyword)
("\\\\\\(chapter\\|part\\)\\(\*\\|\\[.*\\]\\)?{" "}" keyword)
("\\\\footnote\\(mark\\|text\\)?{" "}" keyword)
("\\\\[a-z]+box" nil keyword)
("\\\\\\(v\\|h\\)space\\(\*\\)?{" "}" keyword)
("\\\\\\(re\\)?new\\(environment\\|command\\){" "}" defun)
("\\\\new\\(length\\|theorem\\|counter\\){" "}" defun)
("\\\\\\(setlength\\|settowidth\\|addtolength\\|setcounter\\|addtocounter\\)" nil define)
("\\\\\\(title\\|author\\|date\\|thanks\\){" "}" define)
("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl)
("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl)
("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" nil
decl)
("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl)
("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" nil decl)
("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b"
nil decl)
("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" nil decl)
("\\\\item\\(\\[[^]]*\\]\\)?" nil label)
("\\\\caption\\(\\[[^]]*\\]\\)?{" "}" label)
("[^\\]\\\\(" "\\\\)" formula) ("[^\\]\\\\\\[" "\\\\\\]" formula) ("[^\\$]\\(\\$\\(\\$[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula)
("\\\\\\(include\\|input\\|bibliography\\){" "}" include)
("``" "''" string)
("\\\\\\(\\(no\\)?cite\\|\\(page\\)?ref\\|label\\|index\\|glossary\\){" "}" crossref)
))
(hilit-set-mode-patterns
'bibtex-mode
'( ("%.*$" nil comment)
("@[a-zA-Z]+" nil keyword)
("{[ \t]*[-a-z:_A-Z0-9]+," nil label) ("^[ \t]*[a-zA-Z]+[ \t]*=" nil define)))
(hilit-set-mode-patterns
'compilation-mode
'(
("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+: warning:.*$" nil warning)
("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+:.*$" nil error)
))
(hilit-set-mode-patterns
'makefile-mode
'(("^#.*$" nil comment)
("[^$]#.*$" nil comment)
("^[^ \t\n]*%[^ \t\n]*[ \t]*::?[ \t]*[^ \t\n]*[ \t]*\\(#.*\\)?$" nil rule)
("^[.][A-Za-z][A-Za-z]?\..*$" nil rule)
("^[_A-Za-z0-9]+[ \t]*\+?=" nil define)
("\\( \\|:=\\)[_A-Za-z0-9]+[ \t]*\\+=" nil define)
("\\$\\([^ \t\n{(]\\|[{(]@?[_A-Za-z0-9:.,%/=]+[)}]\\)" nil keyword)
("^[A-Za-z0-9.,/_-]+[ \t]*:.*$" nil defun)
("^include " nil include)))
(let* ((header-patterns '(("^Subject:.*$" nil msg-subject)
("^From:.*$" nil msg-from)
("^--text follows this line--$" nil msg-separator)
("^[A-Za-z][A-Za-z0-9-]+:" nil msg-header)))
(body-patterns '(("^\\(In article\\|[ \t]*\\w*[]<>}|]\\).*$"
nil msg-quote)))
(message-patterns (append header-patterns body-patterns)))
(hilit-set-mode-patterns 'msg-header header-patterns)
(hilit-set-mode-patterns 'msg-body body-patterns)
(hilit-set-mode-patterns '(vm-mode text-mode mail-mode rmail-mode
gnus-article-mode news-reply-mode mh-show-mode)
message-patterns
'hilit-rehighlight-message))
(hilit-set-mode-patterns
'gnus-group-mode
'(("^ U.*$" nil gnus-group-unsubscribed)
("^\\*? +[01]?[0-9]:.*$" nil gnus-group-empty)
("^ +[2-9][0-9]:.*$" nil gnus-group-full)
("^ +[0-9][0-9][0-9]+:.*$" nil gnus-group-overflowing)))
(hilit-set-mode-patterns
'vm-summary-mode
'(("^ .*$" nil summary-seen)
("^->.*$" nil summary-current)
("^ D.*$" nil summary-deleted)
("^ U.*$" nil summary-unread)
("^ N.*$" nil summary-new)))
(hilit-set-mode-patterns
'(emacs-lisp-mode lisp-interaction-mode)
'(
(";.*" nil comment)
(hilit-string-find ?\\ string)
("^\\s *(def\\(un\\|macro\\|advice\\|alias\\|subst\\)[ \t\n]"
"\\()\\|nil\\)" defun)
("^\\s *(defvar\\s +\\S +" nil decl)
("^\\s *(defconst\\s +\\S +" nil define)
("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include)
("\\s *\\&\\(rest\\|optional\\)\\s *" nil keyword)
("(\\(let\\*?\\|cond\\|if\\|or\\|and\\|map\\(car\\|concat\\)\\|prog[n1*]?\\|while\\|lambda\\|function\\|set\\([qf]\\|car\\|cdr\\)?\\|nconc\\|eval-when-compile\\|condition-case\\|unwind-protect\\|catch\\|throw\\|error\\)[ \t\n]" 1 keyword)
))
(hilit-set-mode-patterns
'(lisp-mode ilisp-mode)
'(
(";.*" nil comment)
("#|" "|#" comment)
(hilit-string-find ?\\ string)
("^\\s *(def\\(un\\|macro\\|advice\\|subst\\|method\\)\\s " "\\()\\|nil\\)" defun)
("^\\s *(\\(def\\(var\\|type\\|parameter\\)\\|declare\\)\\s +\\S +" nil decl)
("^\\s *(def\\(const\\(ant\\)?\\|class\\|struct\\)\\s \\S +[ \t\n]+" nil define)
("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include)
("[ \t]\\&\\(key\\|rest\\|optional\\|aux\\)\\s *" nil keyword)
("(\\(let\\*?\\|locally\\|cond\\|if\\*?\\|or\\|and\\|map\\(car\\|c[ao]n\\)?\\|prog[nv1*]?\\|while\\|when\\|unless\\|do\\(\\*\\|list\\|times\\)\\|list\\|lambda\\|function\\|values\\|set\\([qf]\\|car\\|cdr\\)?\\|rplac[ad]\\|nconc\\|block\\|go\\|return\\(-from\\)?\\|[ec]?\\(type\\)?case\\|multiple-value-\\(bind\\|setq\\|list\\|call\\|prog1\\)\\|unwind-protect\\|handler-case\\|catch\\|throw\\|eval-when\\(-compile\\)?\\)[ \t\n]" 1 keyword)
))
(hilit-set-mode-patterns
'plain-tex-mode
'(("^%%.*$" nil comment)
("{\\\\em\\([^}]+\\)}" nil comment)
("\\(\\\\\\w+\\)" nil keyword)
("{\\\\bf\\([^}]+\\)}" nil keyword)
("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun)
("\\\\\\(begin\\|end\\){\\([A-Za-z0-9\\*]+\\)}" nil defun)
("\\$\\([^$]*\\)\\$" nil string)
))
(hilit-set-mode-patterns
'nroff-mode
'(("^\\.[\\\][\\\"].*$" nil comment)
("^\\.so .*$" nil include)
("^\\.[ST]H.*$" nil defun)
("\"" "[^\\]\"" string)
("^\\.[A-Z12\\\\].*$" nil define)
("\\([\\\][^ ]*\\)" nil keyword)
("^\\.[A-Z].*$" nil keyword))
nil 'case-insensitive)
(hilit-set-mode-patterns
'texinfo-mode
'(("^\\(@c\\|@comment\\)\\>.*$" nil comment)
("@\\(emph\\|strong\\|b\\|i\\){[^}]+}" nil comment)
("@\\(file\\|kbd\\|key\\){[^}]+}" nil string)
("^\\*.*$" nil defun)
("@\\(if\\w+\\|format\\|item\\)\\b.*$" nil defun)
("@end +[A-Za-z0-9]+[ \t]*$" nil defun)
("@\\(samp\\|code\\|var\\){[^}]+}" nil defun)
("@\\w+\\({[^}]+}\\)?" nil keyword)
))
(hilit-set-mode-patterns
'dired-mode
(append
'(("^D.*$" nil dired-deleted)
("^\\*.*$" nil dired-marked)
("^ d.*$" nil dired-directory)
("^ l.*$" nil dired-link)
("^ -.*#.*#$" nil dired-ignored))
(list (cons
(concat "^ .*\\("
(mapconcat 'regexp-quote completion-ignored-extensions "\\|")
"\\)$")
'(nil dired-ignored)))))
(hilit-set-mode-patterns
'jargon-mode
'(("^:[^:]*:" nil jargon-entry)
("{[^}]*}+" nil jargon-xref)))
(hilit-set-mode-patterns
'Info-mode
'(("^\\* [^:]+:+" nil jargon-entry)
("\\*[Nn]ote\\b[^:]+:+" nil jargon-xref)
(" \\(Next\\|Prev\\|Up\\):" nil jargon-xref)
("- \\(Variable\\|Function\\|Macro\\|Command\\|Special Form\\|User Option\\):.*$"
nil jargon-keyword)))
(hilit-set-mode-patterns
'calendar-mode
'(("[A-Z][a-z]+ [0-9]+" nil define) ("S M Tu W Th F S" nil label)))
(hilit-set-mode-patterns
'asm-mode
'(("/\\*" "\\*/" comment)
("^#[ \t]*\\(undef\\|define\\).*$" "[^\\]$" define)
("^#.*$" nil include)
("^.+:" nil defun)
("^[ \t]*\\..*$" nil decl)
("\\$[a-z0-9]+" nil string)
("^[ \t]*[a-z]+" nil struct)))
(hilit-set-mode-patterns
'pascal-mode
'(("(\\*" "\\*)" comment)
("{" "}" comment)
("^#.*$" nil include)
("^[ \t]*\\(procedure\\|function\\)[ \t]+\\w+[^ \t(;]*" nil defun)
("\\<\\(program\\|begin\\|end\\)\\>" nil defun)
("\\<\\(external\\|forward\\)\\>" nil include)
("\\<\\(label\\|const\\|type\\|var\\)\\>" nil define)
("\\<\\(record\\|array\\|file\\)\\>" nil type)
("\\<\\(of\\|to\\|for\\|if\\|then\\|else\\|case\\|while\\|do\\|until\\|and\\|or\\|not\\|with\\|repeat\\)\\>" nil keyword)
)
nil 'case-insensitive)
(hilit-set-mode-patterns
'icon-mode
'(("#.*$" nil comment)
("\"[^\\\"]*\\(\\\\.[^\\\"]*\\)*\"" nil string)
("^[ \t]*procedure[ \t]+\\w+[ \t]*(" ")" defun)
("^[ \t]*record.*(" ")" include)
("^[ \t]*\\(global\\|link\\)[ \t\n]+[A-Za-z_0-9]+\\([ \t\n]*,[ \t\n]*[A-Za-z_0-9]+\\)*" nil include)
("^[ \t]*\\(local\\|static\\)[ \t\n]+[A-Za-z_0-9]+\\([ \t\n]*,[ \t\n]*[A-Za-z_0-9]+\\)*" nil decl)
("\\<\\(initial\\|end\\)\\>" nil glob-struct)
("\\<\\(while\\|until\\|return\\|every\\|if\\|then\\|else\\|to\\|case\\|of\\|suspend\\|create\\|do\\|repeat\\|break\\)\\>" nil keyword)
))
(provide 'hilit19)