;;
;; hilit19.el v1.2 Copyright (C) 1993 Jonathan Stigelman <Stig@netcom.com> 
;;
;; A package allowing customizable highlighting of Emacs19 buffers.
;;
;; Author: Jonathan Stigelman <Stig@netcom.com>
;;
;; Other contributors:
;;   ebert@enpc.enpc.fr (Rolf EBERT)
;;   Vivek Khera <khera@cs.duke.edu>
;;
;; Created in true "stone soup" fashion (i.e.: 100% rewritten) from:
;;   hilit v1.3 by pnakada@oracle.com, later modified by dliu@ace.njit.edu
;;

;;; This file seems like it might become part of GNU Emacs.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY.  No author or distributor
;;; accepts responsibility to anyone for the consequences of using it
;;; or for whether it serves any particular purpose or works at all,
;;; unless he says so in writing.  Refer to the GNU Emacs General Public
;;; License for full details.
;;;
;;; Everyone is granted permission to copy, modify and redistribute
;;; GNU Emacs, but only under the conditions described in the
;;; GNU Emacs General Public License.   A copy of this license is
;;; supposed to have been given to you along with GNU Emacs so you
;;; can know your rights and responsibilities.  It should be in a
;;; file named COPYING.  Among other things, the copyright notice
;;; and this notice must be preserved on all copies.
;;;

;; LCD Archive Entry:
;; hilit19|Jonathan Stigelman|Stig@netcom.com|
;; Mode switched highlighting of regions of buffers with colors and fonts.|
;; 93-06-23|v1.2|~/emacs19/hilit19.el.gz|

;; HISTORY 
;; V1.2 28-June-1993		Stig@netcom.com
;;   partially fixed bug in hilit-toggle-highlight
;;   added string highlighting
;;   fixed bug in hilit-lookup-face-create
;;   additions for Ada, Tex, LaTeX, and Texinfo (is scribe next? =)
;;   now highlight template decls in C++
;;   added reverse-* intelligence to hilit-lookup-face-create
;;   imported wysiwyg (overstrike replacement) stuff from my hacks to man.el
;;   sketched out a stub of a wysiwyg write file hook, care to finish it?
;; V1.1	25-June-1993		Stig@netcom.com
;;   replaced last vestiges of original hilit.el
;;   now map default modes to major-mode values
;;   reworked face allocation so that colors don't get tied up
;;   rewrote some comments that I'd put in earlier but somehow managed to nuke
;; V1.0 22-June-1993		Stig@netcom.com
;;   incrementally replaced just about everything...simpler, cleaner, & faster
;;   extended highlight coverage for C/C++ modes (highlight more things)
;;   added layer of indirection to face selection

