X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/280a6a9f189e512c3de4e22ed146b4f4701d6765..ad9cdce411a4fd164a754626d9286cc45be8a807:/lisp/hilit19.el diff --git a/lisp/hilit19.el b/lisp/hilit19.el index 960fdafd98..5fca0bab48 100644 --- a/lisp/hilit19.el +++ b/lisp/hilit19.el @@ -1,5 +1,5 @@ -;; hilit19.el (Release 2.7) -- customizable highlighting for Emacs19. -;; Copyright (c) 1993 Free Software Foundation, Inc. +;; hilit19.el (Release 2.19) -- customizable highlighting for Emacs19. +;; Copyright (c) 1993, 1994 Free Software Foundation, Inc. ;; ;; Author: Jonathan Stigelman ;; Keywords: faces @@ -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" @@ -130,18 +132,8 @@ ;; ;; KNOWN BUGS/TO DO LIST/HELP WANTED/APPLY WITHIN ;; -;; * 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 +162,89 @@ ;; Alon Albert , 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 , 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 +324,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 +377,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 +393,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 " - "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 +435,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 +456,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 +472,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 +514,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)) @@ -552,17 +634,11 @@ See the documentation for hilit-translate and hilit-face-translation-table." (set-face-font face nil frame) (set-face-underline-p face (string-match "underline" fn)) (if (string-match ".*bold" fn) - (progn - ;; first, fix up this frame's face - (make-face-bold face frame 'noerr) - ;; now, fix up the face from the global list - (set-face-font face (face-font face frame) t))) + ;; make face bold in all frames + (make-face-bold face nil 'noerr)) (if (string-match ".*italic" fn) - (progn - ;; first, fix up this frame's face - (make-face-italic face frame 'noerr) - ;; now, fix up the face from the global list - (set-face-font face (face-font face frame) t))) + ;; make face italic in all frames + (make-face-italic face nil 'noerr)) )) ))) face) @@ -583,11 +659,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 +702,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 +721,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 +739,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 +760,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 +790,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 @@ -730,9 +815,11 @@ non-nil." (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 - (hilit-rehighlight-buffer) - (set-buffer-modified-p nil))))) + (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 @@ -754,18 +841,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 +851,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 +965,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 +979,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 +1022,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 +1044,113 @@ 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 + '(objc-mode objective-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\\|interface\\|implementation\\|end\\|super\\|self\\)\\>[^_]" + 1 keyword)))) + ) (hilit-set-mode-patterns 'perl-mode @@ -1063,16 +1194,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 +1212,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 +1248,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 +1261,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 +1352,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\\)\\|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) )) @@ -1237,7 +1405,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 +1420,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 +1466,84 @@ 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 + +(hilit-set-mode-patterns + 'asm-mode + '(("/\\*" "\\*/" comment) + ("^#[ \t]*\\(undef\\|define\\).*$" "[^\\]$" define) + ("^#.*$" nil include) + ;; labels + ("^.+:" nil defun) + ;; assembler directives + ("^[ \t]*\\..*$" nil decl) + ;; register names + ("\\$[a-z0-9]+" nil string) + ;; mnemonics + ("^[ \t]*[a-z]+" nil struct))) + +(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 +