summaryrefslogtreecommitdiff
path: root/lisp/hilit19.el
diff options
context:
space:
mode:
authorRichard M. Stallman <rms@gnu.org>1993-09-18 02:13:02 +0000
committerRichard M. Stallman <rms@gnu.org>1993-09-18 02:13:02 +0000
commit8e7e8de0ea5f38e6d728022e542b195826d93b3d (patch)
treeb1ea39cd841e398185a861c5bbb09f53e5021a47 /lisp/hilit19.el
parentfca67e82b7517076f1b00f117343e50adca58dbd (diff)
downloademacs-8e7e8de0ea5f38e6d728022e542b195826d93b3d.tar.gz
- (hilit-rehighlight-region): added (save-restriction (widen))
to avoid hangups in dired. - Also slight improvements to fortran patterns and hilit-default-face-table doc string - added optional case-fold argument to hilit-set-mode-patterns - added hilit-rehighlight-buffer-quietly to dired-after-readin-hook - fixed bug in hilit-string-find that mishandled some strings: "\\" - work-around for bug in next-overlay-change - the pattern matcher now starts it's searches from the end of the most recently highlighted region (which is not necessarily the end of the most recently matched regex). - code moved from hilit-highlight-region to hilit-set-mode-patterns. This will affect you if you pass your patterns directly to hilit-highlight-region....use a pseudo-mode instead. - twiddled C/C++, latex, texinfo, fortran, nroff patterns. - added calendar-mode, icon-mode and pascal-mode patterns - diverged lisp-mode and emacs-lisp-mode...also added lisp keywords.
Diffstat (limited to 'lisp/hilit19.el')
-rw-r--r--lisp/hilit19.el544
1 files changed, 385 insertions, 159 deletions
diff --git a/lisp/hilit19.el b/lisp/hilit19.el
index 960fdafd98b..2bf5f920a43 100644
--- a/lisp/hilit19.el
+++ b/lisp/hilit19.el
@@ -1,4 +1,4 @@
-;; hilit19.el (Release 2.7) -- customizable highlighting for Emacs19.
+;; hilit19.el (Release 2.19) -- customizable highlighting for Emacs19.
;; Copyright (c) 1993 Free Software Foundation, Inc.
;;
;; Author: Jonathan Stigelman <Stig@netcom.com>
@@ -39,12 +39,12 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
-;; hilit19.el,v 2.7 1993/07/30 02:43:01 stig Release
+;; hilit19.el,v 2.19 1993/09/08 18:44:10 stig Release
;;
;; LCD Archive Entry:
;; hilit19|Jonathan Stigelman|Stig@netcom.com|
;; Comprehensive (and comparatively fast) regex-based highlighting for Emacs 19|
-;; 1993/07/30 02:43:01|Release 2.7|~/packages/hilit19.el.Z|
+;; 1993/09/08 18:44:10|Release 2.19|~/packages/hilit19.el.Z|
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -97,12 +97,14 @@
;; SETUP -- Are you using the right font for Emacs?
;;
;; Emacs cannot properly find bold and italic fonts unless you specify a
-;; verbose X11 font name. Here's a good font menu:
+;; verbose X11 font name. If you specify a font for emacs in your
+;; .Xdefaults, it *MUST* be specified using the long form of the font name.
+;; Here's a good font menu:
;;
;; (setq
;; x-fixed-font-alist
;; '("Font Menu"
-;; ("Fonts"
+;; ("Misc"
;; ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1")
;; ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1")
;; ("lucida 13"
@@ -133,15 +135,8 @@
;; * When more than one size of font is used in different frames, only one
;; font size can have bold & italic properties.
;;
-;; * When identifiers such as remove_switch_entry, ar highlighted in C/C++,
-;; imbedded keywords--"switch" in this case--are highlighted. I don't
-;; personally see this problem because I modify the syntax for C/C++ so that
-;; ?_ is a word character "w". This also means that forward-word skips over
-;; entire variables. This will be fixed when I generalize the highlighting
-;; patterns.
-;;
;; * unbalanced, unescaped double quote characters can confuse hilit19.
-;; This will be fixed, so don't bug me about it.
+;; This will be fixed someday, so don't bug me about it.
;;
;; * ALTHOUGH HILIT19 IS FASTER THAN FONT-LOCK-MODE...
;; For various reasons, the speed of the package could still stand to be
@@ -170,12 +165,89 @@
;; Alon Albert <alon@milcse.rtsg.mot.com>, advice & patches
;; dana@thumper.bellcore.com (Dana A. Chee), working on the multi-frame bug
;; derway@ndc.com (Don Erway), for breaking it...
+;; moss_r@summer.chem.su.oz.au (Richard Moss), first pass at add-pattern
+;; Olivier Lecarme <ol@aiguemarine.unice.fr>, Pascal & Icon patterns
;;
;; With suggestions and minor regex patches from numerous others...
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; hilit19.el,v
+;; Revision 2.19 1993/09/08 18:44:10 stig
+;; installed patch for elusive bug in hilit-rehighlight-region that caused
+;; hilit-unhighlight-region to hang in an infinite loop.
+;;
+;; Revision 2.18 1993/08/27 03:51:00 stig
+;; minor mods to lisp-mode and c/c++ mode patterns
+;;
+;; Revision 2.17 1993/08/25 02:19:17 stig
+;; work-around for bug in next-overlay-change that caused dired and jargon-mode
+;; to hang in an endless loop. Perhaps other modes were doing this too.
+;;
+;; Revision 2.16 1993/08/22 19:46:00 stig
+;; bug fix for next-overlay-change and accompanying change to
+;; hilit-unhighlight-region
+;;
+;; Revision 2.15 1993/08/20 12:16:22 stig
+;; minor change to fortran patterns
+;;
+;; Revision 2.14 1993/08/17 14:12:10 stig
+;; added default face mapping for 'formula' which is needed for new latex
+;; patterns.
+;;
+;; twiddled the calendar-mode patterns a bit.
+;;
+;; Revision 2.13 1993/08/16 04:33:54 stig
+;; hilit-set-mode-patterns was screwing up two part patterns. it doesn't now.
+;;
+;; Revision 2.12 1993/08/16 00:16:41 stig
+;; changed references to default-bold-italic to just bold-italic because the
+;; font for that face is maintained by emacs.
+;;
+;; the pattern matcher now starts it's searches from the end of the most
+;; recently highlighted region (which is not necessarily the end of the most
+;; recently matched regex).
+;;
+;; multiple errors in pattern matcher now just give an error instead of lots of
+;; annoying messages and dings.
+;;
+;; no longer use vm-summary-mode-hooks.
+;;
+;; some code moved from hilit-highlight-region to hilit-set-mode-patterns.
+;; This will affect you if you pass your patterns directly to
+;; hilit-highlight-region....use a pseudo-mode instead.
+;;
+;; pattern changes to C/C++, latex, texinfo, fortran, nroff, etc.
+;;
+;; Revision 2.11 1993/08/13 12:12:37 stig
+;; removed some crufty commented-out code
+;;
+;; diverged lisp-mode and emacs-lisp-mode...also added lisp keywords.
+;;
+;; Revision 2.10 1993/08/13 09:47:06 stig
+;; added calendar-mode, icon-mode and pascal-mode patterns
+;;
+;; commented out hilit-toggle-highlight because I want to phase it out entirely
+;;
+;; Revision 2.9 1993/08/13 08:44:22 stig
+;; added optional case-fold argument to hilit-set-mode-patterns, this case-fold
+;; parameter is now stored in hilit-patterns-alist.
+;;
+;; Revision 2.8 1993/08/12 22:05:03 stig
+;; fixed some typos in documentation
+;;
+;; twiddled some of the color defaults for dark backgrounds
+;;
+;; always get 'mono color defaults if (not (x-display-color-p))
+;;
+;; added hilit-rehighlight-buffer-quietly to dired-after-readin-hook
+;;
+;; fixed bug in hilit-string-find that mishandled strings of the form: "\\"
+;;
+;; NEW FUNCTION: hilit-add-mode-pattern... kinda like add-hook for patterns
+;;
+;; fixed minor pattern bugs for latex-mode and emacs-lisp-mode
+;;
;; Revision 2.7 1993/07/30 02:43:01 stig
;; added const to the list of modifiers for C/C++ types
;;
@@ -255,7 +327,7 @@
"* 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 57000
+(defvar hilit-auto-highlight-maxout 60000 ; hilit19 keeps getting bigger...
"* auto-highlight is disabled in buffers larger than this")
(defvar hilit-auto-rehighlight t
@@ -308,11 +380,14 @@ like to make this more universal?")
(defvar hilit-patterns-alist nil
"alist 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
+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)
@@ -321,19 +396,21 @@ See the hilit-lookup-face-create documentation for valid face names.")
If hilit19 is dumped into emacs at your site, you may have to set this in
your init file.")
+(eval-when-compile (setq byte-optimize t))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Use this to report bugs:
(eval-when-compile (require 'reporter)) ; no compilation gripes
-(defun hilit-submit-feeback ()
+(defun hilit-submit-feedback ()
"Submit feedback on hilit19 to the author: Stig@netcom.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 <Stig@netcom.com>"
- "hilit19.el (Release 2.7)"
+ "hilit19.el (Release 2.19)"
(and (y-or-n-p "Do you need to include a dump hilit variables? ")
(append
'(
@@ -361,15 +438,15 @@ your init file.")
"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"
- " [ ] my DONATION to your vacation fund (prototype digital cash)\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 (diff -cw oldversion newversion) to fix a problem\n"
- " [ ] a REPRODUCABLE BUG that I do not believe to be an EMACS bug\n"
+ " [ ] a PATCH. (output of 'diff -uw old.el new.el' or 'diff -cw')\n"
+ " [ ] a SERIOUS AND REPRODUCABLE BUG that is not an EMACS bug\n"
" - I *swear* that it's not already mentioned in the KNOWN BUGS\n"
- " - Also, I have checked netcom.com:/pub/stig/src/hilit19.el.gz\n"
+ " - I HAVE CHECKED netcom.com:/pub/stig/src/Beta/hilit19.el.gz\n"
" for a newer release that fixes the problem.\n"
- " [ ] ADVICE -- or an unfulfilled desire that I suspect you share\n"
+ " >> I HAVE ALSO CHECKED netcom.com:/pub/stig/src/Beta/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"))))
@@ -382,13 +459,13 @@ your init file.")
'(
;; used for C/C++ and elisp and perl
(comment firebrick-italic moccasin italic)
- (include purple Plum1 default-bold-italic)
+ (include purple Plum1 bold-italic)
(define ForestGreen-bold green bold)
- (defun blue-bold cyan-bold default-bold-italic)
+ (defun blue-bold cyan-bold bold-italic)
(decl RoyalBlue cyan bold)
(type nil yellow nil)
- (keyword RoyalBlue cyan default-bold-italic)
- (label red-bold orange-underlined underline)
+ (keyword RoyalBlue cyan bold-italic)
+ (label red-underline orange-underlined underline)
(string grey40 orange underline)
;; some further faces for Ada
@@ -398,40 +475,41 @@ your init file.")
;; and anotherone for LaTeX
(crossref DarkGoldenrod Goldenrod underline)
+ (formula Goldenrod DarkGoldenrod underline)
;; compilation buffers
- (active-error default/pink-bold default/DeepPink-bold bold-underline)
- (error red-bold yellow bold)
- (warning blue-italic green italic)
+ (active-error default/pink-bold default/DeepPink-bold default-underline)
+ (error red-bold yellow bold)
+ (warning blue-italic green italic)
;; Makefiles (some faces borrowed from C/C++ too)
- (rule blue-bold-underline cyan-underline bold-underline)
+ (rule blue-bold-underline cyan-underline default-bold-underline)
;; VM, GNUS and Text mode
(msg-subject blue-bold yellow bold)
- (msg-from purple-bold SeaGreen bold)
+ (msg-from purple-bold green bold)
(msg-header firebrick-bold cyan italic)
- (msg-separator black/tan-bold lightblue nil)
- (msg-quote ForestGreen green 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 default-bold-italic)
- (summary-current default/skyblue-bold green/LightGrey-bold reverse-default)
+ (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 yellow nil)
+ (gnus-group-empty nil nil nil)
(gnus-group-full ForestGreen green italic)
- (gnus-group-overflowing firebrick orange default-bold-italic)
+ (gnus-group-overflowing firebrick red bold-italic)
;; dired mode
(dired-directory blue-bold cyan bold)
(dired-link firebrick-italic green italic)
(dired-ignored ForestGreen moccasin nil)
- (dired-deleted red-bold-italic orange default-bold-italic)
+ (dired-deleted red-bold-italic orange bold-italic)
(dired-marked purple Plum1 nil)
;; Info-mode, and jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon*
@@ -439,11 +517,18 @@ your init file.")
(jargon-xref purple-bold Plum1 italic)
(jargon-keyword firebrick-underline yellow underline)
)
- "alist of default faces (face . (light-default dark-default mono-default))")
+ "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 (cdr (assq hilit-background-mode
- '((light . 1) (dark . 2))))
+ (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))
@@ -583,11 +668,12 @@ The optional 5th arg, PROP is a property to set instead of 'hilit."
"Unhighlights the region from START to END, optionally in a QUIET way"
(interactive "r")
(or quietly hilit-quietly (message "Unhighlighting"))
- (while (< start end)
- (mapcar (function (lambda (ovr)
- (and (overlay-get ovr 'hilit) (delete-overlay ovr))))
- (overlays-at start))
- (setq start (next-overlay-change start)))
+ (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")))
;;;; These functions use text properties instead of overlays. Text properties
@@ -625,12 +711,13 @@ non-nil."
((symbolp patterns)
(setq patterns (cdr (assq patterns hilit-patterns-alist)))))
;; txt prop: (setq patterns (reverse patterns))
- (let ((prio (length patterns))
- (case-fold-search nil)
+ (let ((case-fold-search (car patterns))
+ (prio (1- (length patterns)))
;; txt prop: (buffer-read-only nil)
;; txt prop: (bm (buffer-modified-p))
- p pstart pend face mstart)
+ p pstart pend face mstart (puke-count 0))
;; txt prop: (unwind-protect
+ (setq patterns (cdr patterns)) ; remove case-fold from head of pattern
(save-excursion
(save-restriction
(narrow-to-region start end)
@@ -643,9 +730,9 @@ non-nil."
nil
(or quietly hilit-quietly
(message "highlighting %d: %s%s" prio pstart
- (if pend (concat " ... " pend) "")))
+ (if (stringp pend) (concat " ... " pend) "")))
(goto-char (point-min))
- (condition-case nil
+ (condition-case msg
(cond
((symbolp pstart)
;; inner loop -- special function to find pattern
@@ -661,18 +748,20 @@ non-nil."
(hilit-region-set-face mstart (match-end 0)
face prio)
(forward-char 1))))
- (t
- (or (numberp pend) (setq pend 0))
+ ((numberp pend)
;; inner loop -- just one regex to match whole pattern
(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))))
- (error (message "Unbalanced delimiters? Barfed on '%s'"
- pstart)
- (ding) (sit-for 4))))
+ (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 "")) ; "Done highlighting"
;; txt prop: (set-buffer-modified-p bm)) ; unwind protection
))
@@ -680,10 +769,12 @@ non-nil."
(defun hilit-rehighlight-region (start end &optional quietly)
"Re-highlights the region, optionally in a QUIET way"
(interactive "r")
- (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))
+ (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"
@@ -708,16 +799,19 @@ non-nil."
(defalias 'hilit-highlight-buffer 'hilit-rehighlight-buffer)
-(defun hilit-toggle-highlight (arg)
- "Locally toggle highlighting. With arg, forces highlighting off."
- (interactive "P")
- ;; FIXME -- this loses numeric information in hilit-auto-rehighlight
- (setq hilit-auto-rehighlight
- (and (not arg) (not hilit-auto-rehighlight)))
- (if hilit-auto-rehighlight
- (hilit-rehighlight-buffer)
- (hilit-unhighlight-region (point-min) (point-max)))
- (message "Rehighlighting is set to %s" hilit-auto-rehighlight))
+;; Well, I want to remove this function...there's one sure way to find out if
+;; anyone uses it or not...and that's to comment it out.
+;;
+;; (defun hilit-toggle-highlight (arg)
+;; "Locally toggle highlighting. With arg, forces highlighting off."
+;; (interactive "P")
+;; ;; FIXME -- this loses numeric information in hilit-auto-rehighlight
+;; (setq hilit-auto-rehighlight
+;; (and (not arg) (not hilit-auto-rehighlight)))
+;; (if hilit-auto-rehighlight
+;; (hilit-rehighlight-buffer)
+;; (hilit-unhighlight-region (point-min) (point-max)))
+;; (message "Rehighlighting is set to %s" hilit-auto-rehighlight))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HOOKS
@@ -754,18 +848,6 @@ prefix argument if that is specified.
(if st
(hilit-rehighlight-region st en quietly))))
-;; (defun hilit-rehighlight-yank-region ()
-;; "Rehighlights from the beginning of the line where the region starts to
-;; the end of the line where the region ends. This could flake out on
-;; multi-line highlights (like C comments and lisp strings.)"
-;; (if hilit-auto-rehighlight
-;; (hilit-rehighlight-region
-;; (save-excursion (goto-char (region-beginning))
-;; (beginning-of-line) (point))
-;; (save-excursion (goto-char (region-end))
-;; (end-of-line) (point))
-;; t)))
-
(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
@@ -776,14 +858,6 @@ the entire buffer is forced."
(sit-for 0)
(hilit-repaint-command (consp arg)))
-;; (defun hilit-redraw-display (arg)
-;; "Rehighlights according to the value of hilit-auto-rehighlight, a prefix
-;; arg forces a rehighlight of the whole buffer. Otherwise just like
-;; redraw-display."
-;; (interactive "P")
-;; (hilit-redraw-internal arg)
-;; (redraw-display))
-
(defun hilit-yank (arg)
"Yank with rehighlighting"
(interactive "*P")
@@ -898,12 +972,9 @@ the entire buffer is forced."
(lambda (hook)
(add-hook hook 'hilit-rehighlight-buffer-quietly)))
'(
- compilation-parse-hook
-
- Info-select-hook ; FIXME -- phase this out later
Info-selection-hook
- vm-summary-mode-hooks
+;; runs too early vm-summary-mode-hooks
vm-summary-pointer-hook
vm-preview-message-hook
vm-show-message-hook
@@ -915,9 +986,11 @@ the entire buffer is forced."
rmail-show-message-hook
mail-setup-hook
mh-show-mode-hook
+
+ dired-after-readin-hook
))
- ;; rehilight only the visible part of the summary buffer for speed.
+ ;; rehighlight only visible part of summary buffer for speed.
(add-hook 'gnus-mark-article-hook
(function
(lambda ()
@@ -956,9 +1029,20 @@ the entire buffer is forced."
(setcdr oldentry val)
(set alist (cons (cons key val) (eval alist))))))
-(defun hilit-set-mode-patterns (modelist patterns &optional parse-fn)
+(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."
+See the variable hilit-mode-enable-list.
+
+Takes optional arguments PARSE-FN and CASE-FOLD."
+ ;; change pattern
+ (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
@@ -967,59 +1051,96 @@ See the variable 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)))))
+ (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-int 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 [^QCHAR]\" ... [^\\]\""
+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)
- (eq ?\\ (char-after (- (setq en (point)) 2)))))
+ (save-excursion
+ (setq en (point))
+ (forward-char -1)
+ (skip-chars-backward "\\\\")
+ (forward-char 1)
+ (not (zerop (% (- en (point)) 2))))))
(and en (cons st en))))
-(hilit-set-mode-patterns
- '(c-mode c++-c-mode elec-c-mode)
- '(("/\\*" "\\*/" comment)
- ; ("\"" "[^\\]\"" string)
- (hilit-string-find ?' string)
- ;; declaration
- ("^#[ \t]*\\(undef\\|define\\).*$" nil define)
- ("^#.*$" nil include)
- ;; function decls are expected to have types on the previous line
- ("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
- ("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl)
- ;; datatype -- black magic regular expression
- ("[ \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)
- ;; key words
- ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>[^_]" 1 keyword)
- ))
+;; return types on same line...
+;; ("^[a-zA-z].*\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
-(hilit-set-mode-patterns
- 'c++-mode
- '(("/\\*" "\\*/" comment)
- ("//.*$" nil comment)
- ("^/.*$" nil comment)
-; ("\"" "[^\\]\"" string)
- (hilit-string-find ?' string)
- ;; declaration
- ("^#[ \t]*\\(undef\\|define\\).*$" nil define)
- ("^#.*$" nil include)
- ;; function decls are expected to have types on the previous line
- ("^\\(\\(\\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)
- ;; datatype -- black magic regular expression
- ("[ \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)
- ;; key words
- ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>[^_]"
- 1 keyword)))
+;; On another note, a working pattern for grabbing function definitions for C is
+;;
+;; ("^[a-zA-Z_]+.*[;{]$" nil ForestGreen) ; global defns ( start at col 1 )
+;; ("^[a-zA-Z_]+.*(" ")" defun)
+;; ; defuns assumed to start at col 1, not with # or {
+;;
+;; this will make external declarations/definitions green, and function
+;; definitions the defun face. Hmmm - seems to work for me anyway.
+
+(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
+ '(
+ ;; function decls are expected to have types on the previous line
+ ("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
+ ("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl)
+ ;; datatype -- black magic regular expression
+ ("[ \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)
+ ;; key words
+ ("[^_]\\<\\(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
+ '(
+ ;; function decls are expected to have types on the previous line
+ ("^\\(\\(\\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)
+ ;; datatype -- black magic regular expression
+ ("[ \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)
+ ;; key words
+ ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>[^_]"
+ 1 keyword)))))
(hilit-set-mode-patterns
'perl-mode
@@ -1063,16 +1184,17 @@ Finds [^QCHAR]\" ... [^\\]\""
(hilit-set-mode-patterns
'fortran-mode
'(("^[*Cc].*$" nil comment)
- ("[ \t]\\(call\\|program\\|subroutine\\|function\\|stop\\|return\\|end\\|include\\)[ \t\n]" nil include)
+ ("'[^'\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)
- ("'[^'\n]*'" nil string)
- ))
+ )
+ nil 'case-insensitive)
(hilit-set-mode-patterns
'(m2-mode modula-2-mode)
@@ -1080,7 +1202,8 @@ Finds [^QCHAR]\" ... [^\\]\""
(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)
@@ -1115,7 +1238,7 @@ Finds [^QCHAR]\" ... [^\\]\""
;; various declarations/definitions
("\\\\\\(setlength\\|settowidth\\|addtolength\\|setcounter\\|addtocounter\\)" nil define)
- ("\\\\\\(\\|title\\|author\\|date\\|thanks\\){" "}" define)
+ ("\\\\\\(title\\|author\\|date\\|thanks\\){" "}" define)
("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl)
("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl)
@@ -1128,10 +1251,14 @@ Finds [^QCHAR]\" ... [^\\]\""
("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" nil decl)
;; label-like things
- ("\\\\item\\[" "\\]" label)
- ("\\\\item\\b" nil label)
- ("\\\\caption\\(\\[.*\\]\\)?{" "}" label)
-
+ ("\\\\item\\(\\[[^]]*\\]\\)?" nil label)
+ ("\\\\caption\\(\\[[^]]*\\]\\)?{" "}" label)
+
+ ;; formulas
+ ("\\\\(" "\\\\)" formula) ; \( \)
+ ("\\\\\\[" "\\\\\\]" formula) ; \[ \]
+ ("[^$]\\($\\($[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula) ; '$...$' or '$$...$$'
+
;; things that bring in external files
("\\\\\\(include\\|input\\|bibliography\\){" "}" include)
@@ -1215,17 +1342,48 @@ Finds [^QCHAR]\" ... [^\\]\""
("^ N.*$" nil summary-new)))
+;;; this will match only comments w/ an even (zero is even) number of quotes...
+;;; which is still inadequate because it matches comments in multi-line strings
+;;; how anal do you want to get about never highlighting comments in strings?
+;;; I could twiddle with this forever and still it wouldn't be perfect.
+;;; (";\\([^\"\n]*\"[^\"\n]*\"\\)*[^\"\n]*$" nil comment)
+
(hilit-set-mode-patterns
- '(emacs-lisp-mode lisp-mode)
+ '(emacs-lisp-mode lisp-interaction-mode)
'(
(";.*" nil comment)
-;;; ("^;.*$" nil comment)
-;;; ("\\s ;+[ ;].*$" nil comment)
+
+;;; This almost works...but I think I'll stick with the parser function
+;;;("[^?]\\(\"\\(\"\\||\\([^\"]+\\|[\\]\\([\\][\\]\\)*\"\\)*\"\\)\\)" 1 string)
(hilit-string-find ?\\ string)
- ("^\\s *(def\\(un\\|macro\\|advice\\|subst\\)\\s " "\\()\\|nil\\)" defun)
+
+ ("^\\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)
+;;; This almost works...but I think I'll stick with the parser function
+;;;("[^?]\\(\"\\(\"\\||\\([^\"]+\\|[\\]\\([\\][\\]\\)*\"\\)*\"\\)\\)" 1 string)
+ (hilit-string-find ?\\ string)
+
+ ;; this is waaaaaaaay too slow
+ ;; ("^\\s *(def\\(un\\|macro\\|advice\\|alias\\|method\\|subst\\)\\s \\S +[ \t\n]+\\(nil\\|(\\(([^()]*)\\|[^()]+\\)*)\\)" nil defun)
+ ("^\\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\\)\\|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)
))
@@ -1237,7 +1395,7 @@ Finds [^QCHAR]\" ... [^\\]\""
("{\\\\bf\\([^}]+\\)}" nil keyword)
("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun)
("\\\\\\(begin\\|end\\){\\([A-Za-z0-9\\*]+\\)}" nil defun)
-; ("[^\\\\]\\$\\([^$]*\\)\\$" nil string)
+ ;; ("[^\\\\]\\$\\([^$]*\\)\\$" nil string)
("\\$\\([^$]*\\)\\$" nil string)
))
@@ -1252,16 +1410,17 @@ Finds [^QCHAR]\" ... [^\\]\""
("^\\.[ST]H.*$" nil defun)
;; ("^[^\\.].*\"[^\\\"]*\\(\\\\\\(.\\)[^\\\"]*\\)*\"" nil string)
("\"" "[^\\]\"" string)
- ("^\\.[A-Za-z12\\\\].*$" nil define)
+ ("^\\.[A-Z12\\\\].*$" nil define)
("\\([\\\][^ ]*\\)" nil keyword)
- ("^\\.[a-zA-Z].*$" 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)
-; seems broken
-; ("\\$[^$]*\\$" nil string)
+;; seems broken
+;; ("\\$[^$]*\\$" nil string)
("@\\(file\\|kbd\\|key\\){[^}]+}" nil string)
("^\\*.*$" nil defun)
("@\\(if\\w+\\|format\\|item\\)\\b.*$" nil defun)
@@ -1297,6 +1456,73 @@ Finds [^QCHAR]\" ... [^\\]\""
("- \\(Variable\\|Function\\|Macro\\|Command\\|Special Form\\|User Option\\):.*$"
nil jargon-keyword))) ; lisp manual
+(hilit-set-mode-patterns
+ 'calendar-mode
+ '(("[A-Z][a-z]+ [0-9]+" nil define) ; month and year
+ ("S M Tu W Th F S" nil label) ; week days
+ ("[0-9]+\\*" nil defun) ; holidays
+ ("[0-9]+\\+" nil comment) ; diary days
+ ))
+
+(hilit-set-mode-patterns
+ 'pascal-mode
+ '(("(\\*" "\\*)" comment)
+ ("{" "}" comment)
+ ;; Doesn't work when there are strings in comments....
+ ;; ("'[^']*'" nil string)
+ ("^#.*$" 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)
+ ;; charsets: these do not work because of a conflict with strings
+ ;; ("'[^\\']*\\(\\\\.[^\\']*\\)*'" 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)
+ ))
+
+;; as you can see, I had two similar problems for Pascal and Icon. In
+;; Pascal, strings are delimited with ' and an embedded quote is doubled,
+;; thus string syntax would be extremely simple. However, if a string
+;; occurs within a comment, the following text is considered a string.
+;;
+;; In Icon, strings are similar to C ones, but there are also charsets,
+;; delimited with simple quotes. I could not manage to use both regexps at
+;; the same time.
+
+;; The problem I have with my patterns for Icon is that this language has a
+;; string similar constant to the C one (but a string can be cut on several
+;; lines, if terminated by a dash and continued with initial blanks, like
+;; this:
+;; "This is a somewhat long -
+;; string, written on three -
+;; succesive lines"
+;; in order to insert a double quote in a string, you have to escape it
+;; with a \), bu also a character set constant (named a charset), which
+;; uses single quotes instead of double ones. It would seem intuitive to
+;; highlight both constants in the same way.
+
+
(provide 'hilit19)
;;; hilit19 ends here.
+
+
+;; __________________________________________________________________________
+;; Stig@netcom.com netcom.com:/pub/stig/00-PGP-KEY
+;; It's hard to be cutting-edge at your own pace... 32 DF B9 19 AE 28 D1 7A
+;; Bullet-proof code cannot stand up to teflon bugs. A3 9D 0B 1A 33 13 4D 7F
+