Commit | Line | Data |
---|---|---|
41487370 | 1 | ;;; gnus-vis.el --- display-oriented parts of Gnus |
231f989b | 2 | ;; Copyright (C) 1995,96 Free Software Foundation, Inc. |
41487370 LMI |
3 | |
4 | ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
5 | ;; Per Abrahamsen <abraham@iesd.auc.dk> | |
6 | ;; Keywords: news | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
41487370 LMI |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;;; Code: | |
28 | ||
29 | (require 'gnus) | |
30 | (require 'gnus-ems) | |
31 | (require 'easymenu) | |
32 | (require 'custom) | |
231f989b LMI |
33 | (require 'browse-url) |
34 | (require 'gnus-score) | |
35 | (eval-when-compile (require 'cl)) | |
41487370 LMI |
36 | |
37 | (defvar gnus-group-menu-hook nil | |
38 | "*Hook run after the creation of the group mode menu.") | |
39 | ||
40 | (defvar gnus-summary-menu-hook nil | |
41 | "*Hook run after the creation of the summary mode menu.") | |
42 | ||
43 | (defvar gnus-article-menu-hook nil | |
44 | "*Hook run after the creation of the article mode menu.") | |
45 | ||
41487370 LMI |
46 | ;;; Summary highlights. |
47 | ||
48 | ;(defvar gnus-summary-highlight-properties | |
49 | ; '((unread "ForestGreen" "green") | |
50 | ; (ticked "Firebrick" "pink") | |
51 | ; (read "black" "white") | |
52 | ; (low italic italic) | |
53 | ; (high bold bold) | |
54 | ; (canceled "yellow/black" "black/yellow"))) | |
55 | ||
56 | ;(defvar gnus-summary-highlight-translation | |
57 | ; '(((unread (= mark gnus-unread-mark)) | |
58 | ; (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark))) | |
59 | ; (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark) | |
60 | ; (= mark gnus-ticked-mark) (= mark gnus-canceled-mark)))) | |
61 | ; (canceled (= mark gnus-canceled-mark))) | |
62 | ; ((low (< score gnus-summary-default-score)) | |
63 | ; (high (> score gnus-summary-default-score))))) | |
64 | ||
65 | ;(defun gnus-visual-map-face-translation () | |
66 | ; (let ((props gnus-summary-highlight-properties) | |
67 | ; (trans gnus-summary-highlight-translation) | |
68 | ; map) | |
69 | ; (while props))) | |
70 | ||
71 | ;see gnus-cus.el | |
72 | ;(defvar gnus-summary-selected-face 'underline | |
73 | ; "*Face used for highlighting the current article in the summary buffer.") | |
74 | ||
75 | ;see gnus-cus.el | |
76 | ;(defvar gnus-summary-highlight | |
77 | ; (cond ((not (eq gnus-display-type 'color)) | |
78 | ; '(((> score default) . bold) | |
79 | ; ((< score default) . italic))) | |
80 | ; ((eq gnus-background-mode 'dark) | |
81 | ; (list (cons '(= mark gnus-canceled-mark) | |
82 | ; (custom-face-lookup "yellow" "black" nil nil nil nil)) | |
83 | ; (cons '(and (> score default) | |
84 | ; (or (= mark gnus-dormant-mark) | |
85 | ; (= mark gnus-ticked-mark))) | |
86 | ; (custom-face-lookup "pink" nil nil t nil nil)) | |
87 | ; (cons '(and (< score default) | |
88 | ; (or (= mark gnus-dormant-mark) | |
89 | ; (= mark gnus-ticked-mark))) | |
90 | ; (custom-face-lookup "pink" nil nil nil t nil)) | |
91 | ; (cons '(or (= mark gnus-dormant-mark) | |
92 | ; (= mark gnus-ticked-mark)) | |
93 | ; (custom-face-lookup "pink" nil nil nil nil nil)) | |
94 | ||
95 | ; (cons '(and (> score default) (= mark gnus-ancient-mark)) | |
96 | ; (custom-face-lookup "SkyBlue" nil nil t nil nil)) | |
97 | ; (cons '(and (< score default) (= mark gnus-ancient-mark)) | |
98 | ; (custom-face-lookup "SkyBlue" nil nil nil t nil)) | |
99 | ; (cons '(= mark gnus-ancient-mark) | |
100 | ; (custom-face-lookup "SkyBlue" nil nil nil nil nil)) | |
101 | ||
102 | ; (cons '(and (> score default) (= mark gnus-unread-mark)) | |
103 | ; (custom-face-lookup "white" nil nil t nil nil)) | |
104 | ; (cons '(and (< score default) (= mark gnus-unread-mark)) | |
105 | ; (custom-face-lookup "white" nil nil nil t nil)) | |
106 | ; (cons '(= mark gnus-unread-mark) | |
107 | ; (custom-face-lookup "white" nil nil nil nil nil)) | |
108 | ||
109 | ; (cons '(> score default) 'bold) | |
110 | ; (cons '(< score default) 'italic))) | |
111 | ; (t | |
112 | ; (list (cons '(= mark gnus-canceled-mark) | |
113 | ; (custom-face-lookup "yellow" "black" nil nil nil nil)) | |
114 | ; (cons '(and (> score default) | |
115 | ; (or (= mark gnus-dormant-mark) | |
116 | ; (= mark gnus-ticked-mark))) | |
117 | ; (custom-face-lookup "firebrick" nil nil t nil nil)) | |
118 | ; (cons '(and (< score default) | |
119 | ; (or (= mark gnus-dormant-mark) | |
120 | ; (= mark gnus-ticked-mark))) | |
121 | ; (custom-face-lookup "firebrick" nil nil nil t nil)) | |
122 | ; (cons '(or (= mark gnus-dormant-mark) | |
123 | ; (= mark gnus-ticked-mark)) | |
124 | ; (custom-face-lookup "firebrick" nil nil nil nil nil)) | |
125 | ||
126 | ; (cons '(and (> score default) (= mark gnus-ancient-mark)) | |
127 | ; (custom-face-lookup "RoyalBlue" nil nil t nil nil)) | |
128 | ; (cons '(and (< score default) (= mark gnus-ancient-mark)) | |
129 | ; (custom-face-lookup "RoyalBlue" nil nil nil t nil)) | |
130 | ; (cons '(= mark gnus-ancient-mark) | |
131 | ; (custom-face-lookup "RoyalBlue" nil nil nil nil nil)) | |
132 | ||
133 | ; (cons '(and (> score default) (/= mark gnus-unread-mark)) | |
134 | ; (custom-face-lookup "DarkGreen" nil nil t nil nil)) | |
135 | ; (cons '(and (< score default) (/= mark gnus-unread-mark)) | |
136 | ; (custom-face-lookup "DarkGreen" nil nil nil t nil)) | |
137 | ; (cons '(/= mark gnus-unread-mark) | |
138 | ; (custom-face-lookup "DarkGreen" nil nil nil nil nil)) | |
139 | ||
140 | ; (cons '(> score default) 'bold) | |
141 | ; (cons '(< score default) 'italic)))) | |
142 | ; "*Alist of `(FORM . FACE)'. | |
143 | ;Summary lines are highlighted with the FACE for the first FORM which | |
144 | ;evaluate to a non-nil value. | |
145 | ||
146 | ;Point will be at the beginning of the line when FORM is evaluated. | |
147 | ;The following can be used for convenience: | |
148 | ||
149 | ;score: (gnus-summary-article-score) | |
150 | ;default: gnus-summary-default-score | |
151 | ;below: gnus-summary-mark-below | |
152 | ;mark: (gnus-summary-article-mark) | |
153 | ||
154 | ;The latter can be used like this: | |
155 | ; ((= mark gnus-replied-mark) . underline)") | |
156 | ||
157 | ;;; article highlights | |
158 | ||
159 | ;see gnus-cus.el | |
160 | ;(defvar gnus-header-face-alist | |
161 | ; (cond ((not (eq gnus-display-type 'color)) | |
162 | ; '(("" bold italic))) | |
163 | ; ((eq gnus-background-mode 'dark) | |
164 | ; (list (list "From" nil | |
165 | ; (custom-face-lookup "SkyBlue" nil nil t t nil)) | |
166 | ; (list "Subject" nil | |
167 | ; (custom-face-lookup "pink" nil nil t t nil)) | |
168 | ; (list "Newsgroups:.*," nil | |
169 | ; (custom-face-lookup "yellow" nil nil t t nil)) | |
170 | ; (list "" | |
171 | ; (custom-face-lookup "cyan" nil nil t nil nil) | |
172 | ; (custom-face-lookup "green" nil nil nil t nil)))) | |
173 | ; (t | |
174 | ; (list (list "From" nil | |
175 | ; (custom-face-lookup "RoyalBlue" nil nil t t nil)) | |
176 | ; (list "Subject" nil | |
177 | ; (custom-face-lookup "firebrick" nil nil t t nil)) | |
178 | ; (list "Newsgroups:.*," nil | |
179 | ; (custom-face-lookup "red" nil nil t t nil)) | |
180 | ; (list "" | |
181 | ; (custom-face-lookup "DarkGreen" nil nil t nil nil) | |
182 | ; (custom-face-lookup "DarkGreen" nil nil nil t nil))))) | |
183 | ; "Alist of headers and faces used for highlighting them. | |
184 | ;The entries in the list has the form `(REGEXP NAME CONTENT)', where | |
185 | ;REGEXP is a regular expression matching the beginning of the header, | |
186 | ;NAME is the face used for highlighting the header name and CONTENT is | |
187 | ;the face used for highlighting the header content. | |
188 | ||
189 | ;The first non-nil NAME or CONTENT with a matching REGEXP in the list | |
190 | ;will be used.") | |
191 | ||
192 | ||
193 | ;see gnus-cus.el | |
194 | ;(defvar gnus-make-foreground t | |
195 | ; "Non nil means foreground color to highlight citations.") | |
196 | ||
197 | ;see gnus-cus.el | |
198 | ;(defvar gnus-article-button-face 'bold | |
199 | ; "Face used for text buttons.") | |
200 | ||
201 | ;see gnus-cus.el | |
202 | ;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face) | |
203 | ; gnus-mouse-face | |
204 | ; 'highlight) | |
205 | ; "Face used when the mouse is over the button.") | |
206 | ||
207 | ;see gnus-cus.el | |
208 | ;(defvar gnus-signature-face 'italic | |
209 | ; "Face used for signature.") | |
210 | ||
231f989b LMI |
211 | (defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]" |
212 | "*Regular expression that matches URLs.") | |
213 | ||
41487370 | 214 | (defvar gnus-button-alist |
231f989b LMI |
215 | `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 |
216 | t gnus-button-message-id 3) | |
217 | ("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t | |
41487370 | 218 | gnus-button-message-id 3) |
231f989b | 219 | ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-button-reply 2) |
41487370 LMI |
220 | ;; Next regexp stolen from highlight-headers.el. |
221 | ;; Modified by Vladimir Alexiev. | |
ea7cceff RS |
222 | (,gnus-button-url-regexp 0 t gnus-button-url 0) |
223 | ;; This is how URLs _should_ be embedded in text... It should go | |
224 | ;; last to avoid matching only a subset of the URL, depending on | |
225 | ;; how it was broken across lines. | |
226 | ("<URL:\\([^>]+\\)>" 0 t gnus-button-url 1)) | |
231f989b | 227 | "Alist of regexps matching buttons in article bodies. |
41487370 LMI |
228 | |
229 | Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where | |
230 | REGEXP: is the string matching text around the button, | |
231 | BUTTON: is the number of the regexp grouping actually matching the button, | |
232 | FORM: is a lisp expression which must eval to true for the button to | |
233 | be added, | |
234 | CALLBACK: is the function to call when the user push this button, and each | |
235 | PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. | |
236 | ||
237 | CALLBACK can also be a variable, in that case the value of that | |
238 | variable it the real callback function.") | |
239 | ||
231f989b LMI |
240 | (defvar gnus-header-button-alist |
241 | `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" | |
242 | 0 t gnus-button-message-id 0) | |
243 | ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0) | |
244 | ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" | |
245 | 0 t gnus-button-mailto 0) | |
246 | ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) | |
247 | ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) | |
248 | ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t | |
249 | gnus-button-message-id 3)) | |
250 | "Alist of headers and regexps to match buttons in article heads. | |
251 | ||
252 | This alist is very similar to `gnus-button-alist', except that each | |
253 | alist has an additional HEADER element first in each entry: | |
254 | ||
255 | \(HEADER REGEXP BUTTON FORM CALLBACK PAR) | |
256 | ||
257 | HEADER is a regexp to match a header. For a fuller explanation, see | |
258 | `gnus-button-alist'.") | |
259 | ||
41487370 LMI |
260 | ;see gnus-cus.el |
261 | ;(eval-when-compile | |
262 | ; (defvar browse-url-browser-function)) | |
263 | ||
231f989b LMI |
264 | ;;; Group mode highlighting. |
265 | ||
41487370 | 266 | ;see gnus-cus.el |
231f989b LMI |
267 | ;(defvar gnus-group-highlight nil |
268 | ; "Group lines are highlighted with the FACE for the first FORM which | |
269 | ;evaluate to a non-nil value. | |
270 | ; | |
271 | ;Point will be at the beginning of the line when FORM is evaluated. | |
272 | ;Variables bound when these forms are evaluated include: | |
273 | ; | |
274 | ;group: The group name. | |
275 | ;unread: The number of unread articles. | |
276 | ;method: The select method. | |
277 | ;mailp: Whether the select method is a mail method. | |
278 | ;level: The level of the group. | |
279 | ;score: The score of the group. | |
280 | ;ticked: The number of ticked articles in the group. | |
281 | ;") | |
282 | ||
283 | ||
284 | ;;; Internal variables. | |
285 | ||
286 | (defvar gnus-button-marker-list nil) | |
41487370 LMI |
287 | |
288 | \f | |
289 | ||
290 | (eval-and-compile | |
291 | (autoload 'nnkiboze-generate-groups "nnkiboze") | |
292 | (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t)) | |
293 | ||
294 | ;;; | |
295 | ;;; gnus-menu | |
296 | ;;; | |
297 | ||
298 | (defun gnus-visual-turn-off-edit-menu (type) | |
299 | (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) | |
300 | [menu-bar edit] 'undefined)) | |
301 | ||
302 | ;; Newsgroup buffer | |
303 | ||
304 | (defun gnus-group-make-menu-bar () | |
305 | (gnus-visual-turn-off-edit-menu 'group) | |
306 | (or | |
307 | (boundp 'gnus-group-reading-menu) | |
308 | (progn | |
309 | (easy-menu-define | |
231f989b | 310 | gnus-group-reading-menu gnus-group-mode-map "" |
41487370 | 311 | '("Group" |
231f989b LMI |
312 | ["Read" gnus-group-read-group (gnus-group-group-name)] |
313 | ["Select" gnus-group-select-group (gnus-group-group-name)] | |
314 | ["See old articles" (gnus-group-select-group 'all) | |
315 | :keys "C-u SPC" :active (gnus-group-group-name)] | |
316 | ["Catch up" gnus-group-catchup-current (gnus-group-group-name)] | |
317 | ["Catch up all articles" gnus-group-catchup-current-all | |
318 | (gnus-group-group-name)] | |
319 | ["Check for new articles" gnus-group-get-new-news-this-group | |
320 | (gnus-group-group-name)] | |
321 | ["Toggle subscription" gnus-group-unsubscribe-current-group | |
322 | (gnus-group-group-name)] | |
323 | ["Kill" gnus-group-kill-group (gnus-group-group-name)] | |
324 | ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] | |
325 | ["Describe" gnus-group-describe-group (gnus-group-group-name)] | |
326 | ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] | |
327 | ["Edit kill file" gnus-group-edit-local-kill | |
328 | (gnus-group-group-name)] | |
329 | ;; Actually one should check, if any of the marked groups gives t for | |
330 | ;; (gnus-check-backend-function 'request-expire-articles ...) | |
331 | ["Expire articles" gnus-group-expire-articles | |
332 | (or (and (gnus-group-group-name) | |
333 | (gnus-check-backend-function | |
334 | 'request-expire-articles | |
335 | (gnus-group-group-name))) gnus-group-marked)] | |
336 | ["Set group level" gnus-group-set-current-level | |
337 | (gnus-group-group-name)] | |
338 | ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] | |
41487370 LMI |
339 | )) |
340 | ||
341 | (easy-menu-define | |
231f989b | 342 | gnus-group-group-menu gnus-group-mode-map "" |
41487370 LMI |
343 | '("Groups" |
344 | ("Listing" | |
231f989b LMI |
345 | ["List unread subscribed groups" gnus-group-list-groups t] |
346 | ["List (un)subscribed groups" gnus-group-list-all-groups t] | |
347 | ["List killed groups" gnus-group-list-killed gnus-killed-list] | |
348 | ["List zombie groups" gnus-group-list-zombies gnus-zombie-list] | |
349 | ["List level..." gnus-group-list-level t] | |
41487370 | 350 | ["Describe all groups" gnus-group-describe-all-groups t] |
231f989b LMI |
351 | ["Group apropos..." gnus-group-apropos t] |
352 | ["Group and description apropos..." gnus-group-description-apropos t] | |
353 | ["List groups matching..." gnus-group-list-matching t] | |
354 | ["List all groups matching..." gnus-group-list-all-matching t] | |
355 | ["List active file" gnus-group-list-active t]) | |
356 | ("Sort" | |
357 | ["Default sort" gnus-group-sort-groups | |
358 | (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | |
359 | ["Sort by method" gnus-group-sort-groups-by-method | |
360 | (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | |
361 | ["Sort by rank" gnus-group-sort-groups-by-rank | |
362 | (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | |
363 | ["Sort by score" gnus-group-sort-groups-by-score | |
364 | (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | |
365 | ["Sort by level" gnus-group-sort-groups-by-level | |
366 | (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | |
367 | ["Sort by unread" gnus-group-sort-groups-by-unread | |
368 | (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | |
369 | ["Sort by name" gnus-group-sort-groups-by-alphabet | |
370 | (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) | |
41487370 | 371 | ("Mark" |
231f989b LMI |
372 | ["Mark group" gnus-group-mark-group |
373 | (and (gnus-group-group-name) | |
374 | (not (memq (gnus-group-group-name) gnus-group-marked)))] | |
375 | ["Unmark group" gnus-group-unmark-group | |
376 | (and (gnus-group-group-name) | |
377 | (memq (gnus-group-group-name) gnus-group-marked))] | |
378 | ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] | |
379 | ["Mark regexp..." gnus-group-mark-regexp t] | |
380 | ["Mark region" gnus-group-mark-region t] | |
381 | ["Mark buffer" gnus-group-mark-buffer t] | |
382 | ["Execute command" gnus-group-universal-argument | |
383 | (or gnus-group-marked (gnus-group-group-name))]) | |
41487370 LMI |
384 | ("Subscribe" |
385 | ["Subscribe to random group" gnus-group-unsubscribe-group t] | |
386 | ["Kill all newsgroups in region" gnus-group-kill-region t] | |
231f989b LMI |
387 | ["Kill all zombie groups" gnus-group-kill-all-zombies |
388 | gnus-zombie-list] | |
389 | ["Kill all groups on level..." gnus-group-kill-level t]) | |
41487370 LMI |
390 | ("Foreign groups" |
391 | ["Make a foreign group" gnus-group-make-group t] | |
392 | ["Add a directory group" gnus-group-make-directory-group t] | |
393 | ["Add the help group" gnus-group-make-help-group t] | |
394 | ["Add the archive group" gnus-group-make-archive-group t] | |
395 | ["Make a doc group" gnus-group-make-doc-group t] | |
396 | ["Make a kiboze group" gnus-group-make-kiboze-group t] | |
397 | ["Make a virtual group" gnus-group-make-empty-virtual t] | |
231f989b LMI |
398 | ["Add a group to a virtual" gnus-group-add-to-virtual t] |
399 | ["Rename group" gnus-group-rename-group | |
400 | (gnus-check-backend-function | |
401 | 'request-rename-group (gnus-group-group-name))] | |
402 | ["Delete group" gnus-group-delete-group | |
403 | (gnus-check-backend-function | |
404 | 'request-delete-group (gnus-group-group-name))]) | |
41487370 | 405 | ("Editing groups" |
231f989b LMI |
406 | ["Parameters" gnus-group-edit-group-parameters |
407 | (gnus-group-group-name)] | |
408 | ["Select method" gnus-group-edit-group-method | |
409 | (gnus-group-group-name)] | |
410 | ["Info" gnus-group-edit-group (gnus-group-group-name)]) | |
411 | ("Score file" | |
412 | ["Flush cache" gnus-score-flush-cache | |
413 | (or gnus-score-cache gnus-short-name-score-file-cache)]) | |
414 | ("Move" | |
415 | ["Next" gnus-group-next-group t] | |
416 | ["Previous" gnus-group-prev-group t] | |
417 | ["Next unread" gnus-group-next-unread-group t] | |
418 | ["Previous unread" gnus-group-prev-unread-group t] | |
419 | ["Next unread same level" gnus-group-next-unread-group-same-level t] | |
420 | ["Previous unread same level" | |
421 | gnus-group-previous-unread-group-same-level t] | |
422 | ["Jump to group" gnus-group-jump-to-group t] | |
423 | ["First unread group" gnus-group-first-unread-group t] | |
424 | ["Best unread group" gnus-group-best-unread-group t]) | |
425 | ["Transpose" gnus-group-transpose-groups | |
426 | (gnus-group-group-name)] | |
427 | ["Read a directory as a group..." gnus-group-enter-directory t] | |
41487370 LMI |
428 | )) |
429 | ||
430 | (easy-menu-define | |
231f989b | 431 | gnus-group-misc-menu gnus-group-mode-map "" |
41487370 LMI |
432 | '("Misc" |
433 | ["Send a bug report" gnus-bug t] | |
434 | ["Send a mail" gnus-group-mail t] | |
231f989b LMI |
435 | ["Post an article..." gnus-group-post-news t] |
436 | ["Customize score file" gnus-score-customize t] | |
41487370 | 437 | ["Check for new news" gnus-group-get-new-news t] |
231f989b | 438 | ["Activate all groups" gnus-activate-all-groups t] |
41487370 LMI |
439 | ["Delete bogus groups" gnus-group-check-bogus-groups t] |
440 | ["Find new newsgroups" gnus-find-new-newsgroups t] | |
441 | ["Restart Gnus" gnus-group-restart t] | |
442 | ["Read init file" gnus-group-read-init-file t] | |
443 | ["Browse foreign server" gnus-group-browse-foreign-server t] | |
444 | ["Enter server buffer" gnus-group-enter-server-mode t] | |
231f989b | 445 | ["Expire all expirable articles" gnus-group-expire-all-groups t] |
41487370 LMI |
446 | ["Generate any kiboze groups" nnkiboze-generate-groups t] |
447 | ["Gnus version" gnus-version t] | |
448 | ["Save .newsrc files" gnus-group-save-newsrc t] | |
449 | ["Suspend Gnus" gnus-group-suspend t] | |
450 | ["Clear dribble buffer" gnus-group-clear-dribble t] | |
451 | ["Exit from Gnus" gnus-group-exit t] | |
452 | ["Exit without saving" gnus-group-quit t] | |
453 | ["Edit global kill file" gnus-group-edit-global-kill t] | |
231f989b LMI |
454 | ["Read manual" gnus-info-find-node t] |
455 | ["Toggle topics" gnus-topic-mode t] | |
456 | ("SOUP" | |
457 | ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] | |
458 | ["Send replies" gnus-soup-send-replies | |
459 | (fboundp 'gnus-soup-pack-packet)] | |
460 | ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] | |
461 | ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] | |
462 | ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) | |
41487370 LMI |
463 | )) |
464 | (run-hooks 'gnus-group-menu-hook) | |
465 | ))) | |
466 | ||
41487370 LMI |
467 | ;; Summary buffer |
468 | (defun gnus-summary-make-menu-bar () | |
469 | (gnus-visual-turn-off-edit-menu 'summary) | |
470 | ||
231f989b LMI |
471 | (unless (boundp 'gnus-summary-misc-menu) |
472 | ||
473 | (easy-menu-define | |
474 | gnus-summary-misc-menu gnus-summary-mode-map "" | |
475 | '("Misc" | |
476 | ("Mark" | |
477 | ("Read" | |
478 | ["Mark as read" gnus-summary-mark-as-read-forward t] | |
479 | ["Mark same subject and select" | |
480 | gnus-summary-kill-same-subject-and-select t] | |
481 | ["Mark same subject" gnus-summary-kill-same-subject t] | |
482 | ["Catchup" gnus-summary-catchup t] | |
483 | ["Catchup all" gnus-summary-catchup-all t] | |
484 | ["Catchup to here" gnus-summary-catchup-to-here t] | |
485 | ["Catchup region" gnus-summary-mark-region-as-read t] | |
486 | ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) | |
487 | ("Various" | |
488 | ["Tick" gnus-summary-tick-article-forward t] | |
489 | ["Mark as dormant" gnus-summary-mark-as-dormant t] | |
490 | ["Remove marks" gnus-summary-clear-mark-forward t] | |
491 | ["Set expirable mark" gnus-summary-mark-as-expirable t] | |
492 | ["Set bookmark" gnus-summary-set-bookmark t] | |
493 | ["Remove bookmark" gnus-summary-remove-bookmark t]) | |
494 | ("Limit" | |
495 | ["Marks..." gnus-summary-limit-to-marks t] | |
496 | ["Subject..." gnus-summary-limit-to-subject t] | |
497 | ["Author..." gnus-summary-limit-to-author t] | |
498 | ["Score" gnus-summary-limit-to-score t] | |
499 | ["Unread" gnus-summary-limit-to-unread t] | |
500 | ["Non-dormant" gnus-summary-limit-exclude-dormant t] | |
501 | ["Articles" gnus-summary-limit-to-articles t] | |
502 | ["Pop limit" gnus-summary-pop-limit t] | |
503 | ["Show dormant" gnus-summary-limit-include-dormant t] | |
504 | ["Hide childless dormant" | |
505 | gnus-summary-limit-exclude-childless-dormant t] | |
506 | ;;["Hide thread" gnus-summary-limit-exclude-thread t] | |
507 | ["Show expunged" gnus-summary-show-all-expunged t]) | |
508 | ("Process mark" | |
509 | ["Set mark" gnus-summary-mark-as-processable t] | |
510 | ["Remove mark" gnus-summary-unmark-as-processable t] | |
511 | ["Remove all marks" gnus-summary-unmark-all-processable t] | |
512 | ["Mark above" gnus-uu-mark-over t] | |
513 | ["Mark series" gnus-uu-mark-series t] | |
514 | ["Mark region" gnus-uu-mark-region t] | |
515 | ["Mark by regexp..." gnus-uu-mark-by-regexp t] | |
516 | ["Mark all" gnus-uu-mark-all t] | |
517 | ["Mark buffer" gnus-uu-mark-buffer t] | |
518 | ["Mark sparse" gnus-uu-mark-sparse t] | |
519 | ["Mark thread" gnus-uu-mark-thread t] | |
520 | ["Unmark thread" gnus-uu-unmark-thread t])) | |
521 | ("Scroll article" | |
522 | ["Page forward" gnus-summary-next-page t] | |
523 | ["Page backward" gnus-summary-prev-page t] | |
524 | ["Line forward" gnus-summary-scroll-up t]) | |
525 | ("Move" | |
526 | ["Next unread article" gnus-summary-next-unread-article t] | |
527 | ["Previous unread article" gnus-summary-prev-unread-article t] | |
528 | ["Next article" gnus-summary-next-article t] | |
529 | ["Previous article" gnus-summary-prev-article t] | |
530 | ["Next unread subject" gnus-summary-next-unread-subject t] | |
531 | ["Previous unread subject" gnus-summary-prev-unread-subject t] | |
532 | ["Next article same subject" gnus-summary-next-same-subject t] | |
533 | ["Previous article same subject" gnus-summary-prev-same-subject t] | |
534 | ["First unread article" gnus-summary-first-unread-article t] | |
535 | ["Best unread article" gnus-summary-best-unread-article t] | |
536 | ["Go to subject number..." gnus-summary-goto-subject t] | |
537 | ["Go to article number..." gnus-summary-goto-article t] | |
538 | ["Go to the last article" gnus-summary-goto-last-article t] | |
539 | ["Pop article off history" gnus-summary-pop-article t]) | |
540 | ("Sort" | |
541 | ["Sort by number" gnus-summary-sort-by-number t] | |
542 | ["Sort by author" gnus-summary-sort-by-author t] | |
543 | ["Sort by subject" gnus-summary-sort-by-subject t] | |
544 | ["Sort by date" gnus-summary-sort-by-date t] | |
545 | ["Sort by score" gnus-summary-sort-by-score t]) | |
546 | ("Exit" | |
547 | ["Catchup and exit" gnus-summary-catchup-and-exit t] | |
548 | ["Catchup all and exit" gnus-summary-catchup-and-exit t] | |
549 | ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] | |
550 | ["Exit group" gnus-summary-exit t] | |
551 | ["Exit group without updating" gnus-summary-exit-no-update t] | |
552 | ["Exit and goto next group" gnus-summary-next-group t] | |
553 | ["Exit and goto prev group" gnus-summary-prev-group t] | |
554 | ["Reselect group" gnus-summary-reselect-current-group t] | |
555 | ["Rescan group" gnus-summary-rescan-group t]) | |
556 | ("Help" | |
41487370 | 557 | ["Fetch group FAQ" gnus-summary-fetch-faq t] |
41487370 | 558 | ["Describe group" gnus-summary-describe-group t] |
231f989b LMI |
559 | ["Read manual" gnus-info-find-node t]) |
560 | ("Cache" | |
561 | ["Enter article" gnus-cache-enter-article t] | |
562 | ["Remove article" gnus-cache-remove-article t]) | |
563 | ("Modes" | |
564 | ["Pick and read" gnus-pick-mode t] | |
565 | ["Binary" gnus-binary-mode t]) | |
566 | ["Filter articles..." gnus-summary-execute-command t] | |
567 | ["Run command on subjects..." gnus-summary-universal-argument t] | |
568 | ["Toggle line truncation" gnus-summary-toggle-truncation t] | |
569 | ["Expand window" gnus-summary-expand-window t] | |
570 | ["Expire expirable articles" gnus-summary-expire-articles | |
571 | (gnus-check-backend-function | |
572 | 'request-expire-articles gnus-newsgroup-name)] | |
573 | ["Edit local kill file" gnus-summary-edit-local-kill t] | |
574 | ["Edit main kill file" gnus-summary-edit-global-kill t] | |
575 | )) | |
576 | ||
577 | (easy-menu-define | |
578 | gnus-summary-kill-menu gnus-summary-mode-map "" | |
579 | (cons | |
580 | "Score" | |
581 | (nconc | |
582 | (list | |
583 | ["Enter score..." gnus-summary-score-entry t]) | |
584 | (gnus-visual-score-map 'increase) | |
585 | (gnus-visual-score-map 'lower) | |
586 | '(("Mark" | |
587 | ["Kill below" gnus-summary-kill-below t] | |
588 | ["Mark above" gnus-summary-mark-above t] | |
589 | ["Tick above" gnus-summary-tick-above t] | |
590 | ["Clear above" gnus-summary-clear-above t]) | |
591 | ["Current score" gnus-summary-current-score t] | |
592 | ["Set score" gnus-summary-set-score t] | |
593 | ["Customize score file" gnus-score-customize t] | |
594 | ["Switch current score file..." gnus-score-change-score-file t] | |
595 | ["Set mark below..." gnus-score-set-mark-below t] | |
596 | ["Set expunge below..." gnus-score-set-expunge-below t] | |
597 | ["Edit current score file" gnus-score-edit-current-scores t] | |
598 | ["Edit score file" gnus-score-edit-file t] | |
599 | ["Trace score" gnus-score-find-trace t] | |
600 | ["Rescore buffer" gnus-summary-rescore t] | |
601 | ["Increase score..." gnus-summary-increase-score t] | |
602 | ["Lower score..." gnus-summary-lower-score t])))) | |
603 | ||
604 | '(("Default header" | |
605 | ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) | |
606 | :style radio | |
607 | :selected (null gnus-score-default-header)] | |
608 | ["From" (gnus-score-set-default 'gnus-score-default-header 'a) | |
609 | :style radio | |
610 | :selected (eq gnus-score-default-header 'a)] | |
611 | ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) | |
612 | :style radio | |
613 | :selected (eq gnus-score-default-header 's)] | |
614 | ["Article body" | |
615 | (gnus-score-set-default 'gnus-score-default-header 'b) | |
616 | :style radio | |
617 | :selected (eq gnus-score-default-header 'b )] | |
618 | ["All headers" | |
619 | (gnus-score-set-default 'gnus-score-default-header 'h) | |
620 | :style radio | |
621 | :selected (eq gnus-score-default-header 'h )] | |
622 | ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i) | |
623 | :style radio | |
624 | :selected (eq gnus-score-default-header 'i )] | |
625 | ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) | |
626 | :style radio | |
627 | :selected (eq gnus-score-default-header 't )] | |
628 | ["Crossposting" | |
629 | (gnus-score-set-default 'gnus-score-default-header 'x) | |
630 | :style radio | |
631 | :selected (eq gnus-score-default-header 'x )] | |
632 | ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) | |
633 | :style radio | |
634 | :selected (eq gnus-score-default-header 'l )] | |
635 | ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) | |
636 | :style radio | |
637 | :selected (eq gnus-score-default-header 'd )] | |
638 | ["Followups to author" | |
639 | (gnus-score-set-default 'gnus-score-default-header 'f) | |
640 | :style radio | |
641 | :selected (eq gnus-score-default-header 'f )]) | |
642 | ("Default type" | |
643 | ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) | |
644 | :style radio | |
645 | :selected (null gnus-score-default-type)] | |
646 | ;; The `:active' key is commented out in the following, | |
647 | ;; because the GNU Emacs hack to support radio buttons use | |
648 | ;; active to indicate which button is selected. | |
649 | ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) | |
650 | :style radio | |
651 | ;; :active (not (memq gnus-score-default-header '(l d))) | |
652 | :selected (eq gnus-score-default-type 's)] | |
653 | ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) | |
654 | :style radio | |
655 | ;; :active (not (memq gnus-score-default-header '(l d))) | |
656 | :selected (eq gnus-score-default-type 'r)] | |
657 | ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) | |
658 | :style radio | |
659 | ;; :active (not (memq gnus-score-default-header '(l d))) | |
660 | :selected (eq gnus-score-default-type 'e)] | |
661 | ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) | |
662 | :style radio | |
663 | ;; :active (not (memq gnus-score-default-header '(l d))) | |
664 | :selected (eq gnus-score-default-type 'f)] | |
665 | ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) | |
666 | :style radio | |
667 | ;; :active (eq (gnus-score-default-header 'd)) | |
668 | :selected (eq gnus-score-default-type 'b)] | |
669 | ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) | |
670 | :style radio | |
671 | ;; :active (eq (gnus-score-default-header 'd)) | |
672 | :selected (eq gnus-score-default-type 'n)] | |
673 | ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) | |
674 | :style radio | |
675 | ;; :active (eq (gnus-score-default-header 'd)) | |
676 | :selected (eq gnus-score-default-type 'a)] | |
677 | ["Less than number" | |
678 | (gnus-score-set-default 'gnus-score-default-type '<) | |
679 | :style radio | |
680 | ;; :active (eq (gnus-score-default-header 'l)) | |
681 | :selected (eq gnus-score-default-type '<)] | |
682 | ["Equal to number" | |
683 | (gnus-score-set-default 'gnus-score-default-type '=) | |
684 | :style radio | |
685 | ;; :active (eq (gnus-score-default-header 'l)) | |
686 | :selected (eq gnus-score-default-type '=)] | |
687 | ["Greater than number" | |
688 | (gnus-score-set-default 'gnus-score-default-type '>) | |
689 | :style radio | |
690 | ;; :active (eq (gnus-score-default-header 'l)) | |
691 | :selected (eq gnus-score-default-type '>)]) | |
692 | ["Default fold" gnus-score-default-fold-toggle | |
693 | :style toggle | |
694 | :selected gnus-score-default-fold] | |
695 | ("Default duration" | |
696 | ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) | |
697 | :style radio | |
698 | :selected (null gnus-score-default-duration)] | |
699 | ["Permanent" | |
700 | (gnus-score-set-default 'gnus-score-default-duration 'p) | |
701 | :style radio | |
702 | :selected (eq gnus-score-default-duration 'p)] | |
703 | ["Temporary" | |
704 | (gnus-score-set-default 'gnus-score-default-duration 't) | |
705 | :style radio | |
706 | :selected (eq gnus-score-default-duration 't)] | |
707 | ["Immediate" | |
708 | (gnus-score-set-default 'gnus-score-default-duration 'i) | |
709 | :style radio | |
710 | :selected (eq gnus-score-default-duration 'i)])) | |
711 | ||
712 | (easy-menu-define | |
713 | gnus-summary-article-menu gnus-summary-mode-map "" | |
714 | '("Article" | |
715 | ("Hide" | |
716 | ["All" gnus-article-hide t] | |
717 | ["Headers" gnus-article-hide-headers t] | |
718 | ["Signature" gnus-article-hide-signature t] | |
719 | ["Citation" gnus-article-hide-citation t] | |
720 | ["PGP" gnus-article-hide-pgp t] | |
721 | ["Boring headers" gnus-article-hide-boring-headers t]) | |
722 | ("Highlight" | |
723 | ["All" gnus-article-highlight t] | |
724 | ["Headers" gnus-article-highlight-headers t] | |
725 | ["Signature" gnus-article-highlight-signature t] | |
726 | ["Citation" gnus-article-highlight-citation t]) | |
727 | ("Date" | |
728 | ["Local" gnus-article-date-local t] | |
729 | ["UT" gnus-article-date-ut t] | |
730 | ["Original" gnus-article-date-original t] | |
731 | ["Lapsed" gnus-article-date-lapsed t]) | |
732 | ("Filter" | |
733 | ["Overstrike" gnus-article-treat-overstrike t] | |
734 | ["Word wrap" gnus-article-fill-cited-article t] | |
735 | ["CR" gnus-article-remove-cr t] | |
736 | ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t] | |
737 | ["Show X-Face" gnus-article-display-x-face t] | |
738 | ["Quoted-Printable" gnus-article-de-quoted-unreadable t] | |
739 | ["Rot 13" gnus-summary-caesar-message t] | |
740 | ["Add buttons" gnus-article-add-buttons t] | |
741 | ["Add buttons to head" gnus-article-add-buttons-to-head t] | |
742 | ["Stop page breaking" gnus-summary-stop-page-breaking t] | |
743 | ["Toggle MIME" gnus-summary-toggle-mime t] | |
744 | ["Verbose header" gnus-summary-verbose-headers t] | |
745 | ["Toggle header" gnus-summary-toggle-header t]) | |
746 | ("Output" | |
747 | ["Save in default format" gnus-summary-save-article t] | |
748 | ["Save in file" gnus-summary-save-article-file t] | |
749 | ["Save in Unix mail format" gnus-summary-save-article-mail t] | |
750 | ["Save in MH folder" gnus-summary-save-article-folder t] | |
751 | ["Save in VM folder" gnus-summary-save-article-vm t] | |
752 | ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] | |
753 | ["Save body in file" gnus-summary-save-article-body-file t] | |
754 | ["Pipe through a filter" gnus-summary-pipe-output t] | |
755 | ["Add to SOUP packet" gnus-soup-add-article t]) | |
756 | ("Backend" | |
757 | ["Respool article..." gnus-summary-respool-article t] | |
758 | ["Move article..." gnus-summary-move-article | |
759 | (gnus-check-backend-function | |
760 | 'request-move-article gnus-newsgroup-name)] | |
761 | ["Copy article..." gnus-summary-copy-article t] | |
762 | ["Crosspost article..." gnus-summary-crosspost-article | |
763 | (gnus-check-backend-function | |
764 | 'request-replace-article gnus-newsgroup-name)] | |
765 | ["Import file..." gnus-summary-import-article t] | |
766 | ["Edit article" gnus-summary-edit-article | |
767 | (not (gnus-group-read-only-p))] | |
768 | ["Delete article" gnus-summary-delete-article | |
769 | (gnus-check-backend-function | |
770 | 'request-expire-articles gnus-newsgroup-name)] | |
771 | ["Query respool" gnus-summary-respool-query t] | |
772 | ["Delete expirable articles" gnus-summary-expire-articles-now | |
773 | (gnus-check-backend-function | |
774 | 'request-expire-articles gnus-newsgroup-name)]) | |
775 | ("Extract" | |
776 | ["Uudecode" gnus-uu-decode-uu t] | |
777 | ["Uudecode and save" gnus-uu-decode-uu-and-save t] | |
778 | ["Unshar" gnus-uu-decode-unshar t] | |
779 | ["Unshar and save" gnus-uu-decode-unshar-and-save t] | |
780 | ["Save" gnus-uu-decode-save t] | |
781 | ["Binhex" gnus-uu-decode-binhex t] | |
782 | ["Postscript" gnus-uu-decode-postscript t]) | |
783 | ["Enter digest buffer" gnus-summary-enter-digest-group t] | |
784 | ["Isearch article..." gnus-summary-isearch-article t] | |
785 | ["Search articles forward..." gnus-summary-search-article-forward t] | |
786 | ["Search articles backward..." gnus-summary-search-article-backward t] | |
787 | ["Beginning of the article" gnus-summary-beginning-of-article t] | |
788 | ["End of the article" gnus-summary-end-of-article t] | |
789 | ["Fetch parent of article" gnus-summary-refer-parent-article t] | |
790 | ["Fetch referenced articles" gnus-summary-refer-references t] | |
791 | ["Fetch article with id..." gnus-summary-refer-article t] | |
792 | ["Redisplay" gnus-summary-show-article t])) | |
793 | ||
794 | (easy-menu-define | |
795 | gnus-summary-thread-menu gnus-summary-mode-map "" | |
796 | '("Threads" | |
797 | ["Toggle threading" gnus-summary-toggle-threads t] | |
798 | ["Hide threads" gnus-summary-hide-all-threads t] | |
799 | ["Show threads" gnus-summary-show-all-threads t] | |
800 | ["Hide thread" gnus-summary-hide-thread t] | |
801 | ["Show thread" gnus-summary-show-thread t] | |
802 | ["Go to next thread" gnus-summary-next-thread t] | |
803 | ["Go to previous thread" gnus-summary-prev-thread t] | |
804 | ["Go down thread" gnus-summary-down-thread t] | |
805 | ["Go up thread" gnus-summary-up-thread t] | |
806 | ["Top of thread" gnus-summary-top-thread t] | |
807 | ["Mark thread as read" gnus-summary-kill-thread t] | |
808 | ["Lower thread score" gnus-summary-lower-thread t] | |
809 | ["Raise thread score" gnus-summary-raise-thread t] | |
810 | ["Rethread current" gnus-summary-rethread-current t] | |
811 | )) | |
812 | ||
813 | (easy-menu-define | |
814 | gnus-summary-post-menu gnus-summary-mode-map "" | |
815 | '("Post" | |
816 | ["Post an article" gnus-summary-post-news t] | |
817 | ["Followup" gnus-summary-followup t] | |
818 | ["Followup and yank" gnus-summary-followup-with-original t] | |
819 | ["Supersede article" gnus-summary-supersede-article t] | |
820 | ["Cancel article" gnus-summary-cancel-article t] | |
821 | ["Reply" gnus-summary-reply t] | |
822 | ["Reply and yank" gnus-summary-reply-with-original t] | |
823 | ["Mail forward" gnus-summary-mail-forward t] | |
824 | ["Post forward" gnus-summary-post-forward t] | |
825 | ["Digest and mail" gnus-uu-digest-mail-forward t] | |
826 | ["Digest and post" gnus-uu-digest-post-forward t] | |
827 | ["Resend message" gnus-summary-resend-message t] | |
828 | ["Send bounced mail" gnus-summary-resend-bounced-mail t] | |
829 | ["Send a mail" gnus-summary-mail-other-window t] | |
830 | ["Uuencode and post" gnus-uu-post-news t] | |
831 | ;;("Draft" | |
832 | ;;["Send" gnus-summary-send-draft t] | |
833 | ;;["Send bounced" gnus-resend-bounced-mail t]) | |
834 | )) | |
835 | (run-hooks 'gnus-summary-menu-hook) | |
836 | )) | |
41487370 LMI |
837 | |
838 | (defun gnus-score-set-default (var value) | |
231f989b | 839 | "A version of set that updates the GNU Emacs menu-bar." |
41487370 LMI |
840 | (set var value) |
841 | ;; It is the message that forces the active status to be updated. | |
842 | (message "")) | |
843 | ||
41487370 LMI |
844 | (defun gnus-visual-score-map (type) |
845 | (if t | |
846 | nil | |
847 | (let ((headers '(("author" "from" string) | |
848 | ("subject" "subject" string) | |
849 | ("article body" "body" string) | |
850 | ("article head" "head" string) | |
851 | ("xref" "xref" string) | |
852 | ("lines" "lines" number) | |
853 | ("followups to author" "followup" string))) | |
854 | (types '((number ("less than" <) | |
855 | ("greater than" >) | |
856 | ("equal" =)) | |
857 | (string ("substring" s) | |
858 | ("exact string" e) | |
859 | ("fuzzy string" f) | |
860 | ("regexp" r)))) | |
861 | (perms '(("temporary" (current-time-string)) | |
862 | ("permanent" nil) | |
863 | ("immediate" now))) | |
864 | header) | |
865 | (list | |
866 | (apply | |
867 | 'nconc | |
868 | (list | |
869 | (if (eq type 'lower) | |
870 | "Lower score" | |
871 | "Increase score")) | |
872 | (let (outh) | |
873 | (while headers | |
874 | (setq header (car headers)) | |
875 | (setq outh | |
876 | (cons | |
877 | (apply | |
878 | 'nconc | |
879 | (list (car header)) | |
880 | (let ((ts (cdr (assoc (nth 2 header) types))) | |
881 | outt) | |
882 | (while ts | |
883 | (setq outt | |
884 | (cons | |
885 | (apply | |
886 | 'nconc | |
231f989b | 887 | (list (caar ts)) |
41487370 LMI |
888 | (let ((ps perms) |
889 | outp) | |
890 | (while ps | |
891 | (setq outp | |
892 | (cons | |
893 | (vector | |
231f989b | 894 | (caar ps) |
41487370 LMI |
895 | (list |
896 | 'gnus-summary-score-entry | |
897 | (nth 1 header) | |
898 | (if (or (string= (nth 1 header) | |
899 | "head") | |
900 | (string= (nth 1 header) | |
901 | "body")) | |
902 | "" | |
903 | (list 'gnus-summary-header | |
904 | (nth 1 header))) | |
905 | (list 'quote (nth 1 (car ts))) | |
906 | (list 'gnus-score-default nil) | |
907 | (nth 1 (car ps)) | |
908 | t) | |
909 | t) | |
910 | outp)) | |
911 | (setq ps (cdr ps))) | |
912 | (list (nreverse outp)))) | |
913 | outt)) | |
914 | (setq ts (cdr ts))) | |
915 | (list (nreverse outt)))) | |
916 | outh)) | |
917 | (setq headers (cdr headers))) | |
918 | (list (nreverse outh)))))))) | |
919 | ||
920 | ;; Article buffer | |
921 | (defun gnus-article-make-menu-bar () | |
922 | (gnus-visual-turn-off-edit-menu 'summary) | |
923 | (or | |
924 | (boundp 'gnus-article-article-menu) | |
925 | (progn | |
926 | (easy-menu-define | |
231f989b | 927 | gnus-article-article-menu gnus-article-mode-map "" |
41487370 | 928 | '("Article" |
231f989b LMI |
929 | ["Scroll forwards" gnus-article-goto-next-page t] |
930 | ["Scroll backwards" gnus-article-goto-prev-page t] | |
41487370 LMI |
931 | ["Show summary" gnus-article-show-summary t] |
932 | ["Fetch Message-ID at point" gnus-article-refer-article t] | |
933 | ["Mail to address at point" gnus-article-mail t] | |
934 | )) | |
935 | ||
936 | (easy-menu-define | |
231f989b | 937 | gnus-article-treatment-menu gnus-article-mode-map "" |
41487370 LMI |
938 | '("Treatment" |
939 | ["Hide headers" gnus-article-hide-headers t] | |
940 | ["Hide signature" gnus-article-hide-signature t] | |
941 | ["Hide citation" gnus-article-hide-citation t] | |
942 | ["Treat overstrike" gnus-article-treat-overstrike t] | |
943 | ["Remove carriage return" gnus-article-remove-cr t] | |
944 | ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] | |
945 | )) | |
231f989b | 946 | (run-hooks 'gnus-article-menu-hook)))) |
41487370 LMI |
947 | |
948 | ;;; | |
949 | ;;; summary highlights | |
950 | ;;; | |
951 | ||
952 | (defun gnus-highlight-selected-summary () | |
953 | ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. | |
954 | ;; Highlight selected article in summary buffer | |
955 | (if gnus-summary-selected-face | |
956 | (save-excursion | |
957 | (let* ((beg (progn (beginning-of-line) (point))) | |
958 | (end (progn (end-of-line) (point))) | |
959 | ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. | |
231f989b | 960 | (from (if (get-text-property beg gnus-mouse-face-prop) |
41487370 LMI |
961 | beg |
962 | (1+ (or (next-single-property-change | |
231f989b | 963 | beg gnus-mouse-face-prop nil end) |
41487370 LMI |
964 | beg)))) |
965 | (to (1- (or (next-single-property-change | |
231f989b | 966 | from gnus-mouse-face-prop nil end) |
41487370 LMI |
967 | end)))) |
968 | ;; If no mouse-face prop on line (e.g. xemacs) we | |
969 | ;; will have to = from = end, so we highlight the | |
970 | ;; entire line instead. | |
971 | (if (= (+ to 2) from) | |
972 | (progn | |
973 | (setq from beg) | |
974 | (setq to end))) | |
975 | (if gnus-newsgroup-selected-overlay | |
976 | (gnus-move-overlay gnus-newsgroup-selected-overlay | |
977 | from to (current-buffer)) | |
978 | (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) | |
979 | (gnus-overlay-put gnus-newsgroup-selected-overlay 'face | |
980 | gnus-summary-selected-face)))))) | |
981 | ||
982 | ;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>. | |
983 | (defun gnus-summary-highlight-line () | |
984 | "Highlight current line according to `gnus-summary-highlight'." | |
985 | (let* ((list gnus-summary-highlight) | |
986 | (p (point)) | |
987 | (end (progn (end-of-line) (point))) | |
988 | ;; now find out where the line starts and leave point there. | |
989 | (beg (progn (beginning-of-line) (point))) | |
231f989b LMI |
990 | (article (gnus-summary-article-number)) |
991 | (score (or (cdr (assq (or article gnus-current-article) | |
41487370 LMI |
992 | gnus-newsgroup-scored)) |
993 | gnus-summary-default-score 0)) | |
231f989b LMI |
994 | (mark (or (gnus-summary-article-mark) gnus-unread-mark)) |
995 | (inhibit-read-only t)) | |
996 | ;; Eval the cars of the lists until we find a match. | |
997 | (let ((default gnus-summary-default-score)) | |
998 | (while (and list | |
999 | (not (eval (caar list)))) | |
1000 | (setq list (cdr list)))) | |
1001 | (let ((face (cdar list))) | |
1002 | (unless (eq face (get-text-property beg 'face)) | |
1003 | (gnus-put-text-property | |
1004 | beg end 'face | |
1005 | (setq face (if (boundp face) (symbol-value face) face))) | |
1006 | (when gnus-summary-highlight-line-function | |
1007 | (funcall gnus-summary-highlight-line-function article face)))) | |
1008 | (goto-char p))) | |
1009 | ||
1010 | (defun gnus-group-highlight-line () | |
1011 | "Highlight the current line according to `gnus-group-highlight'." | |
1012 | (let* ((list gnus-group-highlight) | |
1013 | (p (point)) | |
1014 | (end (progn (end-of-line) (point))) | |
1015 | ;; now find out where the line starts and leave point there. | |
1016 | (beg (progn (beginning-of-line) (point))) | |
1017 | (group (gnus-group-group-name)) | |
1018 | (entry (gnus-group-entry group)) | |
1019 | (unread (if (numberp (car entry)) (car entry) 0)) | |
1020 | (info (nth 2 entry)) | |
1021 | (method (gnus-server-get-method group (gnus-info-method info))) | |
1022 | (marked (gnus-info-marks info)) | |
1023 | (mailp (memq 'mail (assoc (symbol-name | |
1024 | (car (or method gnus-select-method))) | |
1025 | gnus-valid-select-methods))) | |
1026 | (level (or (gnus-info-level info) 9)) | |
1027 | (score (or (gnus-info-score info) 0)) | |
1028 | (ticked (gnus-range-length (cdr (assq 'tick marked)))) | |
41487370 | 1029 | (inhibit-read-only t)) |
231f989b LMI |
1030 | ;; Eval the cars of the lists until we find a match. |
1031 | (while (and list | |
1032 | (not (eval (caar list)))) | |
41487370 | 1033 | (setq list (cdr list))) |
231f989b LMI |
1034 | (let ((face (cdar list))) |
1035 | (unless (eq face (get-text-property beg 'face)) | |
1036 | (gnus-put-text-property | |
1037 | beg end 'face | |
1038 | (setq face (if (boundp face) (symbol-value face) face))) | |
1039 | (gnus-extent-start-open beg))) | |
41487370 LMI |
1040 | (goto-char p))) |
1041 | ||
1042 | ;;; | |
1043 | ;;; gnus-carpal | |
1044 | ;;; | |
1045 | ||
1046 | (defvar gnus-carpal-group-buffer-buttons | |
1047 | '(("next" . gnus-group-next-unread-group) | |
1048 | ("prev" . gnus-group-prev-unread-group) | |
1049 | ("read" . gnus-group-read-group) | |
1050 | ("select" . gnus-group-select-group) | |
1051 | ("catch-up" . gnus-group-catchup-current) | |
1052 | ("new-news" . gnus-group-get-new-news-this-group) | |
1053 | ("toggle-sub" . gnus-group-unsubscribe-current-group) | |
1054 | ("subscribe" . gnus-group-unsubscribe-group) | |
1055 | ("kill" . gnus-group-kill-group) | |
1056 | ("yank" . gnus-group-yank-group) | |
1057 | ("describe" . gnus-group-describe-group) | |
1058 | "list" | |
1059 | ("subscribed" . gnus-group-list-groups) | |
1060 | ("all" . gnus-group-list-all-groups) | |
1061 | ("killed" . gnus-group-list-killed) | |
1062 | ("zombies" . gnus-group-list-zombies) | |
1063 | ("matching" . gnus-group-list-matching) | |
1064 | ("post" . gnus-group-post-news) | |
1065 | ("mail" . gnus-group-mail) | |
1066 | ("rescan" . gnus-group-get-new-news) | |
1067 | ("browse-foreign" . gnus-group-browse-foreign) | |
1068 | ("exit" . gnus-group-exit))) | |
1069 | ||
1070 | (defvar gnus-carpal-summary-buffer-buttons | |
1071 | '("mark" | |
1072 | ("read" . gnus-summary-mark-as-read-forward) | |
1073 | ("tick" . gnus-summary-tick-article-forward) | |
1074 | ("clear" . gnus-summary-clear-mark-forward) | |
1075 | ("expirable" . gnus-summary-mark-as-expirable) | |
1076 | "move" | |
1077 | ("scroll" . gnus-summary-next-page) | |
1078 | ("next-unread" . gnus-summary-next-unread-article) | |
1079 | ("prev-unread" . gnus-summary-prev-unread-article) | |
1080 | ("first" . gnus-summary-first-unread-article) | |
1081 | ("best" . gnus-summary-best-unread-article) | |
1082 | "article" | |
1083 | ("headers" . gnus-summary-toggle-header) | |
1084 | ("uudecode" . gnus-uu-decode-uu) | |
1085 | ("enter-digest" . gnus-summary-enter-digest-group) | |
1086 | ("fetch-parent" . gnus-summary-refer-parent-article) | |
1087 | "mail" | |
1088 | ("move" . gnus-summary-move-article) | |
1089 | ("copy" . gnus-summary-copy-article) | |
1090 | ("respool" . gnus-summary-respool-article) | |
1091 | "threads" | |
1092 | ("lower" . gnus-summary-lower-thread) | |
1093 | ("kill" . gnus-summary-kill-thread) | |
1094 | "post" | |
1095 | ("post" . gnus-summary-post-news) | |
1096 | ("mail" . gnus-summary-mail) | |
1097 | ("followup" . gnus-summary-followup-with-original) | |
1098 | ("reply" . gnus-summary-reply-with-original) | |
1099 | ("cancel" . gnus-summary-cancel-article) | |
1100 | "misc" | |
1101 | ("exit" . gnus-summary-exit) | |
1102 | ("fed-up" . gnus-summary-catchup-and-goto-next-group))) | |
1103 | ||
1104 | (defvar gnus-carpal-server-buffer-buttons | |
1105 | '(("add" . gnus-server-add-server) | |
1106 | ("browse" . gnus-server-browse-server) | |
1107 | ("list" . gnus-server-list-servers) | |
1108 | ("kill" . gnus-server-kill-server) | |
1109 | ("yank" . gnus-server-yank-server) | |
1110 | ("copy" . gnus-server-copy-server) | |
1111 | ("exit" . gnus-server-exit))) | |
1112 | ||
1113 | (defvar gnus-carpal-browse-buffer-buttons | |
1114 | '(("subscribe" . gnus-browse-unsubscribe-current-group) | |
1115 | ("exit" . gnus-browse-exit))) | |
1116 | ||
1117 | (defvar gnus-carpal-group-buffer "*Carpal Group*") | |
1118 | (defvar gnus-carpal-summary-buffer "*Carpal Summary*") | |
1119 | (defvar gnus-carpal-server-buffer "*Carpal Server*") | |
1120 | (defvar gnus-carpal-browse-buffer "*Carpal Browse*") | |
1121 | ||
1122 | (defvar gnus-carpal-attached-buffer nil) | |
1123 | ||
1124 | (defvar gnus-carpal-mode-hook nil | |
1125 | "*Hook run in carpal mode buffers.") | |
1126 | ||
1127 | (defvar gnus-carpal-button-face 'bold | |
1128 | "*Face used on carpal buttons.") | |
1129 | ||
1130 | (defvar gnus-carpal-header-face 'bold-italic | |
1131 | "*Face used on carpal buffer headers.") | |
1132 | ||
1133 | (defvar gnus-carpal-mode-map nil) | |
1134 | (put 'gnus-carpal-mode 'mode-class 'special) | |
1135 | ||
1136 | (if gnus-carpal-mode-map | |
1137 | nil | |
1138 | (setq gnus-carpal-mode-map (make-keymap)) | |
1139 | (suppress-keymap gnus-carpal-mode-map) | |
1140 | (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) | |
1141 | (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) | |
1142 | (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select)) | |
1143 | ||
1144 | (defun gnus-carpal-mode () | |
1145 | "Major mode for clicking buttons. | |
1146 | ||
1147 | All normal editing commands are switched off. | |
1148 | \\<gnus-carpal-mode-map> | |
1149 | The following commands are available: | |
1150 | ||
1151 | \\{gnus-carpal-mode-map}" | |
1152 | (interactive) | |
1153 | (kill-all-local-variables) | |
1154 | (setq mode-line-modified "-- ") | |
1155 | (setq major-mode 'gnus-carpal-mode) | |
1156 | (setq mode-name "Gnus Carpal") | |
1157 | (setq mode-line-process nil) | |
1158 | (use-local-map gnus-carpal-mode-map) | |
1159 | (buffer-disable-undo (current-buffer)) | |
1160 | (setq buffer-read-only t) | |
1161 | (make-local-variable 'gnus-carpal-attached-buffer) | |
1162 | (run-hooks 'gnus-carpal-mode-hook)) | |
1163 | ||
1164 | (defun gnus-carpal-setup-buffer (type) | |
1165 | (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) | |
1166 | (if (get-buffer buffer) | |
1167 | () | |
1168 | (save-excursion | |
1169 | (set-buffer (get-buffer-create buffer)) | |
1170 | (gnus-carpal-mode) | |
1171 | (setq gnus-carpal-attached-buffer | |
1172 | (intern (format "gnus-%s-buffer" type))) | |
1173 | (gnus-add-current-to-buffer-list) | |
1174 | (let ((buttons (symbol-value | |
1175 | (intern (format "gnus-carpal-%s-buffer-buttons" | |
1176 | type)))) | |
1177 | (buffer-read-only nil) | |
1178 | button) | |
1179 | (while buttons | |
1180 | (setq button (car buttons) | |
1181 | buttons (cdr buttons)) | |
1182 | (if (stringp button) | |
231f989b | 1183 | (gnus-set-text-properties |
41487370 LMI |
1184 | (point) |
1185 | (prog2 (insert button) (point) (insert " ")) | |
1186 | (list 'face gnus-carpal-header-face)) | |
231f989b | 1187 | (gnus-set-text-properties |
41487370 LMI |
1188 | (point) |
1189 | (prog2 (insert (car button)) (point) (insert " ")) | |
1190 | (list 'gnus-callback (cdr button) | |
1191 | 'face gnus-carpal-button-face | |
231f989b | 1192 | gnus-mouse-face-prop 'highlight)))) |
41487370 LMI |
1193 | (let ((fill-column (- (window-width) 2))) |
1194 | (fill-region (point-min) (point-max))) | |
1195 | (set-window-point (get-buffer-window (current-buffer)) | |
1196 | (point-min))))))) | |
1197 | ||
1198 | (defun gnus-carpal-select () | |
1199 | "Select the button under point." | |
1200 | (interactive) | |
1201 | (let ((func (get-text-property (point) 'gnus-callback))) | |
1202 | (if (null func) | |
1203 | () | |
1204 | (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) | |
1205 | (call-interactively func)))) | |
1206 | ||
1207 | (defun gnus-carpal-mouse-select (event) | |
1208 | "Select the button under the mouse pointer." | |
1209 | (interactive "e") | |
1210 | (mouse-set-point event) | |
1211 | (gnus-carpal-select)) | |
1212 | ||
1213 | ;;; | |
1214 | ;;; article highlights | |
1215 | ;;; | |
1216 | ||
1217 | ;; Written by Per Abrahamsen <abraham@iesd.auc.dk>. | |
1218 | ||
1219 | ;;; Internal Variables: | |
1220 | ||
1221 | (defvar gnus-button-regexp nil) | |
1222 | ;; Regexp matching any of the regexps from `gnus-button-alist'. | |
1223 | ||
1224 | (defvar gnus-button-last nil) | |
1225 | ;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. | |
1226 | ||
1227 | ;;; Commands: | |
1228 | ||
1229 | (defun gnus-article-push-button (event) | |
1230 | "Check text under the mouse pointer for a callback function. | |
1231 | If the text under the mouse pointer has a `gnus-callback' property, | |
1232 | call it with the value of the `gnus-data' text property." | |
1233 | (interactive "e") | |
1234 | (set-buffer (window-buffer (posn-window (event-start event)))) | |
1235 | (let* ((pos (posn-point (event-start event))) | |
1236 | (data (get-text-property pos 'gnus-data)) | |
1237 | (fun (get-text-property pos 'gnus-callback))) | |
1238 | (if fun (funcall fun data)))) | |
1239 | ||
1240 | (defun gnus-article-press-button () | |
1241 | "Check text at point for a callback function. | |
1242 | If the text at point has a `gnus-callback' property, | |
1243 | call it with the value of the `gnus-data' text property." | |
1244 | (interactive) | |
1245 | (let* ((data (get-text-property (point) 'gnus-data)) | |
1246 | (fun (get-text-property (point) 'gnus-callback))) | |
1247 | (if fun (funcall fun data)))) | |
1248 | ||
231f989b LMI |
1249 | (defun gnus-article-prev-button (n) |
1250 | "Move point to N buttons backward. | |
1251 | If N is negative, move forward instead." | |
1252 | (interactive "p") | |
1253 | (gnus-article-next-button (- n))) | |
1254 | ||
1255 | (defun gnus-article-next-button (n) | |
1256 | "Move point to N buttons forward. | |
1257 | If N is negative, move backward instead." | |
1258 | (interactive "p") | |
1259 | (let ((function (if (< n 0) 'previous-single-property-change | |
1260 | 'next-single-property-change)) | |
1261 | (inhibit-point-motion-hooks t) | |
1262 | (backward (< n 0)) | |
1263 | (limit (if (< n 0) (point-min) (point-max)))) | |
1264 | (setq n (abs n)) | |
1265 | (while (and (not (= limit (point))) | |
1266 | (> n 0)) | |
1267 | ;; Skip past the current button. | |
1268 | (when (get-text-property (point) 'gnus-callback) | |
1269 | (goto-char (funcall function (point) 'gnus-callback nil limit))) | |
1270 | ;; Go to the next (or previous) button. | |
1271 | (gnus-goto-char (funcall function (point) 'gnus-callback nil limit)) | |
1272 | ;; Put point at the start of the button. | |
1273 | (when (and backward (not (get-text-property (point) 'gnus-callback))) | |
1274 | (goto-char (funcall function (point) 'gnus-callback nil limit))) | |
1275 | ;; Skip past intangible buttons. | |
1276 | (when (get-text-property (point) 'intangible) | |
1277 | (incf n)) | |
1278 | (decf n)) | |
1279 | (unless (zerop n) | |
1280 | (gnus-message 5 "No more buttons")) | |
1281 | n)) | |
41487370 LMI |
1282 | |
1283 | (defun gnus-article-highlight (&optional force) | |
1284 | "Highlight current article. | |
1285 | This function calls `gnus-article-highlight-headers', | |
1286 | `gnus-article-highlight-citation', | |
1287 | `gnus-article-highlight-signature', and `gnus-article-add-buttons' to | |
1288 | do the highlighting. See the documentation for those functions." | |
1289 | (interactive (list 'force)) | |
1290 | (gnus-article-highlight-headers) | |
1291 | (gnus-article-highlight-citation force) | |
1292 | (gnus-article-highlight-signature) | |
231f989b LMI |
1293 | (gnus-article-add-buttons force) |
1294 | (gnus-article-add-buttons-to-head)) | |
41487370 LMI |
1295 | |
1296 | (defun gnus-article-highlight-some (&optional force) | |
1297 | "Highlight current article. | |
1298 | This function calls `gnus-article-highlight-headers', | |
1299 | `gnus-article-highlight-signature', and `gnus-article-add-buttons' to | |
1300 | do the highlighting. See the documentation for those functions." | |
1301 | (interactive (list 'force)) | |
1302 | (gnus-article-highlight-headers) | |
1303 | (gnus-article-highlight-signature) | |
1304 | (gnus-article-add-buttons)) | |
1305 | ||
41487370 LMI |
1306 | (defun gnus-article-highlight-headers () |
1307 | "Highlight article headers as specified by `gnus-header-face-alist'." | |
1308 | (interactive) | |
1309 | (save-excursion | |
1310 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
1311 | (save-restriction |
1312 | (let ((alist gnus-header-face-alist) | |
1313 | (buffer-read-only nil) | |
1314 | (case-fold-search t) | |
1315 | (inhibit-point-motion-hooks t) | |
1316 | entry regexp header-face field-face from hpoints fpoints) | |
1317 | (goto-char (point-min)) | |
1318 | (when (search-forward "\n\n" nil t) | |
1319 | (narrow-to-region (1- (point)) (point-min)) | |
1320 | (while (setq entry (pop alist)) | |
1321 | (goto-char (point-min)) | |
1322 | (setq regexp (concat "^\\(" | |
1323 | (if (string-equal "" (nth 0 entry)) | |
1324 | "[^\t ]" | |
1325 | (nth 0 entry)) | |
1326 | "\\)") | |
41487370 | 1327 | header-face (nth 1 entry) |
231f989b LMI |
1328 | field-face (nth 2 entry)) |
1329 | (while (and (re-search-forward regexp nil t) | |
1330 | (not (eobp))) | |
1331 | (beginning-of-line) | |
1332 | (setq from (point)) | |
1333 | (or (search-forward ":" nil t) | |
1334 | (forward-char 1)) | |
1335 | (when (and header-face | |
1336 | (not (memq (point) hpoints))) | |
1337 | (push (point) hpoints) | |
1338 | (gnus-put-text-property from (point) 'face header-face)) | |
1339 | (when (and field-face | |
1340 | (not (memq (setq from (point)) fpoints))) | |
1341 | (push from fpoints) | |
1342 | (if (re-search-forward "^[^ \t]" nil t) | |
1343 | (forward-char -2) | |
1344 | (goto-char (point-max))) | |
1345 | (gnus-put-text-property from (point) 'face field-face))))))))) | |
41487370 LMI |
1346 | |
1347 | (defun gnus-article-highlight-signature () | |
1348 | "Highlight the signature in an article. | |
1349 | It does this by highlighting everything after | |
1350 | `gnus-signature-separator' using `gnus-signature-face'." | |
1351 | (interactive) | |
1352 | (save-excursion | |
1353 | (set-buffer gnus-article-buffer) | |
1354 | (let ((buffer-read-only nil) | |
1355 | (inhibit-point-motion-hooks t)) | |
231f989b LMI |
1356 | (save-restriction |
1357 | (when (and gnus-signature-face | |
1358 | (gnus-narrow-to-signature)) | |
1359 | (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) | |
1360 | 'face gnus-signature-face) | |
1361 | (widen) | |
1362 | (re-search-backward gnus-signature-separator nil t) | |
1363 | (let ((start (match-beginning 0)) | |
1364 | (end (set-marker (make-marker) (1+ (match-end 0))))) | |
1365 | (gnus-article-add-button start (1- end) 'gnus-signature-toggle | |
1366 | end))))))) | |
41487370 LMI |
1367 | |
1368 | (defun gnus-article-add-buttons (&optional force) | |
231f989b LMI |
1369 | "Find external references in the article and make buttons of them. |
1370 | \"External references\" are things like Message-IDs and URLs, as | |
1371 | specified by `gnus-button-alist'." | |
41487370 | 1372 | (interactive (list 'force)) |
41487370 LMI |
1373 | (save-excursion |
1374 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
1375 | ;; Remove all old markers. |
1376 | (while gnus-button-marker-list | |
1377 | (set-marker (pop gnus-button-marker-list) nil)) | |
41487370 LMI |
1378 | (let ((buffer-read-only nil) |
1379 | (inhibit-point-motion-hooks t) | |
231f989b LMI |
1380 | (case-fold-search t) |
1381 | (alist gnus-button-alist) | |
1382 | beg entry regexp) | |
41487370 | 1383 | (goto-char (point-min)) |
231f989b LMI |
1384 | ;; We skip the headers. |
1385 | (unless (search-forward "\n\n" nil t) | |
1386 | (goto-char (point-max))) | |
1387 | (setq beg (point)) | |
1388 | (while (setq entry (pop alist)) | |
1389 | (setq regexp (car entry)) | |
1390 | (goto-char beg) | |
1391 | (while (re-search-forward regexp nil t) | |
1392 | (let* ((start (and entry (match-beginning (nth 1 entry)))) | |
1393 | (end (and entry (match-end (nth 1 entry)))) | |
1394 | (from (match-beginning 0))) | |
1395 | (when (or (eq t (nth 1 entry)) | |
1396 | (eval (nth 1 entry))) | |
1397 | ;; That optional form returned non-nil, so we add the | |
1398 | ;; button. | |
1399 | (gnus-article-add-button | |
1400 | start end 'gnus-button-push | |
1401 | (car (push (set-marker (make-marker) from) | |
1402 | gnus-button-marker-list)))))))))) | |
1403 | ||
1404 | ;; Add buttons to the head of an article. | |
1405 | (defun gnus-article-add-buttons-to-head () | |
1406 | "Add buttons to the head of the article." | |
1407 | (interactive) | |
1408 | (save-excursion | |
1409 | (set-buffer gnus-article-buffer) | |
1410 | (let ((buffer-read-only nil) | |
1411 | (inhibit-point-motion-hooks t) | |
1412 | (case-fold-search t) | |
1413 | (alist gnus-header-button-alist) | |
1414 | entry beg end) | |
1415 | (nnheader-narrow-to-headers) | |
1416 | (while alist | |
1417 | ;; Each alist entry. | |
1418 | (setq entry (car alist) | |
1419 | alist (cdr alist)) | |
1420 | (goto-char (point-min)) | |
1421 | (while (re-search-forward (car entry) nil t) | |
1422 | ;; Each header matching the entry. | |
1423 | (setq beg (match-beginning 0)) | |
1424 | (setq end (or (and (re-search-forward "^[^ \t]" nil t) | |
1425 | (match-beginning 0)) | |
1426 | (point-max))) | |
1427 | (goto-char beg) | |
1428 | (while (re-search-forward (nth 1 entry) end t) | |
1429 | ;; Each match within a header. | |
1430 | (let* ((from (match-beginning 0)) | |
1431 | (entry (cdr entry)) | |
1432 | (start (match-beginning (nth 1 entry))) | |
1433 | (end (match-end (nth 1 entry))) | |
1434 | (form (nth 2 entry))) | |
1435 | (goto-char (match-end 0)) | |
1436 | (and (eval form) | |
1437 | (gnus-article-add-button | |
1438 | start end (nth 3 entry) | |
1439 | (buffer-substring (match-beginning (nth 4 entry)) | |
1440 | (match-end (nth 4 entry))))))) | |
1441 | (goto-char end)))) | |
1442 | (widen))) | |
41487370 LMI |
1443 | |
1444 | ;;; External functions: | |
1445 | ||
1446 | (defun gnus-article-add-button (from to fun &optional data) | |
1447 | "Create a button between FROM and TO with callback FUN and data DATA." | |
1448 | (and gnus-article-button-face | |
1449 | (gnus-overlay-put (gnus-make-overlay from to) | |
1450 | 'face gnus-article-button-face)) | |
231f989b LMI |
1451 | (gnus-add-text-properties |
1452 | from to | |
1453 | (nconc (and gnus-article-mouse-face | |
1454 | (list gnus-mouse-face-prop gnus-article-mouse-face)) | |
1455 | (list 'gnus-callback fun) | |
1456 | (and data (list 'gnus-data data))))) | |
41487370 LMI |
1457 | |
1458 | ;;; Internal functions: | |
1459 | ||
1460 | (defun gnus-signature-toggle (end) | |
1461 | (save-excursion | |
1462 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
1463 | (let ((buffer-read-only nil) |
1464 | (inhibit-point-motion-hooks t)) | |
41487370 | 1465 | (if (get-text-property end 'invisible) |
231f989b LMI |
1466 | (gnus-unhide-text end (point-max)) |
1467 | (gnus-hide-text end (point-max) gnus-hidden-properties))))) | |
41487370 LMI |
1468 | |
1469 | (defun gnus-button-entry () | |
1470 | ;; Return the first entry in `gnus-button-alist' matching this place. | |
1471 | (let ((alist gnus-button-alist) | |
1472 | (entry nil)) | |
1473 | (while alist | |
231f989b | 1474 | (setq entry (pop alist)) |
41487370 LMI |
1475 | (if (looking-at (car entry)) |
1476 | (setq alist nil) | |
1477 | (setq entry nil))) | |
1478 | entry)) | |
1479 | ||
1480 | (defun gnus-button-push (marker) | |
1481 | ;; Push button starting at MARKER. | |
1482 | (save-excursion | |
1483 | (set-buffer gnus-article-buffer) | |
1484 | (goto-char marker) | |
1485 | (let* ((entry (gnus-button-entry)) | |
1486 | (inhibit-point-motion-hooks t) | |
1487 | (fun (nth 3 entry)) | |
1488 | (args (mapcar (lambda (group) | |
1489 | (let ((string (buffer-substring | |
1490 | (match-beginning group) | |
1491 | (match-end group)))) | |
231f989b LMI |
1492 | (gnus-set-text-properties |
1493 | 0 (length string) nil string) | |
41487370 LMI |
1494 | string)) |
1495 | (nthcdr 4 entry)))) | |
231f989b LMI |
1496 | (cond |
1497 | ((fboundp fun) | |
1498 | (apply fun args)) | |
1499 | ((and (boundp fun) | |
1500 | (fboundp (symbol-value fun))) | |
1501 | (apply (symbol-value fun) args)) | |
1502 | (t | |
1503 | (gnus-message 1 "You must define `%S' to use this button" | |
41487370 LMI |
1504 | (cons fun args))))))) |
1505 | ||
1506 | (defun gnus-button-message-id (message-id) | |
231f989b | 1507 | "Fetch MESSAGE-ID." |
41487370 LMI |
1508 | (save-excursion |
1509 | (set-buffer gnus-summary-buffer) | |
1510 | (gnus-summary-refer-article message-id))) | |
1511 | ||
231f989b LMI |
1512 | (defun gnus-button-mailto (address) |
1513 | ;; Mail to ADDRESS. | |
1514 | (set-buffer (gnus-copy-article-buffer)) | |
1515 | (message-reply address)) | |
1516 | ||
1517 | (defun gnus-button-reply (address) | |
1518 | ;; Reply to ADDRESS. | |
1519 | (message-reply address)) | |
1520 | ||
1521 | (defun gnus-button-url (address) | |
1522 | "Browse ADDRESS." | |
ea7cceff RS |
1523 | (funcall browse-url-browser-function |
1524 | ;; Zap whitespace in case <URL:...> contained it. | |
1525 | ;; (Whitespace illegal in raw URL.) | |
1526 | (let ((stripped-address address)) | |
1527 | (while (string-match "\\s +\\|\n+" stripped-address) | |
1528 | (setq stripped-address (replace-match "" t t stripped-address))) | |
1529 | stripped-address))) | |
231f989b LMI |
1530 | |
1531 | ;;; Next/prev buttons in the article buffer. | |
1532 | ||
1533 | (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") | |
1534 | (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") | |
1535 | ||
1536 | (defvar gnus-prev-page-map nil) | |
1537 | (unless gnus-prev-page-map | |
1538 | (setq gnus-prev-page-map (make-sparse-keymap)) | |
1539 | (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) | |
1540 | (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) | |
1541 | ||
1542 | (defun gnus-insert-prev-page-button () | |
1543 | (let ((buffer-read-only nil)) | |
1544 | (gnus-eval-format | |
1545 | gnus-prev-page-line-format nil | |
1546 | `(gnus-prev t local-map ,gnus-prev-page-map | |
1547 | gnus-callback gnus-article-button-prev-page)))) | |
1548 | ||
1549 | (defvar gnus-next-page-map nil) | |
1550 | (unless gnus-next-page-map | |
1551 | (setq gnus-next-page-map (make-keymap)) | |
1552 | (suppress-keymap gnus-prev-page-map) | |
1553 | (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) | |
1554 | (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) | |
1555 | ||
1556 | (defun gnus-button-next-page () | |
1557 | "Go to the next page." | |
1558 | (interactive) | |
1559 | (let ((win (selected-window))) | |
1560 | (select-window (get-buffer-window gnus-article-buffer t)) | |
1561 | (gnus-article-next-page) | |
1562 | (select-window win))) | |
1563 | ||
1564 | (defun gnus-button-prev-page () | |
1565 | "Go to the prev page." | |
1566 | (interactive) | |
1567 | (let ((win (selected-window))) | |
1568 | (select-window (get-buffer-window gnus-article-buffer t)) | |
1569 | (gnus-article-prev-page) | |
1570 | (select-window win))) | |
1571 | ||
1572 | (defun gnus-insert-next-page-button () | |
1573 | (let ((buffer-read-only nil)) | |
1574 | (gnus-eval-format gnus-next-page-line-format nil | |
1575 | `(gnus-next t local-map ,gnus-next-page-map | |
1576 | gnus-callback | |
1577 | gnus-article-button-next-page)))) | |
1578 | ||
1579 | (defun gnus-article-button-next-page (arg) | |
1580 | "Go to the next page." | |
1581 | (interactive "P") | |
1582 | (let ((win (selected-window))) | |
1583 | (select-window (get-buffer-window gnus-article-buffer t)) | |
1584 | (gnus-article-next-page) | |
1585 | (select-window win))) | |
1586 | ||
1587 | (defun gnus-article-button-prev-page (arg) | |
1588 | "Go to the prev page." | |
1589 | (interactive "P") | |
1590 | (let ((win (selected-window))) | |
1591 | (select-window (get-buffer-window gnus-article-buffer t)) | |
1592 | (gnus-article-prev-page) | |
1593 | (select-window win))) | |
1594 | ||
41487370 LMI |
1595 | ;;; Compatibility Functions: |
1596 | ||
1597 | (or (fboundp 'rassoc) | |
1598 | ;; Introduced in Emacs 19.29. | |
1599 | (defun rassoc (elt list) | |
1600 | "Return non-nil if ELT is `equal' to the cdr of an element of LIST. | |
1601 | The value is actually the element of LIST whose cdr is ELT." | |
1602 | (let (result) | |
1603 | (while list | |
1604 | (setq result (car list)) | |
1605 | (if (equal (cdr result) elt) | |
1606 | (setq list nil) | |
1607 | (setq result nil | |
1608 | list (cdr list)))) | |
1609 | result))) | |
1610 | ||
1611 | ; (require 'gnus-cus) | |
1612 | (gnus-ems-redefine) | |
1613 | (provide 'gnus-vis) | |
1614 | ||
1615 | ;;; gnus-vis.el ends here |