aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-07-23 19:28:14 +0000
committerRichard M. Stallman1993-07-23 19:28:14 +0000
commit9a5e9959b5fa8f9f889f33a8f2b96bcf2bebb966 (patch)
tree74806ffd0c821ff52381c880eaaed0edad6fa5b9
parent0fd6b74ee5ec75e1aaa6b9fc7f0b3a8bf4773144 (diff)
downloademacs-9a5e9959b5fa8f9f889f33a8f2b96bcf2bebb966.tar.gz
emacs-9a5e9959b5fa8f9f889f33a8f2b96bcf2bebb966.zip
Initial revision
-rw-r--r--lisp/hilit19.el1454
1 files changed, 1454 insertions, 0 deletions
diff --git a/lisp/hilit19.el b/lisp/hilit19.el
new file mode 100644
index 00000000000..f99b9777452
--- /dev/null
+++ b/lisp/hilit19.el
@@ -0,0 +1,1454 @@
1;; hilit19.el, Beta 1.9 -- customizable highlighting for Emacs19.
2;; Copyright (c) 1993 Free Software Foundation, Inc.
3;;
4;; Author: Jonathan Stigelman <Stig@netcom.com>
5;; Keywords: faces
6;;
7;; This program is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2 of the License, or
10;; (at your option) any later version.
11;;
12;; This program is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16;;
17;; You should have received a copy of the GNU General Public License
18;; along with this program; if not, write to the Free Software
19;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20;;
21
22;;; Commentary:
23
24;; hilit19.el, Beta 1.9 -- customizable highlighting for Emacs19.
25;; Supports not only source code highlighting, but also rmail, VM, and gnus.
26
27;; WHERE TO GET THE LATEST VERSION OF HILIT19.EL (possibly beta),
28;; PLUS LOTS OF OTHER *WAY COOL* STUFF VIA ANONYMOUS FTP:
29;;
30;; netcom.com:/pub/stig/src/hilit19.el.gz
31;;
32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33;;
34;; TO SUBMIT BUG REPORTS (or feedback of any sort)...
35;;
36;; M-x hilit-submit-feedback RET
37;;
38;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39;;
40
41;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42;;
43;; $Id: hilit19.el,v 1.34 1993/07/23 05:18:37 stig Exp stig $
44;;
45;; LCD Archive Entry:
46;; emacs19/hilit19.el|Jonathan Stigelman|Stig@netcom.com
47;; |Comprehensive (and comparatively fast) regex-based highlighting for Emacs 19
48;; Thu Jul 22 21:03:46 1993|Beta 1.9||
49;;
50;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51;;
52;; GENERAL OVERVIEW
53;;
54;; This package installs numerous hooks to colorfully highlight your
55;; source code buffers as well as mail and news buffers. Most
56;; programming languages have predefined highlighting patterns.
57;; Just load hilit19 and files will be automatically highlighted as
58;; they're loaded.
59;;
60;; Rehighlight a buffer by typing C-S-l (control-shift-lowercase-L).
61;;
62;; If, when you edit the buffer, the coloring gets messed up, just
63;; redraw and the coloring will be adjusted. If automatic highlighting
64;; in the current buffer has been turned off, then typing C-u C-S-l will
65;; force a rehighlight of the entire buffer.
66;;
67;; Hilit19 can build faces by examining the names that you give to them
68;; For example, green/black-bold-italic-underline would be created as
69;; a face with a green foreground, and a black background, using a
70;; bold-italic font...with underlining for good measure.
71;;
72;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73;;
74;; SETUP -- In your .emacs:
75;;
76;; (require 'hilit19) ; not intended to be autoloaded
77;;
78;; (setq hilit-mode-enable-list '(not text-mode))
79;;
80;; (hilit-translate type 'RoyalBlue ; enable highlighting in C/C++
81;; string nil) ; disable string highlighting
82;;
83;; To get 100% of the utility of hilit19, you may also have to apply the
84;; patches below for info.el and vm5.33L_19/vm-summary.el
85;;
86;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
87;;
88;; SETUP -- Are you using the right font for Emacs?
89;;
90;; Emacs cannot properly find bold and italic fonts unless you specify a
91;; verbose X11 font name. Here's a good font menu:
92;;
93;; (setq
94;; x-fixed-font-alist
95;; '("Font Menu"
96;; ("Fonts"
97;; ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1")
98;; ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1")
99;; ("lucida 13"
100;; "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1")
101;; ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1")
102;; ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1")
103;; ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1")
104;; ("")
105;; ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1")
106;; ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1")
107;; ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1")
108;; ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1")
109;; ("")
110;; ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1")
111;; ("")
112;; ("-- Courier --")
113;; ("Courier 10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-*-1")
114;; ("Courier 12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-*-1")
115;; ("Courier 14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-*-1")
116;; ("Courier 18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-*-1")
117;; ("Courier 18-b" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-*-1")
118;; )))
119;;
120;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121;;
122;; KNOWN BUGS/TO DO LIST/HELP WANTED/APPLY WITHIN
123;;
124;; * unbalanced double quote characters can confuse hilit19. This will be
125;; fixed, so don't bug me about it.
126;;
127;; * ALTHOUGH HILIT19 IS FASTER THAN FONT-LOCK-MODE, for various reasons,
128;; the speed of the package could still stand to be improved. If you care
129;; to do a little profiling and make things tighter...
130;;
131;; * hilit-toggle-highlight is flaky in large buffers where auto-rehighlight
132;; is numeric after toggling twice, it loses it's numeric value
133;;
134;; PROJECTS THAT YOU CAN TAKE OVER BECAUSE I DON'T MUCH CARE ABOUT THEM...
135;;
136;; * Moved hilit-wysiwyg-replace here from my version of man.el, this is not
137;; a bug. The bug is that I don't have a reverse operation yet...just a
138;; stub Wysiwyg-anything really belongs in a package of it's own.
139;;
140;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
141;;
142;; Thanks to the following people for their input:
143;; ebert@enpc.enpc.fr (Rolf EBERT), ada, LaTeX & bibtex highlights
144;; Vivek Khera <khera@cs.duke.edu>, gnus hooks + random advice & patches
145;; brian@athe.WUstl.EDU (Brian Dunford-Shore), prolog highlights
146;; John Ladwig <jladwig@soils.umn.edu>, 1st pass nroff highlights
147;; campo@sunthpi3.difi.unipi.it (Massimo Campostrini), fortran highlights
148;; jayb@laplace.MATH.ColoState.EDU (Jay Bourland), 1st pass dired
149;; Yoshio Turner <yoshio@CS.UCLA.EDU>, modula 2 highlights
150;; Fritz Knabe <knabe@ecrc.de>, advice & patches
151;; Alon Albert <alon@milcse.rtsg.mot.com>, advice & patches
152;; dana@thumper.bellcore.com (Dana A. Chee), for breaking it...
153;; derway@ndc.com (Don Erway), for breaking it...
154;;
155;; With suggestions and minor regex patches from numerous others...
156;;
157;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
158;;
159;; HISTORY
160;;
161;; V1.9 21-July-1993 Stig@netcom.com
162;; better documentation and added the function hilit-submit-feedback.
163;; no longer rebind ^L, now C-S-l (control shift l) repaints the buffer
164;; multi-line highlights no longer cause problems when
165;; hilit-auto-rehighlight is 'visible
166;; added hilit-predefined-face-list...
167;; changed name of hilit-mode-alist to hilit-patterns-alist
168;; added hilit-message-quietly to mail-setup-hook
169;; added hilit-parser-alist which can be used to apply different patterns to
170;; different parts of a buffer. This could be integrated in a far more
171;; elegant manner, but it presently serves the purpose of not applying
172;; message header patterns to message bodies in mail-mode and it's kin.
173;; hilit-set-mode-patterns now takes a list of modes and an optional parse-fn
174;; V1.8 19-July-1993 Stig@netcom.com
175;; changed hilit-translate to be a macro so that now it mirrors setq
176;; now permit multiple layers of face-translation...
177;; hilit-lookup-face-create now parses background colors
178;; added code to check for face changes and recopy the fonts from 'default
179;; when necessary. this can be disabled if you never change fonts.
180;; you should be able to change fonts, redraw, and have all of your
181;; bold & italic faces back to normal. Should work in new frames as well.
182;; fixed typo for one of the vm hooks and included the magic patch to
183;; vm5.33 that keeps the summary window up to date.
184;; got rid of the annoying dings and delays when colors aren't available
185;; set case-fold-search to nil in highlighting-region function
186;; fixed minor bug in hilit-rehighlight-message-quietly
187;; patches to Info, LaTeX, fortran, nroff, & c++ patterns
188;; modula-2-mode support
189;; improved gnus-mark-article-hook
190;; moved timecard-mode highlights to timecard-mode itself
191;; V1.7 12-July-1993 Stig@netcom.com
192;; fix to dired patterns
193;; punted on the dual functionality in hilit-auto-highlight and added
194;; hilit-mode-enable-list, which permits users to specifically lock out
195;; modes by preventing them from being added into the hilit-mode-list
196;; incorporated defaults for dark backgrounds (see hilit-background-mode)
197;; incorporated fortran highlighting patterns
198;; patches to ada-mode and msg-header regexes
199;; added msg-separator pattern
200;; changed dired-backup to dired ignored which (which is derived from the
201;; variable completion-ignored-extensions)
202;; V1.6 5-July-1993 Stig@netcom.com
203;; added dired patterns
204;; fixed minor typo bug in mail patterns
205;; added profiling hook
206;; V1.5 5-July-1993 Stig@netcom.com
207;; changed behavior of hilit-recenter to more closely match that of recenter
208;; hilit-auto-highlight can now be a list of major-modes to highlight on find
209;; reverted to using overlays...the cost of text-properties is too high, IMHO
210;; added 'visible option to hilit-auto-rehighlight variable
211;; now highlighting support for info pages (see patch below)
212;; added hilit-yank and hilit-yank-pop which replace their analogues
213;; wrote special parsing function for strings...bug squished...faster too
214;; tuned the texinfo patterns for better performance
215;; nroff support
216;; V1.4 2-July-1993 Stig@netcom.com
217;; more efficient highlighting for news and mail
218;; switched to text properties (this may be temporary)
219;; changed regular expressions for c*mode to accomodate syntax tables
220;; minor mod to Ada parameter regexp
221;; now catch regex stack overflows and print an error
222;; string matching now uses start and end expressions to prevent overflows
223;; V1.3 28-June-1993 Stig@netcom.com
224;; added support for hexadecimal color specification under X
225;; added hilit-translate for simple color translations
226;; changed coverage of hilit-quietly...when it's quiet, it's always quiet.
227;; removed extra call to unhighlight-region in rehighlight-buffer
228;; automatically installs hooks, unless hilit-inhibit-hooks set before load
229;; installed fixes for latex
230;; V1.2 28-June-1993 Stig@netcom.com
231;; partially fixed bug in hilit-toggle-highlight
232;; added string highlighting
233;; fixed bug in hilit-lookup-face-create
234;; additions for Ada, Tex, LaTeX, and Texinfo (is scribe next? =)
235;; now highlight template decls in C++
236;; added reverse-* intelligence to hilit-lookup-face-create
237;; imported wysiwyg (overstrike replacement) stuff from my hacks to man.el
238;; sketched out a stub of a wysiwyg write file hook, care to finish it?
239;; V1.1 25-June-1993 Stig@netcom.com
240;; replaced last vestiges of original hilit.el
241;; now map default modes to major-mode values
242;; reworked face allocation so that colors don't get tied up
243;; rewrote some comments that I'd put in earlier but somehow managed to nuke
244;; V1.0 22-June-1993 Stig@netcom.com
245;; incrementally replaced just about everything...simpler, cleaner, & faster
246;; extended highlight coverage for C/C++ modes (highlight more things)
247;; added layer of indirection to face selection
248
249;;;;;; THIS WILL ALLOW INFO PAGES TO BE HILIGHTED:
250;;
251;; *** 19.15/info.el Sat Jun 19 14:47:06 1993
252;; --- 19/info.el Sun Jul 4 03:33:12 1993
253;; ***************
254;; *** 475,481 ****
255;; (setq active-expression
256;; (read (current-buffer))))))
257;; (point-max)))
258;; ! (if Info-enable-active-nodes (eval active-expression)))))
259;;
260;; (defun Info-set-mode-line ()
261;; (setq mode-line-buffer-identification
262;; --- 475,482 ----
263;; (setq active-expression
264;; (read (current-buffer))))))
265;; (point-max)))
266;; ! (if Info-enable-active-nodes (eval active-expression)))
267;; ! (run-hooks 'Info-select-hook)))
268;;
269;; (defun Info-set-mode-line ()
270;; (setq mode-line-buffer-identification
271;;
272;;;;;; AND THIS CAN BE APPLIED TO VM 5.33L_19
273;;
274;; *** ../site/vm5.33L_19/vm-summary.el Fri Jun 4 22:17:11 1993
275;; --- ./vm-summary.el Tue Jun 22 16:39:30 1993
276;; ***************
277;; *** 152,158 ****
278;; (insert "->")
279;; (delete-char 2)
280;; (forward-char -2)
281;; ! (and w vm-auto-center-summary (vm-auto-center-summary))))
282;; (and old-window (select-window old-window)))))))
283;;
284;; (defun vm-mark-for-display-update (message)
285;; --- 152,159 ----
286;; (insert "->")
287;; (delete-char 2)
288;; (forward-char -2)
289;; ! (and w vm-auto-center-summary (vm-auto-center-summary))
290;; ! (run-hooks 'vm-summary-pointer-hook)))
291;; (and old-window (select-window old-window)))))))
292;;
293;; (defun vm-mark-for-display-update (message)
294;;
295;;;;;;
296
297
298;; User Options:
299
300(defvar hilit-quietly nil
301 "* If non-nil, this inhibits progress indicators during highlighting")
302
303(defvar hilit-inhibit-hooks nil
304 "* If non-nil, this inhibits installation of hooks for Info, gnus, & vm.")
305
306(defvar hilit-background-mode 'light
307 "* 'mono inhibits color, 'dark or 'light indicate the background brightness.")
308
309(defvar hilit-mode-enable-list nil
310 "* If a list of modes to exclusively enable or specifically disable.
311The sense of the list is negated if it begins with the symbol 'not'.
312Set this variable before you load hilit19.
313
314Ex: (perl-mode jargon-mode c-mode) ; just perl, C, and jargon modes
315 (not text-mode) ; all modes except text mode")
316
317(defvar hilit-auto-highlight t
318 "* T if we should highlight all buffers as we find 'em, nil to disable
319 automatic highlighting by the find-file hook.")
320
321(defvar hilit-auto-highlight-maxout 57000
322 "* auto-highlight is disabled in buffers larger than this")
323
324(defvar hilit-auto-rehighlight t
325 "* If this is non-nil, then hilit-redraw and hilit-recenter will also
326 rehighlight part or all of the current buffer. T will rehighlights the
327 whole buffer, a NUMBER will rehighlight that many lines before and
328 after the cursor, or the symbol 'visible' will rehighlight only the visible
329 portion of the current buffer.")
330
331(make-variable-buffer-local 'hilit-auto-rehighlight)
332(setq-default hilit-auto-rehighlight t)
333
334(defvar hilit-auto-rehighlight-fallback '(20000 . 100)
335 "* Cons of the form (THRESHOLD . FALLBACK), where FALLBACK is assigned to
336hilit-auto-rehighlight if the size of a newly opened buffer is larger than
337THRESHOLD.")
338
339(defvar hilit-face-check t
340 "* T slows down highlighting but permits the user to change fonts without
341losing bold and italic faces... T causes hilit-lookup-face-create to dig
342through the frame parameters for the current window every time it's called.
343If you never change fonts in emacs, set this to NIL.")
344
345;; Variables that are not generally modified directly
346
347(defvar hilit-parser-alist nil
348 "alist of major-mode values and parsers called by hilit-rehighlight-buffer.
349
350Parsers for a given mode are IGNORED for partial rehighlights...maybe you'd
351like to make this more universal?")
352
353(defvar hilit-patterns-alist nil
354 "alist of major-mode values and default highlighting patterns
355
356A hilighting pattern is a list of the form (start end face), where
357start is a regex, end is a regex (or nil if it's not needed) and face
358is the name of an entry in hilit-face-translation-table, the name of a face,
359or nil (which disables the pattern).
360
361See the hilit-lookup-face-create documentation for valid face names.")
362
363(defvar hilit-predefined-face-list (face-list)
364 "List of faces which with hilit-lookup-face-create will NOT tamper.
365
366If hilit19 is dumped into emacs at your site, you may have to set this in
367your init file.")
368
369;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
370;; Use this to report bugs:
371
372(defun hilit-submit-feeback ()
373 "Submit via mail a bug report on stig-paren"
374 (interactive)
375 (require 'reporter)
376 (and (y-or-n-p "Do you really want to submit a report on hilit19? ")
377 (reporter-submit-bug-report
378 "Jonathan Stigelman <Stig@netcom.com>"
379 "hilit19.el Beta 1.9 ($Revision: 1.34 $)"
380 (and (y-or-n-p "Do you need to include a dump hilit variables? ")
381 (append
382 '(
383 hilit-quietly hilit-inhibit-hooks
384 hilit-background-mode hilit-mode-enable-list
385 hilit-auto-highlight hilit-auto-highlight-maxout
386 hilit-auto-rehighlight hilit-auto-rehighlight-fallback
387 hilit-face-check
388 )
389 (and (y-or-n-p "Have you modified the standard patterns? ")
390 (yes-or-no-p "Are your patterns *REALLY* relevant? ")
391 '(hilit-parser-alist
392 hilit-patterns-alist
393 hilit-predefined-face-list
394 ))))
395 (function
396 (lambda ()
397 (insert "\nFrame Configuration:\n====================\n"
398 (prin1-to-string (frame-configuration-to-register ?F))
399 "\n"
400 )))
401 nil
402 (concat
403 "This is (check all that apply, or delete those that don't):\n"
404 " [ ] a _MASSIVE_THANK_YOU_ for writing hilit19.el\n"
405 " [ ] my DONATION to your vacation fund (prototype digital cash)\n"
406 " [ ] You're a RIGHTEOUS HACKER, what are your rates?\n"
407 " [ ] I've used the force and read the source, but I'M CONFUSED\n"
408 " [ ] a PATCH (diff -cw oldversion newversion) to fix a problem\n"
409 " [ ] a REPRODUCABLE BUG that I do not believe to be an EMACS bug\n"
410 " - I *swear* that it's not already mentioned in the KNOWN BUGS\n"
411 " - Also, I have checked netcom.com:/pub/stig/src/hilit19.el.gz\n"
412 " for a newer release that fixes the problem.\n"
413 " [ ] ADVICE -- or an unfulfilled desire that I suspect you share\n"
414 "\n"
415 "Hey Stig, do you do anything besides hack emacs?\n"))))
416
417;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
418;;
419;; These faces are either a valid face name, or nil
420;; if you want to change them, you must do so AFTER hilit19 is loaded
421
422(defconst hilit-face-translation-table
423 (cond ((and (eq hilit-background-mode 'light) (x-display-color-p))
424 ;; COLOR DEFAULTS for LIGHT backgrounds
425 '(
426 ;; used for C/C++ and elisp and perl
427 (comment . firebrick-italic)
428 (include . purple)
429 (define . ForestGreen-bold)
430 (defun . blue-bold)
431 (decl . RoyalBlue)
432 (type . nil)
433 (keyword . RoyalBlue)
434 (label . red-bold)
435 (string . grey40)
436
437 ;; some further faces for Ada
438 (struct . black-bold)
439 (glob-struct . magenta)
440 (named-param . DarkGoldenrod)
441
442 ;; and anotherone for LaTeX
443 (crossref . DarkGoldenrod)
444
445 (wysiwyg-bold . bold)
446 (wysiwyg-underline . underline)
447
448 ;; compilation buffers
449 (error . red-bold)
450 (warning . firebrick)
451
452 ;; Makefiles (some faces borrowed from C/C++ too)
453 (rule . blue-bold)
454
455 ;; VM, GNUS and Text mode
456 (msg-subject . blue-bold)
457 (msg-from . purple-bold)
458 (msg-header . firebrick-bold)
459 (msg-separator . black/tan-bold)
460 (msg-quote . ForestGreen)
461
462 (summary-seen . grey40)
463 (summary-killed . grey50)
464 (summary-Xed . OliveDrab2)
465 (summary-current . default/skyblue-bold)
466 (summary-deleted . firebrick)
467 (summary-unread . RoyalBlue)
468 (summary-new . blue-bold)
469
470 (gnus-group-unsubscribed . grey50)
471 (gnus-group-empty . nil)
472 (gnus-group-full . ForestGreen)
473 (gnus-group-overflowing . firebrick)
474
475 ;; dired mode
476 (dired-directory . blue-bold)
477 (dired-link . firebrick-italic)
478 (dired-ignored . ForestGreen)
479 (dired-deleted . red-bold-italic)
480 (dired-marked . purple)
481
482 ;; see jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon*.txt
483 (jargon-entry . blue-bold)
484 (jargon-xref . purple-bold)
485 ;; really used for Info-mode
486 (jargon-keyword . firebrick-underline)
487 ))
488 ((and (eq hilit-background-mode 'dark) (x-display-color-p))
489 ;; COLOR DEFAULTS for DARK backgrounds
490 '(
491 ;; used for C/C++ and elisp and perl
492 (comment . moccasin)
493 (include . Plum1)
494 (define . green)
495 (defun . cyan-bold)
496 (decl . cyan)
497 (type . yellow)
498 (keyword . cyan)
499 (label . orange-underlined)
500 (string . orange)
501
502 ;; some further faces for Ada
503 (struct . white-bold)
504 (glob-struct . Plum1)
505 (named-param . Goldenrod)
506
507 ;; and anotherone for LaTeX
508 (crossref . Goldenrod)
509
510 (wysiwyg-bold . bold)
511 (wysiwyg-underline . underline)
512
513 ;; compilation buffers
514 (error . yellow)
515 (warning . green)
516
517 ;; Makefiles (some faces borrowed from C/C++ too)
518 (rule . cyan)
519
520 ;; VM, GNUS and Text mode
521 (msg-subject . yellow)
522 (msg-from . SeaGreen2)
523 (msg-header . cyan)
524 (msg-separator . lightblue)
525 (msg-quote . green)
526
527 (summary-seen . white)
528 (summary-killed . white)
529 (summary-Xed . green)
530 (summary-current . green-bold)
531 (summary-deleted . white)
532 (summary-unread . yellow)
533 (summary-new . yellow-bold)
534
535 (gnus-group-unsubscribed . white)
536 (gnus-group-empty . yellow)
537 (gnus-group-full . green)
538 (gnus-group-overflowing . orange)
539
540 ;; dired mode
541 (dired-directory . cyan)
542 (dired-link . green)
543 (dired-ignored . moccasin)
544 (dired-deleted . orange)
545 (dired-marked . Plum1)
546
547 ;; see jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon*.txt
548 (jargon-entry . cyan)
549 (jargon-xref . Plum1)
550 ;; really used for Info-mode
551 (jargon-keyword . yellow)
552 ))
553 (t
554 ;; MONO DEFAULTS -- you lose
555 '(
556 ;; used for C/C++ and elisp and perl
557 (comment . italic)
558 (include . default-bold-italic)
559 (define . bold)
560 (defun . default-bold-italic)
561 (decl . bold)
562 (type . nil)
563 (keyword . default-bold-italic)
564 (label . underline)
565 (string . underline)
566
567 ;; some further faces for Ada
568 (struct . bold)
569 (named-param . underline)
570 (glob-struct . default-bold-underline)
571
572 ;; and another one for LaTeX
573 (crossref . underline)
574
575 (wysiwyg-bold . bold)
576 (wysiwyg-underline . underline)
577
578 ;; compilation buffers
579 (error . bold)
580 (warning . italic)
581
582 ;; Makefiles (some faces borrowed from C/C++ too)
583 (rule . bold)
584
585 ;; VM, GNUS and Text mode
586 (msg-subject . bold)
587 (msg-from . bold)
588 (msg-header . italic)
589 (msg-separator . nil)
590 (msg-quote . italic)
591
592 (summary-seen . nil)
593 (summary-killed . nil)
594 (summary-Xed . nil)
595 (summary-current . reverse-default)
596 (summary-unread . bold)
597 (summary-deleted . italic)
598 (summary-new . default-bold-italic)
599
600 (gnus-group-unsubscribed . nil)
601 (gnus-group-empty . nil)
602 (gnus-group-full . italic)
603 (gnus-group-overflowing . default-bold-italic)
604
605 ;; dired mode
606 (dired-directory . bold)
607 (dired-link . italic)
608 (dired-ignored . nil)
609 (dired-marked . nil)
610 (dired-deleted . default-bold-italic)
611
612 ;; see jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon*.txt
613 (jargon-entry . bold)
614 (jargon-xref . italic)
615 ;; really used for Info-mode
616 (jargon-keyword . underline)
617 ))
618 )
619 "alist that maps symbolic face-names to real face names")
620
621;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
622;; To translate one face to another...
623;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
624
625(defmacro hilit-translate (&rest args)
626 "(hilit-translate FROM TO FROM TO ...): translate each face FROM to the
627value of its TO face. This is like setq for faces.
628
629The function hilit-lookup-face-create will repeatedly translate until no more
630translations for the face exist in the translation table.
631
632See the documentation for hilit-lookup-face-create for names of valid faces.
633"
634;; can't have an interactive macro
635;; (interactive "SFace translate from: \nSFace translate to: ")
636 (or (zerop (% (length args) 2))
637 (error "wrong number of args"))
638 (let (cmdl from to)
639 (while args
640 (setq from (car args) to (nth 1 args) args (nthcdr 2 args)
641 cmdl (cons (list 'hilit-associate ''hilit-face-translation-table
642 ;; this is for reverse compatibility...
643 (if (and (consp from) (eq 'quote (car from)))
644 from
645 (list 'quote from)) to)
646 cmdl)))
647 (cons 'progn cmdl)))
648
649;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
650;; This function actually translates and then creates the faces...
651;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
652
653(defun hilit-lookup-face-create (face &optional force)
654 "Get a FACE, or create it if it doesn't exist. In order for it to
655properly create the face, the followwing naming convention must be used:
656 [reverse-](fgcolor[/bgcolor])[-bold][-italic][-underline]
657Example: (hilit-lookup-face-create 'comment-face) might create and return 'red
658
659Each color is either the name of an X color (see .../X11/lib/X11/rgb.txt),
660a hexadecimal specification of the form \"hex-[0-9A-Fa-f]+\", or \"default\".
661
662An optional argument, FORCE, will cause the face to be recopied from the
663default...which is probably of use only if you've changed fonts.
664
665See the documentation for hilit-translate and hilit-face-translation-table."
666
667;; translate the face ...
668 (let ((trec t) visited)
669 (while trec
670 (cond ((memq face visited) (error "face translation loop: %S" visited))
671 (t (setq visited (cons face visited)
672 trec (assq face hilit-face-translation-table))
673 (and trec (setq face (cdr trec)))))))
674
675 ;; make the face if we need to...
676 (let* ((fn (symbol-name face))
677 (frame (selected-frame))
678 (basefont (cdr (assq 'font (frame-parameters frame))))
679 error fgcolor bgcolor)
680 (cond
681 ((or (null face)
682 (memq face hilit-predefined-face-list))
683 ;; do nothing if the face is nil or if it's predefined.
684 )
685 ((or force
686 (not (memq face (face-list)))
687 (and hilit-face-check
688 (not (string= (get face 'basefont) basefont))))
689 (copy-face 'default 'scratch-face)
690 (if (string-match "^reverse-?" fn)
691 (progn (invert-face 'scratch-face)
692 (setq fn (substring fn (match-end 0)))))
693
694 ;; parse foreground color
695 (if (string-match "^\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn)
696 (setq fgcolor (concat
697 (if (match-beginning 1) "#")
698 (substring fn (match-beginning 2) (match-end 2)))
699 fn (substring fn (match-end 0)))
700 (error "bad face name %S" face))
701
702 ;; parse background color
703 (if (string-match "^/\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn)
704 (setq bgcolor (concat
705 (and (match-beginning 1) "#")
706 (substring fn (match-beginning 2) (match-end 2)))
707 fn (substring fn (match-end 0))))
708
709 (and (string= "default" fgcolor) (setq fgcolor nil))
710 (and (string= "default" bgcolor) (setq bgcolor nil))
711
712 ;; catch errors if we can't allocate the color(s)
713 (condition-case nil
714 (progn (set-face-foreground 'scratch-face fgcolor)
715 (set-face-background 'scratch-face bgcolor)
716 (copy-face 'scratch-face face)
717 (put face 'basefont basefont))
718 (error (message "couldn't allocate color for '%s'"
719 (symbol-name face))
720 (setq face 'default)
721 (setq error t)))
722 (or error
723 ;; don't bother w/ bold or italic if we didn't get the color
724 ;; we wanted, but ignore errors making the face bold or italic
725 ;; if the font isn't available, there's nothing to do about it...
726 (progn
727 (set-face-font face nil frame)
728 (set-face-underline-p face (string-match "underline" fn))
729 (if (string-match ".*bold" fn)
730 (make-face-bold face frame 'noerr))
731 (if (string-match ".*italic" fn)
732 (make-face-italic face frame 'noerr))
733 ))
734 )))
735 face)
736
737;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
738;; Region Highlight/Unhighlight code (Both overlay and text-property versions)
739;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
740
741(defsubst hilit-region-set-face (start end face-name &optional prio prop)
742 "Highlight region from START to END using FACE and, optionally, PRIO.
743The optional 5th arg, PROP is a property to set instead of 'hilit."
744 (let ((overlay (make-overlay start end)))
745 (overlay-put overlay 'face face-name)
746 (overlay-put overlay (or prop 'hilit) t)
747 (and prio (overlay-put overlay 'priority prio))))
748
749(defun hilit-unhighlight-region (start end &optional quietly)
750 "Unhighlights the region from START to END, optionally in a QUIET way"
751 (interactive "r")
752 (or quietly hilit-quietly (message "Unhighlighting"))
753 (while (< start end)
754 (mapcar (function (lambda (ovr)
755 (and (overlay-get ovr 'hilit) (delete-overlay ovr))))
756 (overlays-at start))
757 (setq start (next-overlay-change start)))
758 (or quietly hilit-quietly (message "Done unhighlighting")))
759
760;;;; These functions use text properties instead of overlays. Text properties
761;;;; are copied through kill and yank...which might be convenient, but is not
762;;;; terribly efficient as of 19.12, ERGO it's been disabled
763;;
764;;(defsubst hilit-region-set-face (start end face-name &optional prio prop)
765;; "Highlight region from START to END using FACE and, optionally, PRIO.
766;;The optional 5th arg, PROP is a property to set instead of 'hilit."
767;; (put-text-property start end 'face face-name)
768;; )
769;;
770;;(defun hilit-unhighlight-region (start end &optional quietly)
771;; "Unhighlights the region from START to END, optionally in a QUIET way"
772;; (interactive "r")
773;; (let ((buffer-read-only nil)
774;; (bm (buffer-modified-p)))
775;; (remove-text-properties start end '(face))
776;; (set-buffer-modified-p bm)))
777;;;;
778
779;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
780;; Pattern Application code and user functions
781;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
782
783(defun hilit-highlight-region (start end &optional patterns quietly)
784 "Highlights the area of the buffer between START and END (the region when
785interactive). Without the optional PATTERNS argument, the pattern for
786major-mode is used. If PATTERNS is a symbol, then the patterns associated
787with that symbol are used. QUIETLY suppresses progress messages if
788non-nil."
789 (interactive "r")
790 (cond ((null patterns)
791 (setq patterns (cdr (assq major-mode hilit-patterns-alist))))
792 ((symbolp patterns)
793 (setq patterns (cdr (assq patterns hilit-patterns-alist)))))
794 ;; txt prop: (setq patterns (reverse patterns))
795 (let ((prio (length patterns))
796 (case-fold-search nil)
797 ;; txt prop: (buffer-read-only nil)
798 ;; txt prop: (bm (buffer-modified-p))
799 p pstart pend face mstart)
800 ;; txt prop: (unwind-protect
801 (save-excursion
802 (save-restriction
803 (narrow-to-region start end)
804 (while patterns
805 (setq p (car patterns))
806 (setq pstart (car p)
807 pend (nth 1 p)
808 face (hilit-lookup-face-create (nth 2 p)))
809 (if (not face) ; skipped if nil
810 nil
811 (or quietly hilit-quietly
812 (message "highlighting %d: %s%s" prio pstart
813 (if pend (concat " ... " pend) "")))
814 (goto-char (point-min))
815 (condition-case nil
816 (cond
817 ((symbolp pstart)
818 ;; inner loop -- special function to find pattern
819 (let (region)
820 (while (setq region (funcall pstart pend))
821 (hilit-region-set-face (car region) (cdr region)
822 face prio))))
823 (pend
824 ;; inner loop -- regex-start ... regex-end
825 (while (re-search-forward pstart nil t nil)
826 (goto-char (setq mstart (match-beginning 0)))
827 (if (re-search-forward pend nil t nil)
828 (hilit-region-set-face mstart (match-end 0)
829 face prio)
830 (forward-char 1))))
831 (t
832 ;; inner loop -- just one regex to match whole pattern
833 (while (re-search-forward pstart nil t nil)
834 (hilit-region-set-face (match-beginning 0)
835 (match-end 0) face prio))))
836 (error (message "Unbalanced delimiters? Barfed on '%s'"
837 pstart)
838 (ding) (sit-for 4))))
839 (setq prio (1- prio)
840 patterns (cdr patterns)))
841 ))
842 (or quietly hilit-quietly (message "")) ; "Done highlighting"
843 ;; txt prop: (set-buffer-modified-p bm)) ; unwind protection
844 ))
845
846(defun hilit-rehighlight-region (start end &optional quietly)
847 "Re-highlights the region, optionally in a QUIET way"
848 (interactive "r")
849 (setq start (apply 'min start (mapcar 'overlay-start (overlays-at start)))
850 end (apply 'max end (mapcar 'overlay-end (overlays-at end))))
851 (hilit-unhighlight-region start end quietly)
852 (hilit-highlight-region start end nil quietly))
853
854(defun hilit-rehighlight-buffer (&optional quietly)
855 "Re-highlights the buffer, optionally in a QUIET way"
856 (interactive "")
857 (let ((parse-fn (cdr (assq major-mode hilit-parser-alist))))
858 (if parse-fn
859 (funcall parse-fn quietly)
860 (hilit-rehighlight-region (point-min) (point-max) quietly)))
861 nil)
862
863(defun hilit-rehighlight-buffer-quietly ()
864 (hilit-rehighlight-buffer t))
865
866(defun hilit-rehighlight-message (quietly)
867 "Highlight a buffer containing a news article or mail message."
868 (save-excursion
869 (goto-char (point-min))
870 (re-search-forward "^$" nil 'noerr)
871 (hilit-unhighlight-region (point-min) (point-max) quietly)
872 (hilit-highlight-region (point-min) (point) 'msg-header quietly)
873 (hilit-highlight-region (point) (point-max) 'msg-body quietly)))
874
875(defalias 'hilit-highlight-buffer 'hilit-rehighlight-buffer)
876
877(defun hilit-toggle-highlight (arg)
878 "Locally toggle highlighting. With arg, forces highlighting off."
879 (interactive "P")
880 ;; FIXME -- this loses numeric information in hilit-auto-rehighlight
881 (setq hilit-auto-rehighlight
882 (and (not arg) (not hilit-auto-rehighlight)))
883 (if hilit-auto-rehighlight
884 (hilit-rehighlight-buffer)
885 (hilit-unhighlight-region (point-min) (point-max)))
886 (message "Rehighlighting is set to %s" hilit-auto-rehighlight))
887
888;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
889;; HOOKS
890;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
891
892(defun hilit-find-file-hook ()
893 "Find-file hook for hilit package. See the variable hilit-auto-highlight."
894 (cond ((and hilit-auto-highlight
895 (assq major-mode hilit-patterns-alist))
896 (if (> buffer-saved-size (car hilit-auto-rehighlight-fallback))
897 (setq hilit-auto-rehighlight
898 (cdr hilit-auto-rehighlight-fallback)))
899 (if (> buffer-saved-size hilit-auto-highlight-maxout) nil
900 (hilit-rehighlight-buffer)
901 (set-buffer-modified-p nil)))))
902
903(defun hilit-repaint-command (arg)
904 "Rehighlights according to the value of hilit-auto-rehighlight, or the
905prefix argument if that is specified.
906\t\\[hilit-repaint-command]\t\trepaint according to hilit-auto-rehighlight
907\t^U \\[hilit-repaint-command]\trepaint entire buffer
908\t^U - \\[hilit-repaint-command]\trepaint visible portion of buffer
909\t^U n \\[hilit-repaint-command]\trepaint n lines to either side of point"
910 (interactive "P")
911 (let (st en quietly)
912 (or arg (setq arg hilit-auto-rehighlight))
913 (cond ((or (eq arg 'visible) (eq arg '-))
914 (setq st (window-start) en (window-end) quietly t))
915 ((numberp arg)
916 (setq st (save-excursion (forward-line (- arg)) (point))
917 en (save-excursion (forward-line arg) (point))))
918 (arg
919 (hilit-rehighlight-buffer)))
920 (if st
921 (hilit-rehighlight-region st en quietly))))
922
923;; (defun hilit-rehighlight-yank-region ()
924;; "Rehighlights from the beginning of the line where the region starts to
925;; the end of the line where the region ends. This could flake out on
926;; multi-line highlights (like C comments and lisp strings.)"
927;; (if hilit-auto-rehighlight
928;; (hilit-rehighlight-region
929;; (save-excursion (goto-char (region-beginning))
930;; (beginning-of-line) (point))
931;; (save-excursion (goto-char (region-end))
932;; (end-of-line) (point))
933;; t)))
934
935(defun hilit-recenter (arg)
936 "Recenter, then rehighlight according to hilit-auto-rehighlight. If called
937with an unspecified prefix argument (^U but no number), then a rehighlight of
938the entire buffer is forced."
939 (interactive "P")
940 (recenter arg)
941 ;; force display update
942 (sit-for 0)
943 (hilit-repaint-command (consp arg)))
944
945;; (defun hilit-redraw-display (arg)
946;; "Rehighlights according to the value of hilit-auto-rehighlight, a prefix
947;; arg forces a rehighlight of the whole buffer. Otherwise just like
948;; redraw-display."
949;; (interactive "P")
950;; (hilit-redraw-internal arg)
951;; (redraw-display))
952
953(defun hilit-yank (arg)
954 "Yank with rehighlighting"
955 (interactive "*P")
956 (let ((transient-mark-mode nil))
957 (yank arg)
958 (hilit-rehighlight-region (region-beginning) (region-end) t)
959 (setq this-command 'yank)))
960
961(defun hilit-yank-pop (arg)
962 "Yank-pop with rehighlighting"
963 (interactive "*p")
964 (let ((transient-mark-mode nil))
965 (yank-pop arg)
966 (hilit-rehighlight-region (region-beginning) (region-end) t)
967 (setq this-command 'yank)))
968
969;;; this line highlighting stuff is untested. play with it only if you feel
970;;; adventurous...don't ask me to fix it...though you're welcome to. -- Stig
971;;
972;; (defun hilit-rehighlight-line-quietly (&rest args)
973;; "Quietly rehighlight just this line.
974;; Useful as an after change hook in VM/gnus summary buffers and dired buffers.
975;; If only there were an after-change-function, that is..."
976;; (save-excursion
977;; (push-mark nil t)
978;; (hilit-rehighlight-yank-region)
979;; (and orig-achange-function (apply orig-achange-function args))))
980;;
981;; (defun hilit-install-line-hooks ()
982;; (make-variable-buffer-local 'after-change-function)
983;; (make-local-variable 'orig-achange-function)
984;; (setq orig-achange-function after-change-function)
985;; (setq after-change-function 'hilit-rehighlight-line-quietly))
986
987;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
988;; Wysiwyg Stuff... take it away and build a whole package around it!
989;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
990;;
991;; ; For the Jargon-impaired, WYSIWYG === What You See Is What You Get
992;; ; Sure, it sucks to type. Oh, well.
993;; (defun hilit-wysiwyg-replace ()
994;; "Replace overstruck text with normal text that's been overlayed with the
995;; appropriate text attribute. Suitable for a find-file hook."
996;; (save-excursion
997;; (goto-char (point-min))
998;; (let ((wysb (hilit-lookup-face-create 'wysiwyg-bold))
999;; (wysu (hilit-lookup-face-create 'wysiwyg-underline))
1000;; (bmod (buffer-modified-p)))
1001;; (while (re-search-forward "\\(.\b.\\)+" nil t)
1002;; (let ((st (match-beginning 0)) (en (match-end 0)))
1003;; (goto-char st)
1004;; (if (looking-at "_")
1005;; (hilit-region-set-face st en wysu 100 'wysiwyg)
1006;; (hilit-region-set-face st en wysb 100 'wysiwyg))
1007;; (while (and (< (point) en) (looking-at ".\b"))
1008;; (replace-match "") (forward-char))
1009;; ))
1010;; (set-buffer-modified-p bmod))))
1011;;
1012;; ; is this more appropriate as a write-file-hook or a write-contents-hook?
1013;; (defun hilit-wysiwyg-write-repair ()
1014;; "Replace wysiwyg overlays with overstrike text."
1015;; (message "*sigh* hilit-wysiwyg-write-repair not implemented yet")
1016;;
1017;; For efficiency, this hook should copy the current buffer to a scratch
1018;; buffer and do it's overstriking there. Overlays are not copied, so it'll
1019;; be necessary to hop back and forth. This is OK since you're not fiddling
1020;; with--making or deleting--any overlays. THEN write the new buffer,
1021;; delete it, and RETURN T. << important
1022;;
1023;; Just so you know...there is already an emacs function called
1024;; underline-region that does underlining. I think that the thing to do is
1025;; extend that to do overstriking as well.
1026;;
1027;; (while (< start end)
1028;; (mapcar (function (lambda (ovr)
1029;; (and (overlay-get ovr 'hilit) (delete-overlay ovr))))
1030;; (overlays-at start))
1031;; (setq start (next-overlay-change start)))
1032;; nil)
1033
1034;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1035;; Initialization.
1036;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1037
1038(substitute-key-definition 'yank 'hilit-yank (current-global-map))
1039(substitute-key-definition 'yank-pop 'hilit-yank-pop (current-global-map))
1040
1041;; (substitute-key-definition 'recenter 'hilit-recenter (current-global-map))
1042;; (substitute-key-definition 'redraw-display 'hilit-redraw-display
1043;; (current-global-map))
1044
1045(global-set-key [?\C-\S-l] 'hilit-repaint-command)
1046
1047(and window-system
1048 (add-hook 'find-file-hooks 'hilit-find-file-hook t))
1049
1050(and (not hilit-inhibit-hooks)
1051 window-system
1052 (condition-case c
1053 (progn
1054
1055 ;; BUFFER highlights...
1056 (mapcar (function
1057 (lambda (hook)
1058 (add-hook hook 'hilit-rehighlight-buffer-quietly)))
1059 '(
1060 Info-select-hook
1061 vm-summary-mode-hooks
1062 vm-summary-pointer-hook
1063 gnus-summary-prepare-hook
1064 gnus-group-prepare-hook
1065
1066 vm-preview-message-hook
1067 vm-show-message-hook
1068 gnus-article-prepare-hook
1069 rmail-show-message-hook
1070 mail-setup-hook
1071 ))
1072
1073 ;; rehilight only the visible part of the summary buffer for speed.
1074 (add-hook 'gnus-mark-article-hook
1075 (function
1076 (lambda ()
1077 (or (memq gnus-current-article gnus-newsgroup-marked)
1078 (gnus-summary-mark-as-read gnus-current-article))
1079 (gnus-summary-set-current-mark)
1080 (save-excursion
1081 (set-buffer gnus-summary-buffer)
1082 (hilit-rehighlight-region (window-start)
1083 (window-end) t)
1084 ))))
1085 ;; only need prepare article hook
1086 ;;
1087 ;; (add-hook 'gnus-select-article-hook
1088 ;; '(lambda () (save-excursion
1089 ;; (set-buffer gnus-article-buffer)
1090 ;; (hilit-rehighlight-buffer))))
1091 )
1092 (error (message "Error loading highlight hooks: %s" c)
1093 (ding) (sit-for 1))))
1094
1095;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1096;; Default patterns for various modes.
1097;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1098
1099;;; do I need this? I changed the defconst to a defvar because defconst is
1100;;; inappropriate, but I don't know why I wanted hilit-patterns-alist to be
1101;;; reset on every reload...
1102
1103(setq hilit-patterns-alist nil)
1104
1105(defun hilit-associate (alist key val)
1106 "creates, or destructively replaces, the pair (key . val) in alist"
1107 (let ((oldentry (assq key (eval alist))))
1108 (if oldentry
1109 (setcdr oldentry val)
1110 (set alist (cons (cons key val) (eval alist))))))
1111
1112(defun hilit-set-mode-patterns (modelist patterns &optional parse-fn)
1113 "Sets the default hilighting patterns for MODE to PATTERNS.
1114See the variable hilit-mode-enable-list."
1115 (or (consp modelist) (setq modelist (list modelist)))
1116 (let (ok (flip (eq (car hilit-mode-enable-list) 'not)))
1117 (mapcar (function
1118 (lambda (m)
1119 (setq ok (or (null hilit-mode-enable-list)
1120 (memq m hilit-mode-enable-list)))
1121 (and flip (setq ok (not ok)))
1122 (and ok
1123 (progn
1124 (and parse-fn
1125 (hilit-associate 'hilit-parser-alist m parse-fn))
1126 (hilit-associate 'hilit-patterns-alist m patterns)))))
1127 modelist)))
1128
1129(defun hilit-string-find (qchar)
1130 "looks for a string and returns (start . end) or NIL. The argument QCHAR
1131is the character that would precede a character constant double quote.
1132Finds [^QCHAR]\" ... [^\\]\""
1133 (let (st en)
1134 (while (and (search-forward "\"" nil t)
1135 (eq qchar (char-after (1- (setq st (match-beginning 0)))))))
1136 (while (and (search-forward "\"" nil t)
1137 (eq ?\\ (char-after (- (setq en (point)) 2)))))
1138 (and en (cons st en))))
1139
1140(hilit-set-mode-patterns
1141 '(c-mode c++-c-mode elec-c-mode)
1142 '(("/\\*" "\\*/" comment)
1143 ; ("\"" "[^\\]\"" string)
1144 (hilit-string-find ?' string)
1145 ;; declaration
1146 ("^#[ \t]*\\(undef\\|define\\).*$" nil define)
1147 ("^#.*$" nil include)
1148 ;; function decls are expected to have types on the previous line
1149 ("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
1150 ("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl)
1151 ;; datatype -- black magic regular expression
1152 ("[ \n\t({]\\(\\(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)
1153 ;; key words
1154 ("\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>" nil keyword)
1155 ))
1156
1157(hilit-set-mode-patterns
1158 'c++-mode
1159 '(("/\\*" "\\*/" comment)
1160 ("//.*$" nil comment)
1161 ("^/.*$" nil comment)
1162; ("\"" "[^\\]\"" string)
1163 (hilit-string-find ?' string)
1164 ;; declaration
1165 ("^#[ \t]*\\(undef\\|define\\).*$" nil define)
1166 ("^#.*$" nil include)
1167 ;; function decls are expected to have types on the previous line
1168 ("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
1169 ("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
1170 ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl)
1171 ;; datatype -- black magic regular expression
1172 ("[ \n\t({]\\(\\(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)
1173 ;; key words
1174 ("\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>"
1175 nil keyword)))
1176
1177(hilit-set-mode-patterns
1178 'perl-mode
1179 '(("\\s #.*$" nil comment)
1180 ("^#.*$" nil comment)
1181 ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string)
1182 ("^\\(__....?__\\|\\s *\\sw+:\\)" nil label)
1183 ("^require.*$" nil include)
1184 ("^package.*$" nil decl)
1185 ("^\\s *sub\\s +\\(\\w\\|[_']\\)+" nil defun)
1186 ("\\b\\(do\\|if\\|unless\\|while\\|until\\|else\\|elsif\\|for\\|foreach\\|continue\\|next\\|redo\\|last\\|goto\\|return\\|die\\|exit\\)\\b" nil keyword)))
1187
1188(hilit-set-mode-patterns
1189 'ada-mode
1190 '(;; comments
1191 ("--.*$" nil comment)
1192 ;; main structure
1193 ("[ \t\n]procedure[ \t]" "\\([ \t]\\(is\\|renames\\)\\|);\\)" glob-struct)
1194 ("[ \t\n]task[ \t]" "[ \t]is" glob-struct)
1195 ("[ \t\n]function[ \t]" "return[ \t]+[A-Za-z_0-9]+[ \t]*\\(is\\|;\\|renames\\)" glob-struct)
1196 ("[ \t\n]package[ \t]" "[ \t]\\(is\\|renames\\)" glob-struct)
1197 ;; if there is nothing before "private", it is part of the structure
1198 ("^[ \t]*private[ \t\n]" nil glob-struct)
1199 ;; if there is no indentation before the "end", then it is most
1200 ;; probably the end of the package
1201 ("^end.*$" ";" glob-struct)
1202 ;; program structure -- "null", "delay" and "terminate" omitted
1203 ("[ \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)
1204 ;; block structure
1205 ("[ \n\t]\\(begin\\|end\\|declare\\|exception\\|generic\\|raise\\|return\\|package\\|body\\)[ \n\t;]" nil struct)
1206 ;; type declaration
1207 ("^[ \t]*\\(type\\|subtype\\).*$" ";" decl)
1208 ("[ \t]+is record.*$" "end record;" decl)
1209 ;; "pragma", "with", and "use" are close to C cpp directives
1210 ("^[ \t]*\\(with\\|pragma\\|use\\)" ";" include)
1211 ;; nice for named parameters, but not so beautiful in case statements
1212 ("[A-Za-z_0-9.]+[ \t]*=>" nil named-param)
1213 ;; string constants probably not everybody likes this one
1214 ("\"" ".*\"" string)))
1215
1216(hilit-set-mode-patterns
1217 'fortran-mode
1218 '(("^[*Cc].*$" nil comment)
1219 ("[ \t]\\(call\\|program\\|subroutine\\|function\\|stop\\|return\\|end\\|include\\)[ \t\n]" nil include)
1220 ("\\(^[ \t]*[0-9]+\\|[ \t]continue[ \t\n]\\|format\\)" nil define)
1221 ("[ \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)
1222 ("[ \t]\\(parameter[\t\n ]*([^)]*)\\|data\\|save\\|common[ \t\n]*/[^/]*/\\)"
1223 nil decl)
1224 ("^ ." nil type)
1225 ("implicit[ \t]*none" nil decl)
1226 ("\\([ \t]\\|implicit[ \t]*\\)\\(dimension\\|integer\\|real\\|double[ \t]*precision\\|character\\|logical\\|complex\\|double[ \t]*complex\\)\\([*][0-9]*\\|[ \t\n]\\)" nil keyword)
1227 ("'[^'\n]*'" nil string)
1228 ))
1229
1230(hilit-set-mode-patterns
1231 '(m2-mode modula-2-mode)
1232 '(("(\\*" "\\*)" comment)
1233 (hilit-string-find ?\\ string)
1234 ("^[ \t]*PROCEDURE[ \t]+\\w+[^ \t(;]*" nil defun)
1235 ("\\<\\(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)
1236 ))
1237
1238(hilit-set-mode-patterns 'prolog-mode
1239 '(("/\\*" "\\*/" comment)
1240 ("%.*$" nil comment)
1241 (":-" nil defun)
1242 ("!" nil label)
1243 ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string)
1244 ("\\b\\(is\\|mod\\)\\b" nil keyword)
1245 ("\\(->\\|-->\\|;\\|==\\|\\\\==\\|=<\\|>=\\|<\\|>\\|=\\|\\\\=\\|=:=\\|=\\\.\\\.\\|\\\\\\\+\\)" nil decl)
1246 ("\\(\\\[\\||\\|\\\]\\)" nil include)))
1247
1248(hilit-set-mode-patterns
1249 '(
1250 LaTeX-mode japanese-LaTeX-mode SliTeX-mode
1251 japanese-SliTeX-mode FoilTeX-mode latex-mode
1252 )
1253 '(
1254 ;; comments
1255 ("[^\\]%.*$" nil comment)
1256
1257 ;; the following two match \foo[xx]{xx} or \foo*{xx} or \foo{xx}
1258 ("\\\\\\(sub\\)*\\(paragraph\\|section\\)\\(\*\\|\\[.*\\]\\)?{" "}"
1259 keyword)
1260 ("\\\\\\(chapter\\|part\\)\\(\*\\|\\[.*\\]\\)?{" "}" keyword)
1261 ("\\\\footnote\\(mark\\|text\\)?{" "}" keyword)
1262 ("\\\\[a-z]+box" nil keyword)
1263 ("\\\\\\(v\\|h\\)space\\(\*\\)?{" "}" keyword)
1264
1265 ;; (re-)define new commands/environments/counters
1266 ("\\\\\\(re\\)?new\\(environment\\|command\\){" "}" defun)
1267 ("\\\\new\\(length\\|theorem\\|counter\\){" "}" defun)
1268
1269 ;; various declarations/definitions
1270 ("\\\\\\(setlength\\|settowidth\\|addtolength\\|setcounter\\|addtocounter\\)" nil define)
1271 ("\\\\\\(\\|title\\|author\\|date\\|thanks\\){" "}" define)
1272
1273 ("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl)
1274 ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl)
1275 ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" nil
1276 decl)
1277 ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl)
1278 ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" nil decl)
1279 ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b"
1280 nil decl)
1281 ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" nil decl)
1282
1283 ;; label-like things
1284 ("\\\\item\\[" "\\]" label)
1285 ("\\\\item\\b" nil label)
1286 ("\\\\caption\\(\\[.*\\]\\)?{" "}" label)
1287
1288 ;; things that bring in external files
1289 ("\\\\\\(include\\|input\\|bibliography\\){" "}" include)
1290
1291 ;; "wysiwyg" emphasis
1292 ("{\\\\\\(em\\|it\\|sl\\)" "}" italic)
1293 ("{\\\\bf" "}" bold)
1294
1295 ("``" "''" string)
1296
1297 ;; things that do some sort of cross-reference
1298 ("\\\\\\(\\(no\\)?cite\\|\\(page\\)?ref\\|label\\|index\\|glossary\\){" "}" crossref)
1299 ))
1300
1301(hilit-set-mode-patterns
1302 'bibtex-mode
1303 '(;;(";.*$" nil comment)
1304 ("%.*$" nil comment)
1305 ("@[a-zA-Z]+" nil keyword)
1306 ("{[ \t]*[-a-z:_A-Z0-9]+," nil label) ; is wrong sometimes
1307 ("^[ \t]*[a-zA-Z]+[ \t]*=" nil define)))
1308
1309(hilit-set-mode-patterns
1310 'compilation-mode
1311 '(("^[^ \t]*:[0-9]+:.*$" nil error)
1312 ("^[^ \t]*:[0-9]+: warning:.*$" nil warning)))
1313
1314(hilit-set-mode-patterns
1315 'makefile-mode
1316 '(("^#.*$" nil comment)
1317 ("[^$]#.*$" nil comment)
1318 ;; rules
1319 ("^%.*$" nil rule)
1320 ("^[.][A-Za-z][A-Za-z]?\..*$" nil rule)
1321 ;; variable definition
1322 ("^[_A-Za-z0-9]+ *\+?=" nil define)
1323 ("\\( \\|:=\\)[_A-Za-z0-9]+ *\\+=" nil define)
1324 ;; variable references
1325 ("\$[_A-Za-z0-9]" nil type)
1326 ("\${[_A-Za-z0-9]+}" nil type)
1327 ("\$\([_A-Za-z0-9]+\)" nil type)
1328 ("^include " nil include)))
1329
1330(let* ((header-patterns '(("^Subject:.*$" nil msg-subject)
1331 ("^From:.*$" nil msg-from)
1332 ("^--text follows this line--$" nil msg-separator)
1333 ("^[A-Za-z][A-Za-z0-9-]+:" nil msg-header)))
1334 (body-patterns '(("^\\(In article\\|[ \t]*\\w*[]>}|]\\).*$"
1335 nil msg-quote)))
1336 (message-patterns (append header-patterns body-patterns)))
1337 (hilit-set-mode-patterns 'msg-header header-patterns)
1338 (hilit-set-mode-patterns 'msg-body body-patterns)
1339 (hilit-set-mode-patterns
1340 '(vm-mode text-mode mail-mode rmail-mode gnus-article-mode news-reply-mode)
1341 message-patterns
1342 'hilit-rehighlight-message))
1343
1344(hilit-set-mode-patterns
1345 'gnus-group-mode
1346 '(("^U.*$" nil gnus-group-unsubscribed)
1347 ("^ +[01]?[0-9]:.*$" nil gnus-group-empty)
1348 ("^ +[2-9][0-9]:.*$" nil gnus-group-full)
1349 ("^ +[0-9][0-9][0-9]+:.*$" nil gnus-group-overflowing)))
1350
1351(hilit-set-mode-patterns
1352 'gnus-summary-mode
1353 '(("^D +[0-9]+: \\[.*$" nil summary-seen)
1354 ("^K +[0-9]+: \\[.*$" nil summary-killed)
1355 ("^X +[0-9]+: \\[.*$" nil summary-Xed)
1356 ("^- +[0-9]+: \\[.*$" nil summary-unread)
1357 ("^. +[0-9]+:\\+\\[.*$" nil summary-current)
1358 ("^ +[0-9]+: \\[.*$" nil summary-new)
1359 ))
1360
1361(hilit-set-mode-patterns
1362 'vm-summary-mode
1363 '(("^ .*$" nil summary-seen)
1364 ("^->.*$" nil summary-current)
1365 ("^ D.*$" nil summary-deleted)
1366 ("^ U.*$" nil summary-unread)
1367 ("^ N.*$" nil summary-new)))
1368
1369
1370(hilit-set-mode-patterns
1371 '(emacs-lisp-mode lisp-mode)
1372 '(
1373 (";.*" nil comment)
1374;;; ("^;.*$" nil comment)
1375;;; ("\\s ;+[ ;].*$" nil comment)
1376 (hilit-string-find ?\\ string)
1377 ("^\\s *(def\\(un\\|macro\\|advice\\|subst\\)\\s " "\\()\\|nil\\)" defun)
1378 ("^\\s *(defvar\\s +\\S +" nil decl)
1379 ("^\\s *(defconst\\s +\\S +" nil define)
1380 ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include)
1381 ))
1382
1383
1384(hilit-set-mode-patterns
1385 'plain-tex-mode
1386 '(("^%%.*$" nil comment)
1387 ("{\\\\em\\([^}]+\\)}" nil comment)
1388 ("\\(\\\\\\w+\\)" nil keyword)
1389 ("{\\\\bf\\([^}]+\\)}" nil keyword)
1390 ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun)
1391 ("\\\\\\(begin\\|end\\){\\([A-Za-z0-9\\*]+\\)}" nil defun)
1392; ("[^\\\\]\\$\\([^$]*\\)\\$" nil string)
1393 ("\\$\\([^$]*\\)\\$" nil string)
1394 ))
1395
1396;; Reasonable extensions would include smarter parameter handling for such
1397;; things as the .IX and .I macros, which alternate the handling of following
1398;; arguments.
1399
1400(hilit-set-mode-patterns
1401 'nroff-mode
1402 '(("^\\.[\\\][\\\"].*$" nil comment)
1403 ("^\\.so .*$" nil include)
1404 ("^\\.[ST]H.*$" nil defun)
1405;; ("^[^\\.].*\"[^\\\"]*\\(\\\\\\(.\\)[^\\\"]*\\)*\"" nil string)
1406 ("\"" "[^\\]\"" string)
1407 ("^\\.[A-Za-z12\\\\].*$" nil define)
1408 ("\\([\\\][^ ]*\\)" nil keyword)
1409 ("^\\.[a-zA-Z].*$" nil keyword)))
1410
1411(hilit-set-mode-patterns
1412 'texinfo-mode
1413 '(("^\\(@c\\|@comment\\)\\>.*$" nil comment)
1414 ("@\\(emph\\|strong\\|b\\|i\\){[^}]+}" nil comment)
1415; seems broken
1416; ("\\$[^$]*\\$" nil string)
1417 ("@\\(file\\|kbd\\|key\\){[^}]+}" nil string)
1418 ("^\\*.*$" nil defun)
1419 ("@\\(if\\w+\\|format\\|item\\)\\b.*$" nil defun)
1420 ("@end +[A-Za-z0-9]+[ \t]*$" nil defun)
1421 ("@\\(samp\\|code\\|var\\){[^}]+}" nil defun)
1422 ("@\\w+\\({[^}]+}\\)?" nil keyword)
1423 ))
1424
1425(hilit-set-mode-patterns
1426 'dired-mode
1427 (append
1428 '(("^D.*$" nil dired-deleted)
1429 ("^\\*.*$" nil dired-marked)
1430 ("^ d.*$" nil dired-directory)
1431 ("^ l.*$" nil dired-link)
1432 ("^ -.*#.*#$" nil dired-ignored))
1433 (list (cons
1434 (concat "^ .*\\("
1435 (mapconcat 'regexp-quote completion-ignored-extensions "\\|")
1436 "\\)$")
1437 '(nil dired-ignored)))))
1438
1439(hilit-set-mode-patterns
1440 'jargon-mode
1441 '(("^:[^:]*:" nil jargon-entry)
1442 ("{[^}]*}+" nil jargon-xref)))
1443
1444(hilit-set-mode-patterns
1445 'Info-mode
1446 '(("^\\* [^:]+:+" nil jargon-entry)
1447 ("\\*[Nn]ote\\b[^:]+:+" nil jargon-xref)
1448 (" \\(Next\\|Prev\\|Up\\):" nil jargon-xref)
1449 ("- \\(Variable\\|Function\\|Macro\\|Command\\|Special Form\\|User Option\\):.*$"
1450 nil jargon-keyword))) ; lisp manual
1451
1452(provide 'hilit19)
1453
1454;;; hilit19 ends here.