Mercurial > hg > xemacs-beta

comparison lisp/utils/highlight-headers.el @ 173:8eaf7971accc r20-3b13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 43dd3413c7c7
children 850242ba4a81
comparison
equal deleted inserted replaced
172:a38aed19690b 173:8eaf7971accc
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Synched up with: Not in FSF. 25 ;;; Synched up with: Not in FSF.
26 26
27 ;; This code is shared by RMAIL, VM, and GNUS. 27 ;; This code is shared by RMAIL and VM.
28 ;; 28 ;;
29 ;; Faces: 29 ;; Faces:
30 ;; 30 ;;
31 ;; message-headers the part before the colon 31 ;; message-headers the part before the colon
32 ;; message-header-contents the part after the colon 32 ;; message-header-contents the part after the colon
39 ;; highlight-headers-citation-regexp matches lines of quoted text 39 ;; highlight-headers-citation-regexp matches lines of quoted text
40 ;; highlight-headers-citation-header-regexp matches headers for quoted text 40 ;; highlight-headers-citation-header-regexp matches headers for quoted text
41 41
42 (defgroup highlight-headers nil 42 (defgroup highlight-headers nil
43 "Fancify rfc822 documents." 43 "Fancify rfc822 documents."
44 :group 'faces
45 :group 'mail 44 :group 'mail
46 :group 'news) 45 :group 'news)
47 46
47 (defgroup highlight-headers-faces nil
48 "Faces of highlighted headers."
49 :group 'highlight-headers
50 :group 'faces)
51
48 (defface message-headers '((t (:bold t))) 52 (defface message-headers '((t (:bold t)))
49 "Face used for header part before colon." 53 "Face used for header part before colon."
50 :group 'highlight-headers) 54 :group 'highlight-headers-faces)
51 55
52 (defface message-header-contents '((t (:italic t))) 56 (defface message-header-contents '((t (:italic t)))
53 "Face used for header part after colon." 57 "Face used for header part after colon."
54 :group 'highlight-headers) 58 :group 'highlight-headers-faces)
55 59
56 (defface message-highlighted-header-contents '((t (:italic t :bold t))) 60 (defface message-highlighted-header-contents '((t (:italic t :bold t)))
57 "Face used for contents of \"special\" headers." 61 "Face used for contents of \"special\" headers."
58 :group 'highlight-headers) 62 :group 'highlight-headers-faces)
59 63
60 (defface message-cited-text '((t (:italic t))) 64 (defface message-cited-text '((t (:italic t)))
61 "Face used for cited text." 65 "Face used for cited text."
62 :group 'highlight-headers) 66 :group 'highlight-headers-faces)
63 67
64 (defface x-face '((t (:background "white" :foreground "black"))) 68 (defface x-face '((t (:background "white" :foreground "black")))
65 "Face used for X-Face icon." 69 "Face used for X-Face icon."
66 :group 'highlight-headers) 70 :group 'highlight-headers-faces)
67 71
68 ;;(condition-case nil 72 ;;(condition-case nil
69 ;; (face-name 'message-addresses) 73 ;; (face-name 'message-addresses)
70 ;; (wrong-type-argument 74 ;; (wrong-type-argument
71 ;; (make-face 'message-addresses) 75 ;; (make-face 'message-addresses)
74 ;; (copy-face 'bold-italic 'message-addresses) 78 ;; (copy-face 'bold-italic 'message-addresses)
75 ;; (set-face-underline-p 'message-addresses 79 ;; (set-face-underline-p 'message-addresses
76 ;; (face-underline-p 80 ;; (face-underline-p
77 ;; 'message-highlighted-header-contents)))))) 81 ;; 'message-highlighted-header-contents))))))
78 82
79 (defvar highlight-headers-regexp "Subject[ \t]*:" 83 (defcustom highlight-headers-regexp "Subject[ \t]*:"
80 "*The headers whose contents should be emphasized more. 84 "*The headers whose contents should be emphasized more.
81 The contents of these headers will be displayed in the face 85 The contents of these headers will be displayed in the face
82 `message-highlighted-header-contents' instead of `message-header-contents'.") 86 `message-highlighted-header-contents' instead of `message-header-contents'."
83 87 :type 'regexp
84 (defvar highlight-headers-citation-regexp 88 :group 'highlight-headers)
89
90 (defcustom highlight-headers-citation-regexp
85 (concat "^\\(" 91 (concat "^\\("
86 (mapconcat 'identity 92 (mapconcat 'identity
87 '("[ \t]*[a-zA-Z0-9_]+>+" ; supercite 93 '("[ \t]*[a-zA-Z0-9_]+>+" ; supercite
88 "[ \t]*[>]+" ; ">" with leading spaces 94 "[ \t]*[>]+" ; ">" with leading spaces
89 "[]}<>|:]+[ \t]*" ; other chars, no leading space 95 "[]}<>|:]+[ \t]*" ; other chars, no leading space
90 ) 96 )
91 "\\|") 97 "\\|")
92 "\\)[ \t]*") 98 "\\)[ \t]*")
93 "*The pattern to match cited text. 99 "*The pattern to match cited text.
94 Text in the body of a message which matches this will be displayed in 100 Text in the body of a message which matches this will be displayed in
95 the face `message-cited-text'.") 101 the face `message-cited-text'."
96 102 :type 'regexp
97 (defvar highlight-headers-citation-header-regexp 103 :group 'highlight-headers)
104
105 (defcustom highlight-headers-citation-header-regexp
98 (concat "^In article\\|^In message\\|" 106 (concat "^In article\\|^In message\\|"
99 "^[^ \t].*\\(writes\\|wrote\\|said\\):\n" 107 "^[^ \t].*\\(writes\\|wrote\\|said\\):\n"
100 (substring highlight-headers-citation-regexp 1)) 108 (substring highlight-headers-citation-regexp 1))
101 "*The pattern to match the prolog of a cited block. 109 "*The pattern to match the prolog of a cited block.
102 Text in the body of a message which matches this will be displayed in 110 Text in the body of a message which matches this will be displayed in
103 the `message-headers' face.") 111 the `message-headers' face."
104 112 :type 'regexp
105 (defvar highlight-headers-highlight-citation-too nil 113 :group 'highlight-headers)
114
115 (defcustom highlight-headers-highlight-citation-too nil
106 "*Whether the whole citation line should go in the `mesage-cited-text' face. 116 "*Whether the whole citation line should go in the `mesage-cited-text' face.
107 If nil, the text matched by `highlight-headers-citation-regexp' is in the 117 If nil, the text matched by `highlight-headers-citation-regexp' is in the
108 default face, and the remainder of the line is in the message-cited-text face.") 118 default face, and the remainder of the line is in the message-cited-text face."
109 119 :type 'boolean
110 (defvar highlight-headers-max-message-size 10000 120 :group 'highlight-headers)
121
122 (defcustom highlight-headers-max-message-size 10000
111 "*If the message body is larger than this many chars, don't highlight it. 123 "*If the message body is larger than this many chars, don't highlight it.
112 This is to prevent us from wasting time trying to fontify things like 124 This is to prevent us from wasting time trying to fontify things like
113 uuencoded files and large digests. If this is nil, all messages will 125 uuencoded files and large digests. If this is nil, all messages will
114 be highlighted.") 126 be highlighted."
115 127 :type '(choice integer
116 (defvar highlight-headers-hack-x-face-p (featurep 'xface) 128 (const :tag "Highlight All" nil))
129 :group 'highlight-headers)
130
131 (defcustom highlight-headers-hack-x-face-p (featurep 'xface)
117 "*If true, then the bitmap in an X-Face header will be displayed 132 "*If true, then the bitmap in an X-Face header will be displayed
118 in the buffer. This assumes you have the `uncompface' and `icontopbm' 133 in the buffer. This assumes you have the `uncompface' and `icontopbm'
119 programs on your path.") 134 programs on your path."
120 135 :type 'boolean
121 (defvar highlight-headers-convert-quietly nil 136 :group 'highlight-headers)
137
138 (defcustom highlight-headers-convert-quietly nil
122 "*Non-nil inhibits the message that is normally displayed when external 139 "*Non-nil inhibits the message that is normally displayed when external
123 filters are used to convert an X-Face header. This has no effect if 140 filters are used to convert an X-Face header. This has no effect if
124 XEmacs is compiled with internal support for x-faces.") 141 XEmacs is compiled with internal support for x-faces."
125 142 :type 'boolean
126 (defvar highlight-headers-invert-x-face-data nil 143 :group 'highlight-headers)
144
145 (defcustom highlight-headers-invert-x-face-data nil
127 "*If true, causes the foreground and background bits in an X-Face 146 "*If true, causes the foreground and background bits in an X-Face
128 header to be flipped before the image is displayed. If you use a 147 header to be flipped before the image is displayed. If you use a
129 light foreground color on a dark background color, you probably want 148 light foreground color on a dark background color, you probably want
130 to set this to t. This assumes that you have the `pnminvert' program 149 to set this to t. This assumes that you have the `pnminvert' program
131 on your path. This doesn't presently work with internal xface support.") 150 on your path. This doesn't presently work with internal xface support."
151 :type 'boolean
152 :group 'highlight-headers)
132 153
133 154
134 ;;;###autoload 155 ;;;###autoload
135 (defun highlight-headers (start end hack-sig) 156 (defun highlight-headers (start end hack-sig)
136 "Highlight message headers between start and end. 157 "Highlight message headers between start and end.
426 447
427 448
428 ;;; "The Internet's new BBS!" -Boardwatch Magazine 449 ;;; "The Internet's new BBS!" -Boardwatch Magazine
429 ;;; URL support by jwz@netscape.com 450 ;;; URL support by jwz@netscape.com
430 451
431 (defvar highlight-headers-mark-urls (string-match "XEmacs" emacs-version) 452 (defcustom highlight-headers-mark-urls (string-match "XEmacs" emacs-version)
432 "*Whether to make URLs clickable in message bodies.") 453 "*Whether to make URLs clickable in message bodies."
454 :type 'boolean
455 :group 'highlight-headers)
456
457 ;; Uh, these should really use browse-url. They are too lame to be
458 ;; customized.
433 459
434 (defvar highlight-headers-follow-url-function 'w3-fetch 460 (defvar highlight-headers-follow-url-function 'w3-fetch
435 "The function to invoke to follow a URL. 461 "The function to invoke to follow a URL.
436 Possible values that work out of the box are: 462 Possible values that work out of the box are:
437 463