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