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