;; GENERAL OVERVIEW
;;
;; This package works as follows
;;
;;      Set the appropriate hooks and watch as your boring black and white
;;      buffers magically become colorful.  Several modes have default
;;      colorings whose colors can be simply redefined without much hassle.
;;      (Make sure that if you redefine the patterns for a given mode, that
;;	you do it after loading this package.)
;;
;;      If, when you edit the buffer, the coloring gets messed up, just
;;      redraw and the coloring will be adjusted.  If automatic highlighting
;;      in the current buffer has been turned off (either because you've
;;      decided to do this or because the buffer is large) then invoking
;;      either redraw-screen or recenter (usually ^L) will highlight the 
;;	area of the buffer that you happen to be viewing.  Giving a prefix
;;	argument to a redraw command will force a rehighlight of the entire
;;	buffer...
;;
;;
;; how to get set up....
;;
;;  (require 'hilit19)		; not intended to be autoloaded
;;  (add-hook 'find-file-hooks 'hilit-highlight-after-find t)
;;
;;  (setq hilit-auto-highlight-maxout 70000) ; set a higher autohighlight max
;;
;; if you want strings to be a different color...
;;
;;  (hilit-associate 'hilit-face-translation-table
;;		     'string-face 'grey-underline)
;;
;; if you want to change the comments in only one mode LOCALLY...
;;
;;  (add-hook 'cookie-mode-hook
;;	      '(lambda () (make-local-variable 'hilit-face-translation-table)
;;			  (setq hilit-face-translation-table
;;				(copy-list hilit-face-translation-table))
;;			  (hilit-associate 'hilit-face-translation-table
;;					   'comment-face 'RolledOats))
;;
;; Yet MORE useful hooks...
;;
;;  (add-hook 'gnus-select-article-hook
;;	      '(lambda () (let ((hilit-quietly t))
;;		 (save-excursion (set-buffer gnus-article-buffer)
;;  				 (hilit-highlight-buffer)))))
;;  (defvar vm-highlight-patterns
;;	    '(("^   .*" nil 'ForestGreen)
;;	      ("^  D.*" nil 'red)
;;	      ("^  N.*" nil 'blue)))
;;  (setq vm-preview-message-hook 
;;	'(lambda () (hilit-rehighlight-region (point-min) (point-max) t)))
;;  (setq vm-show-message-hook 
;;	'(lambda () (hilit-rehighlight-region (point-min) (point-max) t)))
;;  (setq vm-summary-pointer-hook
;;	'(lambda () (hilit-unhighlight-region (point-min) (point-max) t)
;;		    (hilit-highlight-region (point-min) (point-max)
;;					    vm-highlight-patterns t)))
;;
;; you might, though I'm not, also be interested in rehighlighting when you
;; save your buffers:
;;
;;  (add-hook 'write-file-hooks 'hilit-rehighlight nil)

;; BUGS
;;
;; * Emacs19 regular expressions are way slow.  So is the handling of lots
;;   of overlays.  Ergo, so is highlighting of large files.  The variable
;;   hilit-auto-highlight-maxout is used to disable automatic highlighting
;;   of large files.  If you find a way to do highlight and unhighlight more
;;   efficiently, then please let me know.
;;
;; * the default highlighting for text-mode should probably be individually
;;   controllable via hilit-*-face variables.  It's not.
;;
;; * hilit-toggle-highlight is flaky in large buffers where auto-rehighlight
;;   is numeric after toggling twice, it loses it's numeric value
;;
;; * TeX regular expressions seem to be broken.  Somebody want to fix 'em?
;;
;; * Moved hilit-wysiwyg-replace here from my version of man.el, this is not
;;   a bug.  The bug is that I don't have a reverse operation yet...just a stub


(defvar hilit-quietly nil
  "If non-nil, this inhibits progress indicators during highlighting")

(defvar hilit-auto-highlight t
  "T if we should highlight buffers as we find 'em, nil otherwise.")

(defvar hilit-auto-highlight-maxout 50000
  "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 rehighlights the
  whole buffer, and a NUMBER will rehighlight that many lines before and
  after the cursor.")

(defvar hilit-auto-rehighlight-fallback 500
  "Value assigned to hilit-auto-rehighlight when automatic rehighlighting is
turned off in the buffer.") 

;;(defvar hilit-overlay-list nil
;;  "list of overlays in use by the hilit package")
;;(make-variable-buffer-local 'hilit-overlay-list)

(setq-default hilit-auto-highlight hilit-auto-highlight)
(setq-default hilit-auto-rehighlight hilit-auto-rehighlight)

(make-variable-buffer-local 'hilit-auto-highlight)
(make-variable-buffer-local 'hilit-auto-rehighlight)

(defvar hilit-mode-alist nil
  "A-list of major-mode values and default highlighting patterns

A hilighting pattern is a list of the form (start end face), where
start is a regex, end is a regex (or nil if it's not needed) and face
is the name of an entry in hilit-face-translation-table, the name of a face,
or nil (which disables the pattern).

See hilit-face-translation-table hilit-lookup-face-create for valid face names.")

;; These faces are either a valid face name, or nil
;; if you want to change them, you must do so AFTER hilit19 is loaded

(defvar hilit-face-translation-table
  (if (x-display-color-p)
      '(
	;; used for C/C++ and elisp and perl
	(comment-face	. firebrick-italic)
	(include-face	. purple)
	(define-face	. ForestGreen)
	(defun-face	. blue-bold)
	(decl-face	. RoyalBlue)
	(type-face	. nil)
	(keyword-face	. RoyalBlue)
	(label-face	. red-bold)
	(string-face	. grey50)

	;; some further faces for Ada
	(struct-face	. black-bold)
	(glob-struct-face . magenta)
	(named-param-face . DarkGoldenrod)
	
	;; and anotherone for LaTeX
	(crossref-face	. DarkGoldenrod)
 
	;; compilation buffers
	(error-face	. red-bold)
	(warning-face	. firebrick)

	;; Makefiles (some faces borrowed from C/C++ too)
	(rule-face	. blue-bold)

	;; fundamental modes (shell-script comments if you enable them)
	(fund-comment-face	. firebrick-italic)

	;; VM, GNUS and Text mode
	(msg-subject-face	. blue-bold)
	(msg-header-face	. red-bold)
	(msg-quote-face	. ForestGreen)

	;; see jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon*.txt
	(jargon-def-face	. blue-bold)
	(jargon-xref-face	. purple-italic))
    '(
      ;; used for C/C++ and elisp and perl
      (comment-face       . default-italic)
      (include-face       . default-bold-italic)
      (define-face        . default-bold)
      (defun-face         . default-bold-italic)
      (decl-face          . default-bold)
      (type-face          . nil)
      (keyword-face       . default-bold-italic)
      (label-face         . default-underline)
      (string-face        . default-underline)

      ;; some further faces for Ada
      (struct-face	  . default-bold)
      (glob-struct-face   . default-bold-underline)
      (named-param-face   . default-underline)
      
      ;; and another one for LaTeX
      (crossref-face	  . default-underline)

      ;; compilation buffers
      (error-face         . default-bold)
      (warning-face       . default-italic)

      ;; Makefiles (some faces borrowed from C/C++ too)
      (rule-face          . default-bold)

      ;; fundamental modes (shell-script comments if you enable them)
      (fund-comment-face  . default-italic)

      ;; VM, GNUS and Text mode
      (msg-subject-face   . default-bold)
      (msg-header-face    . default-italic)
      (msg-quote-face     . default-italic)

      ;; see jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon*.txt
      (jargon-def-face    . default-bold)
      (jargon-xref-face   . default-italic)))
    "alist that maps symbolic face-names to real face names")

;; Too slow.  Better to have extra overlays sitting around than wait a month 
;; for the find-file hook to highlight the whole buffer.
;;
;; (defun hilit-region-old (start end face-name)
;;   "Hilight regin from START to END using FACE"
;;   (let ((overlays (overlays-at start)))
;;     (if (not (catch 'already-highlighted ;;check previous highlighting
;; 	       (while overlays
;; 		 (if (overlay-get (car overlays) 'highlight)
;; 		     (throw 'already-highlighted t))) ; there is a
;; 						    ; previous highlighting
;; 	       nil))
;; 	;;make sure it is a highlight overlay 
;; 	(let ((overlay (make-overlay start end)))
;; 	  (overlay-put overlay 'face face-name)
;; 	  (overlay-put overlay 'highlight t))))) 

;; (defun hilit-make-face (face color &optional boldp italicp underlinep)
;;   "Define FACE in all frames, allocating COLOR (or using the default color
;; if nil).  Optional arguments BOLDP, ITALICP, and UNDERLINEP set those
;; attributes as well."
;;   (copy-face 'default face)
;;   (if (stringp color) (set-face-foreground face color))
;;   (condition-case nil
;;       (progn 
;; 	(if boldp (make-face-bold face nil 'noerr))
;; 	(if italicp (make-face-italic face nil 'noerr)))
;;     (error nil))
;;   (set-face-underline-p face underlinep)
;;   )

(defun hilit-lookup-face-create (face)
  "Get a FACE, or create it if it doesn't exist.  In order for it to
properly create the face, the followwing naming convention must be used:
	(default|reverse|color)[-bold][-italic][-underline]
Example: (hilit-lookup-face-create 'comment-face) might create and return 'red"
  (let ((trec (assoc face hilit-face-translation-table)))
    (and trec (setq face (cdr trec))))
  (or (not face)
      (memq face (face-list))
      (let ((fn (symbol-name face)) color)
	(copy-face 'default face)
	(string-match "^[A-Za-z0-9]+" fn)
	(setq color (substring fn 0 (match-end 0)))
	(cond ((string= color "default") nil)
	      ((string= color "reverse") (invert-face face))
	      (t (condition-case nil
		     (set-face-foreground face color)
		   (error (message "Warning: couldn't allocate color '%s'"
				   color)))))
	;; this hacks around a bug in files.el (remove it in the future)
	(condition-case nil
	    (progn 
	      (if (string-match "-bold" fn)
		  (make-face-bold face nil 'noerr))
	      (if (string-match "-italic" fn)
		  (make-face-italic face nil 'noerr)))
	  (error nil))
	(set-face-underline-p face (string-match "-underline" fn))))
  face)

(defsubst hilit-region-set-face (start end face-name &optional prio prop)
  "Highlight regin 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-wysiwyg-replace ()
  "Replace overstruck text with normal text that's been overlayed with the 
appropriate text attribute.  Suitable for a find-file hook."
  (save-excursion
    (goto-char (point-min))
    (let ((wysb (hilit-lookup-face-create 'wysiwyg-bold))
	  (wysu (hilit-lookup-face-create 'wysiwyg-underline))
	  (bmod (buffer-modified-p)))
      (while (re-search-forward "\\(.\b.\\)+" nil t)
	(let ((st (match-beginning 0)) (en (match-end 0)))
	  (goto-char st)
	  (if (looking-at "_")
	      (hilit-region-set-face st en wysu nil 'wysiwyg)
	    (hilit-region-set-face st en wysb nil 'wysiwyg))
	  (while (and (< (point) en) (looking-at ".\b"))
	    (replace-match "") (forward-char))
	  ))
      (set-buffer-modified-p bmod))))

; is this more appropriate as a write-file-hook or a write-contents-hook?
(defun hilit-wysiwyg-write-repair ()
  "Replace wysiwyg overlays with overstrike text."
  (message "*sigh* hilit-wysiwyg-write-repair not implemented yet")
;;
;; For efficiency, this hook should copy the current buffer to a scratch
;; buffer and do it's overstriking there.  Overlays are not copied (at least
;; I don't think they are), so it'll be necessary to hop back and forth.
;; This is OK since you're not fiddling with--making or deleting--any overlays.
;; THEN write the new buffer, delete it, and RETURN T. << important
;;
;;  (while (< start end)
;;    (mapcar '(lambda (ovr)
;;	       (and (overlay-get ovr 'hilit) (delete-overlay ovr)))
;;	    (overlays-at start))
;;    (setq start (next-overlay-change start)))
  nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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, default patterns from
hilit-mode-alist are used.  QUIETLY suppresses progress messages if non-nil."
  (interactive "r")
  (if (null patterns)
      (setq patterns (cdr (assoc major-mode hilit-mode-alist))))
  (let ((prio (length patterns)) p pstart pend face mstart)
    (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)		; skipped if nil
	      nil
	    (or quietly (message (concat "highlighting " pstart
					    (if pend " ..." ""))))
	    (goto-char (point-min))
	    (if pend			; INNER LOOP -- keep this tight
		(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)))	; to avoid looping
	      (while (re-search-forward pstart nil t nil)
		(hilit-region-set-face  (match-beginning 0) (match-end 0)
					face prio))))
	  (setq prio (1- prio)
		patterns (cdr patterns)))
	))				
    (or quietly (message "Done highlighting"))
    ))

(defun hilit-highlight-buffer ()
  (interactive)
  (hilit-unhighlight-region (point-min) (point-max) hilit-quietly)
  (hilit-highlight-region (point-min) (point-max) nil hilit-quietly))

(defun hilit-unhighlight-region (start end &optional quietly)
  "Unhighlights the region from START to END, optionally in a QUIET way"
  (interactive "r")
  (or quietly (message "Unhighlighting"))
  (while (< start end)
    (mapcar '(lambda (ovr)
	       (and (overlay-get ovr 'hilit) (delete-overlay ovr)))
	    (overlays-at start))
    (setq start (next-overlay-change start)))
  (or quietly (message "Done unhighlighting")))

(defun hilit-rehighlight-region (start end &optional quietly)
  "Re-highlights the region, optionally in a QUIET way"
  (interactive "r")
  (hilit-unhighlight-region start end quietly)
  (hilit-highlight-region   start end nil quietly))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Find file hook
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun hilit-highlight-after-find ()
  "Hilight current buffer.  Useful as a find-file hook."
  (and hilit-auto-highlight
       (if (> (- (point-max) (point-min)) hilit-auto-highlight-maxout)
	   (progn
	     (message "This buffer is pretty large, highlight it yourself")
	     (setq hilit-auto-highlight nil
		   hilit-auto-rehighlight hilit-auto-rehighlight-fallback))
	 (hilit-highlight-buffer)
	 (set-buffer-modified-p nil))))

(defun hilit-rehighlight (&optional arg)
  "Rehighlight the current buffer.  With arg, unhighlight the current buffer."
  (interactive "P")
  (hilit-unhighlight-region (point-min) (point-max))
  (if (not arg)
      (hilit-highlight-buffer))
  nil)					; so that this can be a write-file-hook

(defun hilit-line-delta (n)
  (save-excursion (forward-line n) (point)))

(defun hilit-redraw-internal (force &rest hooks)
  (cond (force (hilit-highlight-buffer))
	((numberp hilit-auto-rehighlight)
	 (let ((start (hilit-line-delta (- hilit-auto-rehighlight)))
	       (end   (hilit-line-delta hilit-auto-rehighlight)))
	   (hilit-rehighlight-region start end)))
	(hilit-auto-rehighlight (hilit-highlight-buffer)))
  (run-hooks 'hooks))

(defun hilit-recenter (arg)
  "Rehighlights the buffer if called with a prefix arg, or if
hilit-auto-rehighlight is non-nil.  Otherwise just like recenter."
  (interactive "P")
  (hilit-redraw-internal arg 'recenter))

(defun hilit-redraw-display (arg)
  "Rehighlights the buffer if called with a prefix arg, or if
(eval hilit-auto-rehighlight) is non-nil.  Otherwise just like redraw-display."
  (interactive "P")
  (hilit-redraw-internal arg 'redraw-display))

(defun hilit-toggle-highlight (arg)
  "Locally toggle highlighting.  With arg, forces highlighting off."
  (interactive "P")
  (if (setq hilit-auto-highlight
	(and (not arg) (not hilit-auto-highlight)))
      (hilit-rehighlight hilit-auto-highlight)
    (hilit-unhighlight-region (point-min) (point-max)))
  ;; FIXME -- this loses numeric information in hilit-auto-rehighlight
  (setq hilit-auto-rehighlight hilit-auto-highlight) 
  (message (format "Hiliting is %s" (if hilit-auto-highlight "on" "off"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialization.  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(substitute-key-definition 'redraw-display 'hilit-redraw-display
			   (current-global-map))

(substitute-key-definition 'recenter 'hilit-recenter
			   (current-global-map))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Default patterns for various modes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun hilit-associate (alist key val)
  "creates, or destructively replaces, the pair (key . val) in alist"
  (let ((oldentry (assoc key (eval alist))))
    (if oldentry
	(setcdr oldentry val)
      (set alist (cons (cons key val) (eval alist))))))
  
(defun hilit-set-mode-patterns (mode patterns)
  "Sets the default hilighting patterns for MODE to PATTERNS"
  (hilit-associate 'hilit-mode-alist mode patterns))

(let ((c-mode-highlight
      '(("/\\*" "\\*/" comment-face)
	("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string-face)
	;; declaration
	("^#[ \t]*define.*" nil define-face)
	("^#.*" nil include-face)
;	;; function decls are expected to have types on the previous line
;	("^\\sw+\\s *\\(\\sw+\\s *((\\|(\\)[^)]*)" nil defun-face)
; I don't like this style. -ed.
	("^\\(typedef\\|struct\\|union\\|enum\\).*" nil decl-face)
	;; datatype -- black magic regular expression
	("[ \n\t({]\\(\\(register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\sw+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\)\\([ \t]+\\sw*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type-face)
	;; key words
	("[ \n\t({]\\(return\\|if\\|else\\|case\\|default:\\|switch\\|break\\|while\\|do\\|for\\)[ \n\t;(]" nil keyword-face)
	)))
  (hilit-set-mode-patterns 'c-mode c-mode-highlight)
  (hilit-set-mode-patterns 'c++-c-mode c-mode-highlight)
  (hilit-set-mode-patterns 'elec-c-mode c-mode-highlight))

(hilit-set-mode-patterns
 'c++-mode
 '(("/\\*" "\\*/" comment-face)
   ("//.*" nil comment-face)
   ("^/.*" nil comment-face)
   ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string-face)
   ;; declaration	
   ("^#[ \t]*define.*" nil define-face)
   ("^#.*" nil include-face)
   ;; function decls are expected to have types on the previous line
   ("^\\sw+\\s *\\(\\sw+\\s *((\\|(\\)[^)]*)" nil defun-face)
   ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*" nil decl-face)
   ;; datatype -- black magic regular expression
   ("[ \n\t({]\\(\\(register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\sw+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\)\\([ \t]+\\sw*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type-face)
   ;; key words
   ("[ \n\t({]\\(return\\|if\\|else\\|case\\|default:\\|switch\\|break\\|while\\|do\\|for\\)[ \n\t;(]" nil keyword-face)))

(hilit-set-mode-patterns
 'perl-mode
 '(("\\s #.*" nil comment-face)
   ("^#.*" nil comment-face)
   ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string-face)
   ("^\\(__....?__\\|\\s *\\sw+:\\)" nil label-face)
   ("^require.*" nil include-face)
   ("^\\s *sub\\s +\\w+" nil defun-face)
   ("\\b\\(do\\|if\\|unless\\|while\\|until\\|else\\|elsif\\|for\\|foreach\\|continue\\|next\\|redo\\|last\\|goto\\|return\\|die\\|exit\\)\\b" nil keyword-face)))

(hilit-set-mode-patterns
 'ada-mode
 '(;; comments
   ("--.*" nil comment-face)

   ;; main structure
   ("[ \t\n]procedure[ \t]" "\\([ \t]\\(is\\|renames\\)\\|);\\)" glob-struct-face)
   ("[ \t\n]task[ \t]" "[ \t]is" glob-struct-face)
   ("[ \t\n]function[ \t]" "return[ \t]+[a-zA-Z_0-9]+[ \t]*\\(is\\|;\\|renames\\)" glob-struct-face)
   ("[ \t\n]package[ \t]" "[ \t]\\(is\\|renames\\)" glob-struct-face)

   ;; if there is no indentation before the "end", then it is most
   ;; probably the end of the package
   ("^end.*" ";" glob-struct-face)

   ;; program structure -- "null", "delay" and "terminate" omitted
   ("[ \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-face)
 
   ;; block structure
   ("[ \n\t]\\(begin\\|end\\|declare\\|exception\\|generic\\|raise\\|return\\|package\\|body\\)[ \n\t;]" nil struct-face)

   ;; type declaration
   ("^[ \t]*\\(type\\|subtype\\).*" ";" decl-face)
   ("[ \t]+is record.*" "end record;" decl-face)

   ;; "pragma", "with", and "use" is close to C cpp directives
   ("^[ \t]*\\(with\\|use\\)" ";" include-face)
   ("^[ \t]*pragma" ";" include-face)

   ;; this is nice for named parameters, but not so beautyful
   ;; in case statements
   ("[a-zA-Z_0-9]+[ \t]*=>"   nil named-param-face)

   ;; string constants
   ;; probably not everybody likes this one
   ("\"" ".*\"" string-face)))

(hilit-set-mode-patterns
 'latex-mode
 '(;; comments
   ("%.*"             nil comment-face)
   ("\\\\section{"    "}" keyword-face)
   ("\\\\subsection{" "}" keyword-face)
   ("\\\\subsubsection\\(\*\\)?{" "}" keyword-face)
   ("\\\\chapter\\(\*\\)?{"    "}" keyword-face)

   ("\\\\begin{"      "}" decl-face)
   ("\\\\end{"        "}" decl-face)

   ("\\\\item\\["     "\\]" label-face)
   ("\\\\item[ \t\n]"   nil label-face)

   ("\\\\cite{"       "}" crossref-face)
   ("\\\\ref{"        "}" crossref-face)
   ("\\\\label{"      "}" crossref-face)
   ))


(hilit-set-mode-patterns
 'compilation-mode
 '(("^[^ \t]*:[0-9]+:.*$" nil error-face)
   ("^[^ \t]*:[0-9]+: warning:.*$" nil warning-face)))

(hilit-set-mode-patterns
 'jargon-mode
 '(("^:[^:]*:" nil jargon-def-face)
   ("{[^}]*}+" nil jargon-xref-face)))

(hilit-set-mode-patterns
 'timecard-mode
 '(("^../..:\\s +..... - ..:.." nil purple)
   ("^-------*" nil red-italic)
   ("^../..\\s +[[].*" nil ForestGreen)))

(hilit-set-mode-patterns
 'fundamental-mode
 '(("^#.*" nil fund-comment-face)
   ("[^$]#.*" nil fund-comment-face)))

(hilit-set-mode-patterns
 'makefile-mode
 '(("^#.*" nil comment-face)
   ("[^$]#.*" nil comment-face)
   ;; rules
   ("^%.*" nil rule-face)
   ("^[.][a-zA-Z][a-zA-Z]?\..*" nil rule-face)
   ;; variable definition
   ("^[_a-zA-Z0-9]+ *\+?=" nil define-face)
   ("\\( \\|:=\\)[_a-zA-Z0-9]+ *\\+=" nil define-face)
   ;; variable references
   ("\$[_a-zA-Z0-9]" nil type-face)
   ("\${[_a-zA-Z0-9]+}" nil type-face)
   ("\$\([_a-zA-Z0-9]+\)" nil type-face)
   ("^include " nil include-face)))

(let ((message-patterns
       '(("^Subject:.*" nil msg-subject-face)
	 ("^[A-Z][A-Za-z0-9-]+:" nil msg-header-face)  ; other headers
	 ("^[ \t]*[A-Za-z0-9]*>.*" nil msg-quote-face) ; quoted text
	 )))
  (hilit-set-mode-patterns 'vm-mode message-patterns)
  (hilit-set-mode-patterns 'text-mode message-patterns)
  (hilit-set-mode-patterns 'gnus-article-mode message-patterns)
  )

(hilit-set-mode-patterns
 'emacs-lisp-mode
 '(("\\s ;+[ ;].*" nil comment-face)
   ("^;.*" nil comment-face)
   ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string-face)
   ("\(\\(defun\\|defmacro\\|defsubst\\)\\s " ")" defun-face)
   ("\(defvar\\s +\\S +" nil decl-face)
   ("\(defconst\\s +\\S +" nil define-face)
   ("\(\\(provide\\|require\\|load\\).*" nil include-face)))

(hilit-set-mode-patterns
 'plain-tex-mode
 '(("^%%.*" nil comment-face)
   ("{\\\\em\\([^}]+\\)}" nil comment-face)
   ("\\(\\\\\\w+\\)" nil keyword-face)
   ("{\\\\bf\\([^}]+\\)}" nil keyword-face)
   ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun-face)
   ("\\\\\\(begin\\|end\\){\\([a-zA-Z0-9\\*]+\\)}" nil defun-face)
;   ("[^\\\\]\\$\\([^$]*\\)\\$" nil string-face)
   ("\\$\\([^$]*\\)\\$" nil string-face)
   ))

(hilit-set-mode-patterns
 'texinfo-mode
 '(("^\\(@c\\|@comment\\)[ \t].*$" nil comment-face)
   ("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" nil comment-face)
   ("\\$\\([^$]*\\)\\$" nil string-face)
   ("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" nil string-face)
   ("^\\(*.*\\)[\t ]*$" nil defun-face)
   ("@item \\(.*\\)$" nil defun-face)
   ("@end *\\([a-zA-Z0-9]+\\)[ \t]*$" nil defun-face)
   ("@\\(samp\\|code\\|var\\){\\([^}]+\\)" nil defun-face)
   ("@\\(@\\|[^}\t \n{]+\\)" nil keyword-face)
   ("@\\(xref\\|pxref\\){\\([^}]+\\)" nil keyword-face)
   ))

(provide 'hilit19)