1 ;;; gnus-vis.el --- display-oriented parts of Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Per Abrahamsen <abraham@iesd.auc.dk>
8 ;; This file is part of GNU Emacs.
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)
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.
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 the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
34 (eval-when-compile (require 'cl))
36 (defvar gnus-group-menu-hook nil
37 "*Hook run after the creation of the group mode menu.")
39 (defvar gnus-summary-menu-hook nil
40 "*Hook run after the creation of the summary mode menu.")
42 (defvar gnus-article-menu-hook nil
43 "*Hook run after the creation of the article mode menu.")
45 ;;; Summary highlights.
47 ;(defvar gnus-summary-highlight-properties
48 ; '((unread "ForestGreen" "green")
49 ; (ticked "Firebrick" "pink")
50 ; (read "black" "white")
53 ; (canceled "yellow/black" "black/yellow")))
55 ;(defvar gnus-summary-highlight-translation
56 ; '(((unread (= mark gnus-unread-mark))
57 ; (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)))
58 ; (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark)
59 ; (= mark gnus-ticked-mark) (= mark gnus-canceled-mark))))
60 ; (canceled (= mark gnus-canceled-mark)))
61 ; ((low (< score gnus-summary-default-score))
62 ; (high (> score gnus-summary-default-score)))))
64 ;(defun gnus-visual-map-face-translation ()
65 ; (let ((props gnus-summary-highlight-properties)
66 ; (trans gnus-summary-highlight-translation)
71 ;(defvar gnus-summary-selected-face 'underline
72 ; "*Face used for highlighting the current article in the summary buffer.")
75 ;(defvar gnus-summary-highlight
76 ; (cond ((not (eq gnus-display-type 'color))
77 ; '(((> score default) . bold)
78 ; ((< score default) . italic)))
79 ; ((eq gnus-background-mode 'dark)
80 ; (list (cons '(= mark gnus-canceled-mark)
81 ; (custom-face-lookup "yellow" "black" nil nil nil nil))
82 ; (cons '(and (> score default)
83 ; (or (= mark gnus-dormant-mark)
84 ; (= mark gnus-ticked-mark)))
85 ; (custom-face-lookup "pink" nil nil t nil nil))
86 ; (cons '(and (< score default)
87 ; (or (= mark gnus-dormant-mark)
88 ; (= mark gnus-ticked-mark)))
89 ; (custom-face-lookup "pink" nil nil nil t nil))
90 ; (cons '(or (= mark gnus-dormant-mark)
91 ; (= mark gnus-ticked-mark))
92 ; (custom-face-lookup "pink" nil nil nil nil nil))
94 ; (cons '(and (> score default) (= mark gnus-ancient-mark))
95 ; (custom-face-lookup "SkyBlue" nil nil t nil nil))
96 ; (cons '(and (< score default) (= mark gnus-ancient-mark))
97 ; (custom-face-lookup "SkyBlue" nil nil nil t nil))
98 ; (cons '(= mark gnus-ancient-mark)
99 ; (custom-face-lookup "SkyBlue" nil nil nil nil nil))
101 ; (cons '(and (> score default) (= mark gnus-unread-mark))
102 ; (custom-face-lookup "white" nil nil t nil nil))
103 ; (cons '(and (< score default) (= mark gnus-unread-mark))
104 ; (custom-face-lookup "white" nil nil nil t nil))
105 ; (cons '(= mark gnus-unread-mark)
106 ; (custom-face-lookup "white" nil nil nil nil nil))
108 ; (cons '(> score default) 'bold)
109 ; (cons '(< score default) 'italic)))
111 ; (list (cons '(= mark gnus-canceled-mark)
112 ; (custom-face-lookup "yellow" "black" nil nil nil nil))
113 ; (cons '(and (> score default)
114 ; (or (= mark gnus-dormant-mark)
115 ; (= mark gnus-ticked-mark)))
116 ; (custom-face-lookup "firebrick" nil nil t nil nil))
117 ; (cons '(and (< score default)
118 ; (or (= mark gnus-dormant-mark)
119 ; (= mark gnus-ticked-mark)))
120 ; (custom-face-lookup "firebrick" nil nil nil t nil))
121 ; (cons '(or (= mark gnus-dormant-mark)
122 ; (= mark gnus-ticked-mark))
123 ; (custom-face-lookup "firebrick" nil nil nil nil nil))
125 ; (cons '(and (> score default) (= mark gnus-ancient-mark))
126 ; (custom-face-lookup "RoyalBlue" nil nil t nil nil))
127 ; (cons '(and (< score default) (= mark gnus-ancient-mark))
128 ; (custom-face-lookup "RoyalBlue" nil nil nil t nil))
129 ; (cons '(= mark gnus-ancient-mark)
130 ; (custom-face-lookup "RoyalBlue" nil nil nil nil nil))
132 ; (cons '(and (> score default) (/= mark gnus-unread-mark))
133 ; (custom-face-lookup "DarkGreen" nil nil t nil nil))
134 ; (cons '(and (< score default) (/= mark gnus-unread-mark))
135 ; (custom-face-lookup "DarkGreen" nil nil nil t nil))
136 ; (cons '(/= mark gnus-unread-mark)
137 ; (custom-face-lookup "DarkGreen" nil nil nil nil nil))
139 ; (cons '(> score default) 'bold)
140 ; (cons '(< score default) 'italic))))
141 ; "*Alist of `(FORM . FACE)'.
142 ;Summary lines are highlighted with the FACE for the first FORM which
143 ;evaluate to a non-nil value.
145 ;Point will be at the beginning of the line when FORM is evaluated.
146 ;The following can be used for convenience:
148 ;score: (gnus-summary-article-score)
149 ;default: gnus-summary-default-score
150 ;below: gnus-summary-mark-below
151 ;mark: (gnus-summary-article-mark)
153 ;The latter can be used like this:
154 ; ((= mark gnus-replied-mark) . underline)")
156 ;;; article highlights
159 ;(defvar gnus-header-face-alist
160 ; (cond ((not (eq gnus-display-type 'color))
161 ; '(("" bold italic)))
162 ; ((eq gnus-background-mode 'dark)
163 ; (list (list "From" nil
164 ; (custom-face-lookup "SkyBlue" nil nil t t nil))
165 ; (list "Subject" nil
166 ; (custom-face-lookup "pink" nil nil t t nil))
167 ; (list "Newsgroups:.*," nil
168 ; (custom-face-lookup "yellow" nil nil t t nil))
170 ; (custom-face-lookup "cyan" nil nil t nil nil)
171 ; (custom-face-lookup "green" nil nil nil t nil))))
173 ; (list (list "From" nil
174 ; (custom-face-lookup "RoyalBlue" nil nil t t nil))
175 ; (list "Subject" nil
176 ; (custom-face-lookup "firebrick" nil nil t t nil))
177 ; (list "Newsgroups:.*," nil
178 ; (custom-face-lookup "red" nil nil t t nil))
180 ; (custom-face-lookup "DarkGreen" nil nil t nil nil)
181 ; (custom-face-lookup "DarkGreen" nil nil nil t nil)))))
182 ; "Alist of headers and faces used for highlighting them.
183 ;The entries in the list has the form `(REGEXP NAME CONTENT)', where
184 ;REGEXP is a regular expression matching the beginning of the header,
185 ;NAME is the face used for highlighting the header name and CONTENT is
186 ;the face used for highlighting the header content.
188 ;The first non-nil NAME or CONTENT with a matching REGEXP in the list
193 ;(defvar gnus-make-foreground t
194 ; "Non nil means foreground color to highlight citations.")
197 ;(defvar gnus-article-button-face 'bold
198 ; "Face used for text buttons.")
201 ;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face)
204 ; "Face used when the mouse is over the button.")
207 ;(defvar gnus-signature-face 'italic
208 ; "Face used for signature.")
210 (defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]"
211 "*Regular expression that matches URLs.")
213 (defvar gnus-button-alist
214 `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
215 t gnus-button-message-id 3)
216 ;; This is how URLs _should_ be embedded in text...
217 ("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
218 ;; Next regexp stolen from highlight-headers.el.
219 ;; Modified by Vladimir Alexiev.
220 (,gnus-button-url-regexp 0 t gnus-button-url 0)
221 ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
222 gnus-button-message-id 3)
223 ("\\(<URL: *\\)?mailto: *\\([^ \n\t]+\\)>?" 0 t gnus-button-reply 2))
224 "Alist of regexps matching buttons in article bodies.
226 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
227 REGEXP: is the string matching text around the button,
228 BUTTON: is the number of the regexp grouping actually matching the button,
229 FORM: is a lisp expression which must eval to true for the button to
231 CALLBACK: is the function to call when the user push this button, and each
232 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
234 CALLBACK can also be a variable, in that case the value of that
235 variable it the real callback function.")
237 (defvar gnus-header-button-alist
238 `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
239 0 t gnus-button-message-id 0)
240 ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0)
241 ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
242 0 t gnus-button-mailto 0)
243 ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0))
244 "Alist of headers and regexps to match buttons in article heads.
246 This alist is very similar to `gnus-button-alist', except that each
247 alist has an additional HEADER element first in each entry:
249 \(HEADER REGEXP BUTTON FORM CALLBACK PAR)
251 HEADER is a regexp to match a header. For a fuller explanation, see
252 `gnus-button-alist'.")
256 ; (defvar browse-url-browser-function))
258 ;;; Group mode highlighting.
260 (defvar gnus-group-highlight
262 ((not (eq gnus-display-type 'color))
264 ((= unread 0) . italic)))
265 ((eq gnus-background-mode 'dark)
266 `(((> unread 200) . ,(custom-face-lookup "Red" nil nil t nil nil))
267 ((and (< level 3) (zerop unread)) .
268 ,(custom-face-lookup "SeaGreen" nil nil t nil nil))
269 ((< level 3) . ,(custom-face-lookup "SpringGreen" nil nil t nil nil))
270 ((zerop unread) . ,(custom-face-lookup "SteelBlue" nil nil t nil nil))
271 (t . ,(custom-face-lookup "SkyBlue" nil nil t nil nil))
275 ,(custom-face-lookup "ForestGreen" nil nil t nil nil))
277 ,(custom-face-lookup "Blue" nil nil t nil nil)))))
278 "Group lines are highlighted with the FACE for the first FORM which
279 evaluate to a non-nil value.
281 Point will be at the beginning of the line when FORM is evaluated.
282 Variables bound when these forms are evaluated include:
284 group: The group name.
285 unread: The number of unread articles.
286 method: The select method.
287 mailp: Whether the select method is a mail method.
288 level: The level of the group.
289 score: The score of the group.
290 ticked: The number of ticked articles in the group.
294 ;;; Internal variables.
296 (defvar gnus-button-marker-list nil)
301 (autoload 'nnkiboze-generate-groups "nnkiboze")
302 (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t))
308 (defun gnus-visual-turn-off-edit-menu (type)
309 (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
310 [menu-bar edit] 'undefined))
314 (defun gnus-group-make-menu-bar ()
315 (gnus-visual-turn-off-edit-menu 'group)
317 (boundp 'gnus-group-reading-menu)
320 gnus-group-reading-menu gnus-group-mode-map ""
322 ["Read" gnus-group-read-group t]
323 ["Select" gnus-group-select-group t]
324 ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC"]
325 ["Catch up" gnus-group-catchup-current t]
326 ["Catch up all articles" gnus-group-catchup-current-all t]
327 ["Check for new articles" gnus-group-get-new-news-this-group t]
328 ["Toggle subscription" gnus-group-unsubscribe-current-group t]
329 ["Kill" gnus-group-kill-group t]
330 ["Yank" gnus-group-yank-group t]
331 ["Describe" gnus-group-describe-group t]
332 ["Fetch FAQ" gnus-group-fetch-faq t]
333 ["Edit kill file" gnus-group-edit-local-kill t]
334 ["Expire articles" gnus-group-expire-articles t]
335 ["Set group level" gnus-group-set-current-level t]
336 ["Select quick" gnus-group-quick-select-group t]
340 gnus-group-group-menu gnus-group-mode-map ""
343 ["List subscribed groups" gnus-group-list-groups t]
344 ["List all groups" gnus-group-list-all-groups t]
345 ["List groups matching..." gnus-group-list-matching t]
346 ["List killed groups" gnus-group-list-killed t]
347 ["List zombie groups" gnus-group-list-zombies t]
348 ["List level" gnus-group-list-level t]
349 ["Describe all groups" gnus-group-describe-all-groups t]
350 ["Group apropos" gnus-group-apropos t]
351 ["Group and description apropos" gnus-group-description-apropos t]
352 ["List groups matching..." gnus-group-list-matching t]
353 ["List all groups matching..." gnus-group-list-all-matching t]
354 ["List active file" gnus-group-list-active t])
356 ["Default sort" gnus-group-sort-groups t]
357 ["Sort by method" gnus-group-sort-by-method t]
358 ["Sort by rank" gnus-group-sort-by-rank t]
359 ["Sort by score" gnus-group-sort-by-score t]
360 ["Sort by level" gnus-group-sort-by-level t]
361 ["Sort by unread" gnus-group-sort-by-unread t]
362 ["Sort by name" gnus-group-sort-by-alphabet t])
364 ["Mark group" gnus-group-mark-group t]
365 ["Unmark group" gnus-group-unmark-group t]
366 ["Unmark all" gnus-group-unmark-all-groups t]
367 ["Mark regexp" gnus-group-mark-regexp t]
368 ["Mark region" gnus-group-mark-region t]
369 ["Mark buffer" gnus-group-mark-buffer t]
370 ["Execute command" gnus-group-universal-argument t])
372 ["Subscribe to random group" gnus-group-unsubscribe-group t]
373 ["Kill all newsgroups in region" gnus-group-kill-region t]
374 ["Kill all zombie groups" gnus-group-kill-all-zombies t]
375 ["Kill all groups on level..." gnus-group-kill-level t])
377 ["Make a foreign group" gnus-group-make-group t]
378 ["Add a directory group" gnus-group-make-directory-group t]
379 ["Add the help group" gnus-group-make-help-group t]
380 ["Add the archive group" gnus-group-make-archive-group t]
381 ["Make a doc group" gnus-group-make-doc-group t]
382 ["Make a kiboze group" gnus-group-make-kiboze-group t]
383 ["Make a virtual group" gnus-group-make-empty-virtual t]
384 ["Add a group to a virtual" gnus-group-add-to-virtual t]
385 ["Rename group" gnus-group-rename-group t]
386 ["Delete group" gnus-group-delete-group t])
388 ["Parameters" gnus-group-edit-group-parameters t]
389 ["Select method" gnus-group-edit-group-method t]
390 ["Info" gnus-group-edit-group t])
392 ["Flush cache" gnus-score-flush-cache t])
394 ["Next" gnus-group-next-group t]
395 ["Previous" gnus-group-prev-group t]
396 ["Next unread" gnus-group-next-unread-group t]
397 ["Previous unread" gnus-group-prev-unread-group t]
398 ["Next unread same level" gnus-group-next-unread-group-same-level t]
399 ["Previous unread same level"
400 gnus-group-previous-unread-group-same-level t]
401 ["Jump to group" gnus-group-jump-to-group t]
402 ["First unread group" gnus-group-first-unread-group t]
403 ["Best unread group" gnus-group-best-unread-group t])
404 ["Transpose" gnus-group-transpose-groups t]
405 ["Read a directory as a group" gnus-group-enter-directory t]
409 gnus-group-misc-menu gnus-group-mode-map ""
411 ["Send a bug report" gnus-bug t]
412 ["Send a mail" gnus-group-mail t]
413 ["Post an article" gnus-group-post-news t]
414 ["Customize score file" gnus-score-customize
415 (not (string-match "XEmacs" emacs-version)) ]
416 ["Check for new news" gnus-group-get-new-news t]
417 ["Activate all groups" gnus-activate-all-groups t]
418 ["Delete bogus groups" gnus-group-check-bogus-groups t]
419 ["Find new newsgroups" gnus-find-new-newsgroups t]
420 ["Restart Gnus" gnus-group-restart t]
421 ["Read init file" gnus-group-read-init-file t]
422 ["Browse foreign server" gnus-group-browse-foreign-server t]
423 ["Enter server buffer" gnus-group-enter-server-mode t]
424 ["Expire expirable articles" gnus-group-expire-all-groups t]
425 ["Generate any kiboze groups" nnkiboze-generate-groups t]
426 ["Gnus version" gnus-version t]
427 ["Save .newsrc files" gnus-group-save-newsrc t]
428 ["Suspend Gnus" gnus-group-suspend t]
429 ["Clear dribble buffer" gnus-group-clear-dribble t]
430 ["Exit from Gnus" gnus-group-exit t]
431 ["Exit without saving" gnus-group-quit t]
432 ["Edit global kill file" gnus-group-edit-global-kill t]
433 ["Read manual" gnus-info-find-node t]
434 ["Toggle topics" gnus-topic-mode t]
436 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
437 ["Send replies" gnus-soup-send-replies
438 (fboundp 'gnus-soup-pack-packet)]
439 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
440 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
441 ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
443 (run-hooks 'gnus-group-menu-hook)
447 (defun gnus-summary-make-menu-bar ()
448 (gnus-visual-turn-off-edit-menu 'summary)
450 (unless (boundp 'gnus-summary-misc-menu)
453 gnus-summary-misc-menu gnus-summary-mode-map ""
457 ["Mark as read" gnus-summary-mark-as-read-forward t]
458 ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t]
459 ["Mark same subject" gnus-summary-kill-same-subject t]
460 ["Catchup" gnus-summary-catchup t]
461 ["Catchup all" gnus-summary-catchup-all t]
462 ["Catchup to here" gnus-summary-catchup-to-here t]
463 ["Catchup region" gnus-summary-mark-region-as-read t]
464 ["Mark excluded" gnus-summary-limit-mark-exlcuded-as-read t])
466 ["Tick" gnus-summary-tick-article-forward t]
467 ["Mark as dormant" gnus-summary-mark-as-dormant t]
468 ["Remove marks" gnus-summary-clear-mark-forward t]
469 ["Set expirable mark" gnus-summary-mark-as-expirable t]
470 ["Set bookmark" gnus-summary-set-bookmark t]
471 ["Remove bookmark" gnus-summary-remove-bookmark t])
473 ["Unread" gnus-summary-limit-to-unread t]
474 ["Marks" gnus-summary-limit-to-marks t]
475 ["Score" gnus-summary-limit-to-score t]
476 ["Subject" gnus-summary-limit-to-subject t]
477 ["Author" gnus-summary-limit-to-author t]
478 ["Non-dormant" gnus-summary-limit-exclude-dormant t]
479 ["Articles" gnus-summary-limit-to-articles t]
480 ["Pop limit" gnus-summary-pop-limit t]
481 ["Show dormant" gnus-summary-limit-include-dormant t]
482 ["Hide childless dormant"
483 gnus-summary-limit-exclude-childless-dormant t]
484 ["Hide thread" gnus-summary-limit-exclude-thread t]
485 ["Show expunged" gnus-summary-show-all-expunged t])
487 ["Set mark" gnus-summary-mark-as-processable t]
488 ["Remove mark" gnus-summary-unmark-as-processable t]
489 ["Remove all marks" gnus-summary-unmark-all-processable t]
490 ["Mark above" gnus-uu-mark-over t]
491 ["Mark series" gnus-uu-mark-series t]
492 ["Mark region" gnus-uu-mark-region t]
493 ["Mark by regexp" gnus-uu-mark-by-regexp t]
494 ["Mark all" gnus-uu-mark-all t]
495 ["Mark buffer" gnus-uu-mark-buffer t]
496 ["Mark sparse" gnus-uu-mark-sparse t]
497 ["Mark thread" gnus-uu-mark-thread t]
498 ["Unmark thread" gnus-uu-unmark-thread t]))
500 ["Page forward" gnus-summary-next-page t]
501 ["Page backward" gnus-summary-prev-page t]
502 ["Line forward" gnus-summary-scroll-up t])
504 ["Next unread article" gnus-summary-next-unread-article t]
505 ["Previous unread article" gnus-summary-prev-unread-article t]
506 ["Next article" gnus-summary-next-article t]
507 ["Previous article" gnus-summary-prev-article t]
508 ["Next unread subject" gnus-summary-next-unread-subject t]
509 ["Previous unread subject" gnus-summary-prev-unread-subject t]
510 ["Next article same subject" gnus-summary-next-same-subject t]
511 ["Previous article same subject" gnus-summary-prev-same-subject t]
512 ["First unread article" gnus-summary-first-unread-article t]
513 ["Best unread article" gnus-summary-best-unread-article t]
514 ["Go to subject number..." gnus-summary-goto-subject t]
515 ["Go to article number..." gnus-summary-goto-article t]
516 ["Go to the last article" gnus-summary-goto-last-article t]
517 ["Pop article off history" gnus-summary-pop-article t])
519 ["Sort by number" gnus-summary-sort-by-number t]
520 ["Sort by author" gnus-summary-sort-by-author t]
521 ["Sort by subject" gnus-summary-sort-by-subject t]
522 ["Sort by date" gnus-summary-sort-by-date t]
523 ["Sort by score" gnus-summary-sort-by-score t])
525 ["Catchup and exit" gnus-summary-catchup-and-exit t]
526 ["Catchup all and exit" gnus-summary-catchup-and-exit t]
527 ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
528 ["Exit group" gnus-summary-exit t]
529 ["Exit group without updating" gnus-summary-exit-no-update t]
530 ["Exit and goto next group" gnus-summary-next-group t]
531 ["Exit and goto prev group" gnus-summary-prev-group t]
532 ["Reselect group" gnus-summary-reselect-current-group t]
533 ["Rescan group" gnus-summary-rescan-group t])
535 ["Fetch group FAQ" gnus-summary-fetch-faq t]
536 ["Describe group" gnus-summary-describe-group t]
537 ["Read manual" gnus-info-find-node t])
539 ["Enter article" gnus-cache-enter-article t]
540 ["Remove article" gnus-cache-remove-article t])
542 ["Pick and read" gnus-pick-mode t]
543 ["Binary" gnus-binary-mode t])
544 ["Filter articles" gnus-summary-execute-command t]
545 ["Run command on subjects" gnus-summary-universal-argument t]
546 ["Toggle line truncation" gnus-summary-toggle-truncation t]
547 ["Expand window" gnus-summary-expand-window t]
548 ["Expire expirable articles" gnus-summary-expire-articles t]
549 ["Edit local kill file" gnus-summary-edit-local-kill t]
550 ["Edit main kill file" gnus-summary-edit-global-kill t]
554 gnus-summary-kill-menu gnus-summary-mode-map ""
559 ["Enter score" gnus-summary-score-entry t])
560 (gnus-visual-score-map 'increase)
561 (gnus-visual-score-map 'lower)
563 ["Kill below" gnus-summary-kill-below t]
564 ["Mark above" gnus-summary-mark-above t]
565 ["Tick above" gnus-summary-tick-above t]
566 ["Clear above" gnus-summary-clear-above t])
567 ["Current score" gnus-summary-current-score t]
568 ["Set score" gnus-summary-set-score t]
569 ["Customize score file" gnus-score-customize t]
570 ["Switch current score file" gnus-score-change-score-file t]
571 ["Set mark below" gnus-score-set-mark-below t]
572 ["Set expunge below" gnus-score-set-expunge-below t]
573 ["Edit current score file" gnus-score-edit-alist t]
574 ["Edit score file" gnus-score-edit-file t]
575 ["Trace score" gnus-score-find-trace t]
576 ["Rescore buffer" gnus-summary-rescore t]
577 ["Increase score" gnus-summary-increase-score t]
578 ["Lower score" gnus-summary-lower-score t]))))
581 ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
583 :selected (null gnus-score-default-header)]
584 ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
586 :selected (eq gnus-score-default-header 'a)]
587 ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
589 :selected (eq gnus-score-default-header 's)]
591 (gnus-score-set-default 'gnus-score-default-header 'b)
593 :selected (eq gnus-score-default-header 'b )]
595 (gnus-score-set-default 'gnus-score-default-header 'h)
597 :selected (eq gnus-score-default-header 'h )]
598 ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
600 :selected (eq gnus-score-default-header 'i )]
601 ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
603 :selected (eq gnus-score-default-header 't )]
605 (gnus-score-set-default 'gnus-score-default-header 'x)
607 :selected (eq gnus-score-default-header 'x )]
608 ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
610 :selected (eq gnus-score-default-header 'l )]
611 ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
613 :selected (eq gnus-score-default-header 'd )]
614 ["Followups to author"
615 (gnus-score-set-default 'gnus-score-default-header 'f)
617 :selected (eq gnus-score-default-header 'f )])
619 ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
621 :selected (null gnus-score-default-type)]
622 ;; The `:active' key is commented out in the following,
623 ;; because the GNU Emacs hack to support radio buttons use
624 ;; active to indicate which button is selected.
625 ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
627 ;; :active (not (memq gnus-score-default-header '(l d)))
628 :selected (eq gnus-score-default-type 's)]
629 ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
631 ;; :active (not (memq gnus-score-default-header '(l d)))
632 :selected (eq gnus-score-default-type 'r)]
633 ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
635 ;; :active (not (memq gnus-score-default-header '(l d)))
636 :selected (eq gnus-score-default-type 'e)]
637 ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
639 ;; :active (not (memq gnus-score-default-header '(l d)))
640 :selected (eq gnus-score-default-type 'f)]
641 ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
643 ;; :active (eq (gnus-score-default-header 'd))
644 :selected (eq gnus-score-default-type 'b)]
645 ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
647 ;; :active (eq (gnus-score-default-header 'd))
648 :selected (eq gnus-score-default-type 'n)]
649 ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
651 ;; :active (eq (gnus-score-default-header 'd))
652 :selected (eq gnus-score-default-type 'a)]
654 (gnus-score-set-default 'gnus-score-default-type '<)
656 ;; :active (eq (gnus-score-default-header 'l))
657 :selected (eq gnus-score-default-type '<)]
659 (gnus-score-set-default 'gnus-score-default-type '=)
661 ;; :active (eq (gnus-score-default-header 'l))
662 :selected (eq gnus-score-default-type '=)]
663 ["Greater than number"
664 (gnus-score-set-default 'gnus-score-default-type '>)
666 ;; :active (eq (gnus-score-default-header 'l))
667 :selected (eq gnus-score-default-type '>)])
668 ["Default fold" gnus-score-default-fold-toggle
670 :selected gnus-score-default-fold]
672 ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
674 :selected (null gnus-score-default-duration)]
676 (gnus-score-set-default 'gnus-score-default-duration 'p)
678 :selected (eq gnus-score-default-duration 'p)]
680 (gnus-score-set-default 'gnus-score-default-duration 't)
682 :selected (eq gnus-score-default-duration 't)]
684 (gnus-score-set-default 'gnus-score-default-duration 'i)
686 :selected (eq gnus-score-default-duration 'i)]))
689 gnus-summary-article-menu gnus-summary-mode-map ""
692 ["All" gnus-article-hide t]
693 ["Headers" gnus-article-hide-headers t]
694 ["Signature" gnus-article-hide-signature t]
695 ["Citation" gnus-article-hide-citation t]
696 ["PGP" gnus-article-hide-pgp t]
697 ["Boring headers" gnus-article-hide-boring-headers t])
699 ["All" gnus-article-highlight t]
700 ["Headers" gnus-article-highlight-headers t]
701 ["Signature" gnus-article-highlight-signature t]
702 ["Citation" gnus-article-highlight-citation t])
704 ["Local" gnus-article-date-local t]
705 ["UT" gnus-article-date-ut t]
706 ["Original" gnus-article-date-original t]
707 ["Lapsed" gnus-article-date-lapsed t])
709 ["Overstrike" gnus-article-treat-overstrike t]
710 ["Word wrap" gnus-article-fill-cited-article t]
711 ["CR" gnus-article-remove-cr t]
712 ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t]
713 ["Show X-Face" gnus-article-display-x-face t]
714 ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
715 ["Rot 13" gnus-summary-caesar-message t]
716 ["Add buttons" gnus-article-add-buttons t]
717 ["Add buttons to head" gnus-article-add-buttons-to-head t]
718 ["Stop page breaking" gnus-summary-stop-page-breaking t]
719 ["Toggle MIME" gnus-summary-toggle-mime t]
720 ["Verbose header" gnus-summary-verbose-headers t]
721 ["Toggle header" gnus-summary-toggle-header t])
723 ["Save in default format" gnus-summary-save-article t]
724 ["Save in file" gnus-summary-save-article-file t]
725 ["Save in Unix mail format" gnus-summary-save-article-mail t]
726 ["Save in MH folder" gnus-summary-save-article-folder t]
727 ["Save in VM folder" gnus-summary-save-article-vm t]
728 ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
729 ["Save body in file" gnus-summary-save-article-body-file t]
730 ["Pipe through a filter" gnus-summary-pipe-output t]
731 ["Add to SOUP packet" gnus-soup-add-article t])
733 ["Respool article" gnus-summary-respool-article t]
734 ["Move article" gnus-summary-move-article t]
735 ["Copy article" gnus-summary-copy-article t]
736 ["Crosspost article" gnus-summary-crosspost-article t]
737 ["Import file" gnus-summary-import-article t]
738 ["Edit article" gnus-summary-edit-article t]
739 ["Delete article" gnus-summary-delete-article t]
740 ["Query respool" gnus-summary-respool-query t]
741 ["Delete expirable articles" gnus-summary-expire-articles-now t])
743 ["Uudecode" gnus-uu-decode-uu t]
744 ["Uudecode and save" gnus-uu-decode-uu-and-save t]
745 ["Unshar" gnus-uu-decode-unshar t]
746 ["Unshar and save" gnus-uu-decode-unshar-and-save t]
747 ["Save" gnus-uu-decode-save t]
748 ["Binhex" gnus-uu-decode-binhex t]
749 ["Postscript" gnus-uu-decode-postscript t])
750 ["Enter digest buffer" gnus-summary-enter-digest-group t]
751 ["Isearch article" gnus-summary-isearch-article t]
752 ["Search articles forward" gnus-summary-search-article-forward t]
753 ["Search articles backward" gnus-summary-search-article-backward t]
754 ["Beginning of the article" gnus-summary-beginning-of-article t]
755 ["End of the article" gnus-summary-end-of-article t]
756 ["Fetch parent of article" gnus-summary-refer-parent-article t]
757 ["Fetch referenced articles" gnus-summary-refer-references t]
758 ["Fetch article with id..." gnus-summary-refer-article t]
759 ["Redisplay" gnus-summary-show-article t]))
764 gnus-summary-thread-menu gnus-summary-mode-map ""
766 ["Toggle threading" gnus-summary-toggle-threads t]
767 ["Hide threads" gnus-summary-hide-all-threads t]
768 ["Show threads" gnus-summary-show-all-threads t]
769 ["Hide thread" gnus-summary-hide-thread t]
770 ["Show thread" gnus-summary-show-thread t]
771 ["Go to next thread" gnus-summary-next-thread t]
772 ["Go to previous thread" gnus-summary-prev-thread t]
773 ["Go down thread" gnus-summary-down-thread t]
774 ["Go up thread" gnus-summary-up-thread t]
775 ["Top of thread" gnus-summary-top-thread t]
776 ["Mark thread as read" gnus-summary-kill-thread t]
777 ["Lower thread score" gnus-summary-lower-thread t]
778 ["Raise thread score" gnus-summary-raise-thread t]
779 ["Rethread current" gnus-summary-rethread-current t]
783 gnus-summary-post-menu gnus-summary-mode-map ""
785 ["Post an article" gnus-summary-post-news t]
786 ["Followup" gnus-summary-followup t]
787 ["Followup and yank" gnus-summary-followup-with-original t]
788 ["Supersede article" gnus-summary-supersede-article t]
789 ["Cancel article" gnus-summary-cancel-article t]
790 ["Reply" gnus-summary-reply t]
791 ["Reply and yank" gnus-summary-reply-with-original t]
792 ["Mail forward" gnus-summary-mail-forward t]
793 ["Post forward" gnus-summary-post-forward t]
794 ["Digest and mail" gnus-uu-digest-mail-forward t]
795 ["Digest and post" gnus-uu-digest-post-forward t]
796 ["Resend message" gnus-summary-resend-message t]
797 ["Send bounced mail" gnus-summary-resend-bounced-mail t]
798 ["Send a mail" gnus-summary-mail-other-window t]
799 ["Reply & followup" gnus-summary-followup-and-reply t]
800 ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t]
801 ["Uuencode and post" gnus-uu-post-news t]
803 ["Send" gnus-summary-send-draft t]
804 ["Send bounced" gnus-resend-bounced-mail t])
806 (run-hooks 'gnus-summary-menu-hook)
809 (defun gnus-score-set-default (var value)
810 "A version of set that updates the GNU Emacs menu-bar."
812 ;; It is the message that forces the active status to be updated.
815 (defun gnus-visual-score-map (type)
818 (let ((headers '(("author" "from" string)
819 ("subject" "subject" string)
820 ("article body" "body" string)
821 ("article head" "head" string)
822 ("xref" "xref" string)
823 ("lines" "lines" number)
824 ("followups to author" "followup" string)))
825 (types '((number ("less than" <)
828 (string ("substring" s)
832 (perms '(("temporary" (current-time-string))
845 (setq header (car headers))
851 (let ((ts (cdr (assoc (nth 2 header) types)))
867 'gnus-summary-score-entry
869 (if (or (string= (nth 1 header)
871 (string= (nth 1 header)
874 (list 'gnus-summary-header
876 (list 'quote (nth 1 (car ts)))
877 (list 'gnus-score-default nil)
883 (list (nreverse outp))))
886 (list (nreverse outt))))
888 (setq headers (cdr headers)))
889 (list (nreverse outh))))))))
892 (defun gnus-article-make-menu-bar ()
893 (gnus-visual-turn-off-edit-menu 'summary)
895 (boundp 'gnus-article-article-menu)
898 gnus-article-article-menu gnus-article-mode-map ""
900 ["Scroll forwards" gnus-article-goto-next-page t]
901 ["Scroll backwards" gnus-article-goto-prev-page t]
902 ["Show summary" gnus-article-show-summary t]
903 ["Fetch Message-ID at point" gnus-article-refer-article t]
904 ["Mail to address at point" gnus-article-mail t]
908 gnus-article-treatment-menu gnus-article-mode-map ""
910 ["Hide headers" gnus-article-hide-headers t]
911 ["Hide signature" gnus-article-hide-signature t]
912 ["Hide citation" gnus-article-hide-citation t]
913 ["Treat overstrike" gnus-article-treat-overstrike t]
914 ["Remove carriage return" gnus-article-remove-cr t]
915 ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
917 (run-hooks 'gnus-article-menu-hook))))
920 ;;; summary highlights
923 (defun gnus-highlight-selected-summary ()
924 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
925 ;; Highlight selected article in summary buffer
926 (if gnus-summary-selected-face
928 (let* ((beg (progn (beginning-of-line) (point)))
929 (end (progn (end-of-line) (point)))
930 ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
931 (from (if (get-text-property beg gnus-mouse-face-prop)
933 (1+ (or (next-single-property-change
934 beg gnus-mouse-face-prop nil end)
936 (to (1- (or (next-single-property-change
937 from gnus-mouse-face-prop nil end)
939 ;; If no mouse-face prop on line (e.g. xemacs) we
940 ;; will have to = from = end, so we highlight the
941 ;; entire line instead.
942 (if (= (+ to 2) from)
946 (if gnus-newsgroup-selected-overlay
947 (gnus-move-overlay gnus-newsgroup-selected-overlay
948 from to (current-buffer))
949 (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
950 (gnus-overlay-put gnus-newsgroup-selected-overlay 'face
951 gnus-summary-selected-face))))))
953 ;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
954 (defun gnus-summary-highlight-line ()
955 "Highlight current line according to `gnus-summary-highlight'."
956 (let* ((list gnus-summary-highlight)
958 (end (progn (end-of-line) (point)))
959 ;; now find out where the line starts and leave point there.
960 (beg (progn (beginning-of-line) (point)))
961 (article (gnus-summary-article-number))
962 (score (or (cdr (assq (or article gnus-current-article)
963 gnus-newsgroup-scored))
964 gnus-summary-default-score 0))
965 (default gnus-summary-default-score)
966 (mark (or (gnus-summary-article-mark) gnus-unread-mark))
967 (inhibit-read-only t))
968 ;; Eval the cars of the lists until we find a match.
970 (not (eval (caar list))))
971 (setq list (cdr list)))
972 (let ((face (cdar list)))
973 (unless (eq face (get-text-property beg 'face))
976 (setq face (if (boundp face) (symbol-value face) face)))
977 (when gnus-summary-highlight-line-function
978 (funcall gnus-summary-highlight-line-function article face))))
981 (defun gnus-group-highlight-line ()
982 "Highlight the current line according to `gnus-group-highlight'."
983 (let* ((list gnus-group-highlight)
985 (end (progn (end-of-line) (point)))
986 ;; now find out where the line starts and leave point there.
987 (beg (progn (beginning-of-line) (point)))
988 (group (gnus-group-group-name))
989 (entry (gnus-group-entry group))
990 (unread (if (numberp (car entry)) (car entry) 0))
992 (method (gnus-server-get-method group (gnus-info-method info)))
993 (marked (gnus-info-marks info))
994 (mailp (memq 'mail (assoc (symbol-name
995 (car (or method gnus-select-method)))
996 gnus-valid-select-methods)))
997 (level (or (gnus-info-level info) 9))
998 (score (or (gnus-info-score info) 0))
999 (ticked (gnus-range-length (cdr (assq 'tick marked))))
1000 (inhibit-read-only t))
1001 ;; Eval the cars of the lists until we find a match.
1003 (not (eval (caar list))))
1004 (setq list (cdr list)))
1005 (let ((face (cdar list)))
1006 (unless (eq face (get-text-property beg 'face))
1009 (setq face (if (boundp face) (symbol-value face) face)))
1010 (gnus-extent-start-open beg)))
1017 (defvar gnus-carpal-group-buffer-buttons
1018 '(("next" . gnus-group-next-unread-group)
1019 ("prev" . gnus-group-prev-unread-group)
1020 ("read" . gnus-group-read-group)
1021 ("select" . gnus-group-select-group)
1022 ("catch-up" . gnus-group-catchup-current)
1023 ("new-news" . gnus-group-get-new-news-this-group)
1024 ("toggle-sub" . gnus-group-unsubscribe-current-group)
1025 ("subscribe" . gnus-group-unsubscribe-group)
1026 ("kill" . gnus-group-kill-group)
1027 ("yank" . gnus-group-yank-group)
1028 ("describe" . gnus-group-describe-group)
1030 ("subscribed" . gnus-group-list-groups)
1031 ("all" . gnus-group-list-all-groups)
1032 ("killed" . gnus-group-list-killed)
1033 ("zombies" . gnus-group-list-zombies)
1034 ("matching" . gnus-group-list-matching)
1035 ("post" . gnus-group-post-news)
1036 ("mail" . gnus-group-mail)
1037 ("rescan" . gnus-group-get-new-news)
1038 ("browse-foreign" . gnus-group-browse-foreign)
1039 ("exit" . gnus-group-exit)))
1041 (defvar gnus-carpal-summary-buffer-buttons
1043 ("read" . gnus-summary-mark-as-read-forward)
1044 ("tick" . gnus-summary-tick-article-forward)
1045 ("clear" . gnus-summary-clear-mark-forward)
1046 ("expirable" . gnus-summary-mark-as-expirable)
1048 ("scroll" . gnus-summary-next-page)
1049 ("next-unread" . gnus-summary-next-unread-article)
1050 ("prev-unread" . gnus-summary-prev-unread-article)
1051 ("first" . gnus-summary-first-unread-article)
1052 ("best" . gnus-summary-best-unread-article)
1054 ("headers" . gnus-summary-toggle-header)
1055 ("uudecode" . gnus-uu-decode-uu)
1056 ("enter-digest" . gnus-summary-enter-digest-group)
1057 ("fetch-parent" . gnus-summary-refer-parent-article)
1059 ("move" . gnus-summary-move-article)
1060 ("copy" . gnus-summary-copy-article)
1061 ("respool" . gnus-summary-respool-article)
1063 ("lower" . gnus-summary-lower-thread)
1064 ("kill" . gnus-summary-kill-thread)
1066 ("post" . gnus-summary-post-news)
1067 ("mail" . gnus-summary-mail)
1068 ("followup" . gnus-summary-followup-with-original)
1069 ("reply" . gnus-summary-reply-with-original)
1070 ("cancel" . gnus-summary-cancel-article)
1072 ("exit" . gnus-summary-exit)
1073 ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
1075 (defvar gnus-carpal-server-buffer-buttons
1076 '(("add" . gnus-server-add-server)
1077 ("browse" . gnus-server-browse-server)
1078 ("list" . gnus-server-list-servers)
1079 ("kill" . gnus-server-kill-server)
1080 ("yank" . gnus-server-yank-server)
1081 ("copy" . gnus-server-copy-server)
1082 ("exit" . gnus-server-exit)))
1084 (defvar gnus-carpal-browse-buffer-buttons
1085 '(("subscribe" . gnus-browse-unsubscribe-current-group)
1086 ("exit" . gnus-browse-exit)))
1088 (defvar gnus-carpal-group-buffer "*Carpal Group*")
1089 (defvar gnus-carpal-summary-buffer "*Carpal Summary*")
1090 (defvar gnus-carpal-server-buffer "*Carpal Server*")
1091 (defvar gnus-carpal-browse-buffer "*Carpal Browse*")
1093 (defvar gnus-carpal-attached-buffer nil)
1095 (defvar gnus-carpal-mode-hook nil
1096 "*Hook run in carpal mode buffers.")
1098 (defvar gnus-carpal-button-face 'bold
1099 "*Face used on carpal buttons.")
1101 (defvar gnus-carpal-header-face 'bold-italic
1102 "*Face used on carpal buffer headers.")
1104 (defvar gnus-carpal-mode-map nil)
1105 (put 'gnus-carpal-mode 'mode-class 'special)
1107 (if gnus-carpal-mode-map
1109 (setq gnus-carpal-mode-map (make-keymap))
1110 (suppress-keymap gnus-carpal-mode-map)
1111 (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
1112 (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
1113 (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
1115 (defun gnus-carpal-mode ()
1116 "Major mode for clicking buttons.
1118 All normal editing commands are switched off.
1119 \\<gnus-carpal-mode-map>
1120 The following commands are available:
1122 \\{gnus-carpal-mode-map}"
1124 (kill-all-local-variables)
1125 (setq mode-line-modified "-- ")
1126 (setq major-mode 'gnus-carpal-mode)
1127 (setq mode-name "Gnus Carpal")
1128 (setq mode-line-process nil)
1129 (use-local-map gnus-carpal-mode-map)
1130 (buffer-disable-undo (current-buffer))
1131 (setq buffer-read-only t)
1132 (make-local-variable 'gnus-carpal-attached-buffer)
1133 (run-hooks 'gnus-carpal-mode-hook))
1135 (defun gnus-carpal-setup-buffer (type)
1136 (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
1137 (if (get-buffer buffer)
1140 (set-buffer (get-buffer-create buffer))
1142 (setq gnus-carpal-attached-buffer
1143 (intern (format "gnus-%s-buffer" type)))
1144 (gnus-add-current-to-buffer-list)
1145 (let ((buttons (symbol-value
1146 (intern (format "gnus-carpal-%s-buffer-buttons"
1148 (buffer-read-only nil)
1151 (setq button (car buttons)
1152 buttons (cdr buttons))
1153 (if (stringp button)
1154 (gnus-set-text-properties
1156 (prog2 (insert button) (point) (insert " "))
1157 (list 'face gnus-carpal-header-face))
1158 (gnus-set-text-properties
1160 (prog2 (insert (car button)) (point) (insert " "))
1161 (list 'gnus-callback (cdr button)
1162 'face gnus-carpal-button-face
1163 gnus-mouse-face-prop 'highlight))))
1164 (let ((fill-column (- (window-width) 2)))
1165 (fill-region (point-min) (point-max)))
1166 (set-window-point (get-buffer-window (current-buffer))
1169 (defun gnus-carpal-select ()
1170 "Select the button under point."
1172 (let ((func (get-text-property (point) 'gnus-callback)))
1175 (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
1176 (call-interactively func))))
1178 (defun gnus-carpal-mouse-select (event)
1179 "Select the button under the mouse pointer."
1181 (mouse-set-point event)
1182 (gnus-carpal-select))
1185 ;;; article highlights
1188 ;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
1190 ;;; Internal Variables:
1192 (defvar gnus-button-regexp nil)
1193 ;; Regexp matching any of the regexps from `gnus-button-alist'.
1195 (defvar gnus-button-last nil)
1196 ;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
1200 (defun gnus-article-push-button (event)
1201 "Check text under the mouse pointer for a callback function.
1202 If the text under the mouse pointer has a `gnus-callback' property,
1203 call it with the value of the `gnus-data' text property."
1205 (set-buffer (window-buffer (posn-window (event-start event))))
1206 (let* ((pos (posn-point (event-start event)))
1207 (data (get-text-property pos 'gnus-data))
1208 (fun (get-text-property pos 'gnus-callback)))
1209 (if fun (funcall fun data))))
1211 (defun gnus-article-press-button ()
1212 "Check text at point for a callback function.
1213 If the text at point has a `gnus-callback' property,
1214 call it with the value of the `gnus-data' text property."
1216 (let* ((data (get-text-property (point) 'gnus-data))
1217 (fun (get-text-property (point) 'gnus-callback)))
1218 (if fun (funcall fun data))))
1220 (defun gnus-article-prev-button (n)
1221 "Move point to N buttons backward.
1222 If N is negative, move forward instead."
1224 (gnus-article-next-button (- n)))
1226 (defun gnus-article-next-button (n)
1227 "Move point to N buttons forward.
1228 If N is negative, move backward instead."
1230 (let ((function (if (< n 0) 'prev-single-property-change
1231 'next-single-property-change))
1232 (inhibit-point-motion-hooks t)
1233 (limit (if (< n 0) (point-min) (point-max))))
1235 (while (and (not (= limit (point)))
1237 ;; Skip past the current button.
1238 (when (get-text-property (point) 'gnus-callback)
1239 (goto-char (funcall function (point) 'gnus-callback nil limit)))
1240 ;; Go to the next (or previous) button.
1241 (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
1242 ;; Skip past intangible buttons.
1243 (when (get-text-property (point) 'intangible)
1247 (gnus-message 5 "No more buttons"))
1250 (defun gnus-article-highlight (&optional force)
1251 "Highlight current article.
1252 This function calls `gnus-article-highlight-headers',
1253 `gnus-article-highlight-citation',
1254 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
1255 do the highlighting. See the documentation for those functions."
1256 (interactive (list 'force))
1257 (gnus-article-highlight-headers)
1258 (gnus-article-highlight-citation force)
1259 (gnus-article-highlight-signature)
1260 (gnus-article-add-buttons force)
1261 (gnus-article-add-buttons-to-head))
1263 (defun gnus-article-highlight-some (&optional force)
1264 "Highlight current article.
1265 This function calls `gnus-article-highlight-headers',
1266 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
1267 do the highlighting. See the documentation for those functions."
1268 (interactive (list 'force))
1269 (gnus-article-highlight-headers)
1270 (gnus-article-highlight-signature)
1271 (gnus-article-add-buttons))
1273 (defun gnus-article-highlight-headers ()
1274 "Highlight article headers as specified by `gnus-header-face-alist'."
1277 (set-buffer gnus-article-buffer)
1279 (let ((alist gnus-header-face-alist)
1280 (buffer-read-only nil)
1281 (case-fold-search t)
1282 (inhibit-point-motion-hooks t)
1283 entry regexp header-face field-face from hpoints fpoints)
1284 (goto-char (point-min))
1285 (when (search-forward "\n\n" nil t)
1286 (narrow-to-region (1- (point)) (point-min))
1287 (while (setq entry (pop alist))
1288 (goto-char (point-min))
1289 (setq regexp (concat "^\\("
1290 (if (string-equal "" (nth 0 entry))
1294 header-face (nth 1 entry)
1295 field-face (nth 2 entry))
1296 (while (and (re-search-forward regexp nil t)
1300 (search-forward ":" nil t)
1301 (when (and header-face
1302 (not (memq (point) hpoints)))
1303 (push (point) hpoints)
1304 (put-text-property from (point) 'face header-face))
1305 (when (and field-face
1306 (not (memq (setq from (point)) fpoints)))
1308 (if (re-search-forward "^[^ \t]" nil t)
1310 (goto-char (point-max)))
1311 (put-text-property from (point) 'face field-face)))))))))
1313 (defun gnus-article-highlight-signature ()
1314 "Highlight the signature in an article.
1315 It does this by highlighting everything after
1316 `gnus-signature-separator' using `gnus-signature-face'."
1319 (set-buffer gnus-article-buffer)
1320 (let ((buffer-read-only nil)
1321 (inhibit-point-motion-hooks t))
1323 (when (and gnus-signature-face
1324 (gnus-narrow-to-signature))
1325 (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
1326 'face gnus-signature-face)
1328 (re-search-backward gnus-signature-separator nil t)
1329 (let ((start (match-beginning 0))
1330 (end (set-marker (make-marker) (match-end 0))))
1331 (gnus-article-add-button start end 'gnus-signature-toggle
1334 (defun gnus-article-add-buttons (&optional force)
1335 "Find external references in the article and make buttons of them.
1336 \"External references\" are things like Message-IDs and URLs, as
1337 specified by `gnus-button-alist'."
1338 (interactive (list 'force))
1340 (set-buffer gnus-article-buffer)
1341 ;; Remove all old markers.
1342 (while gnus-button-marker-list
1343 (set-marker (pop gnus-button-marker-list) nil))
1344 (let ((buffer-read-only nil)
1345 (inhibit-point-motion-hooks t)
1346 (case-fold-search t)
1347 (alist gnus-button-alist)
1349 (goto-char (point-min))
1350 ;; We skip the headers.
1351 (unless (search-forward "\n\n" nil t)
1352 (goto-char (point-max)))
1354 (while (setq entry (pop alist))
1355 (setq regexp (car entry))
1357 (while (re-search-forward regexp nil t)
1358 (let* ((start (and entry (match-beginning (nth 1 entry))))
1359 (end (and entry (match-end (nth 1 entry))))
1360 (from (match-beginning 0)))
1361 (when (or (eq t (nth 1 entry))
1362 (eval (nth 1 entry)))
1363 ;; That optional form returned non-nil, so we add the
1365 (gnus-article-add-button
1366 start end 'gnus-button-push
1367 (car (push (set-marker (make-marker) from)
1368 gnus-button-marker-list))))))))))
1370 ;; Add buttons to the head of an article.
1371 (defun gnus-article-add-buttons-to-head ()
1372 "Add buttons to the head of the article."
1375 (set-buffer gnus-article-buffer)
1376 (let ((buffer-read-only nil)
1377 (inhibit-point-motion-hooks t)
1378 (case-fold-search t)
1379 (alist gnus-header-button-alist)
1381 (nnheader-narrow-to-headers)
1383 ;; Each alist entry.
1384 (setq entry (car alist)
1386 (goto-char (point-min))
1387 (while (re-search-forward (car entry) nil t)
1388 ;; Each header matching the entry.
1389 (setq beg (match-beginning 0))
1390 (setq end (or (and (re-search-forward "^[^ \t]" nil t)
1391 (match-beginning 0))
1394 (while (re-search-forward (nth 1 entry) end t)
1395 ;; Each match within a header.
1396 (let* ((from (match-beginning 0))
1398 (start (match-beginning (nth 1 entry)))
1399 (end (match-end (nth 1 entry)))
1400 (form (nth 2 entry)))
1401 (goto-char (match-end 0))
1403 (gnus-article-add-button
1404 start end (nth 3 entry)
1405 (buffer-substring (match-beginning (nth 4 entry))
1406 (match-end (nth 4 entry)))))))
1410 ;;; External functions:
1412 (defun gnus-article-add-button (from to fun &optional data)
1413 "Create a button between FROM and TO with callback FUN and data DATA."
1414 (and gnus-article-button-face
1415 (gnus-overlay-put (gnus-make-overlay from to)
1416 'face gnus-article-button-face))
1417 (add-text-properties
1419 (nconc (and gnus-article-mouse-face
1420 (list gnus-mouse-face-prop gnus-article-mouse-face))
1421 (list 'gnus-callback fun)
1422 (and data (list 'gnus-data data)))))
1424 ;;; Internal functions:
1426 (defun gnus-signature-toggle (end)
1428 (set-buffer gnus-article-buffer)
1429 (let ((buffer-read-only nil)
1430 (inhibit-point-motion-hooks t))
1431 (if (get-text-property end 'invisible)
1432 (remove-text-properties end (point-max) gnus-hidden-properties)
1433 (add-text-properties end (point-max) gnus-hidden-properties)))))
1435 (defun gnus-button-entry ()
1436 ;; Return the first entry in `gnus-button-alist' matching this place.
1437 (let ((alist gnus-button-alist)
1440 (setq entry (pop alist))
1441 (if (looking-at (car entry))
1446 (defun gnus-button-push (marker)
1447 ;; Push button starting at MARKER.
1449 (set-buffer gnus-article-buffer)
1451 (let* ((entry (gnus-button-entry))
1452 (inhibit-point-motion-hooks t)
1454 (args (mapcar (lambda (group)
1455 (let ((string (buffer-substring
1456 (match-beginning group)
1457 (match-end group))))
1458 (gnus-set-text-properties
1459 0 (length string) nil string)
1462 (cond ((fboundp fun)
1465 (fboundp (symbol-value fun)))
1466 (apply (symbol-value fun) args))
1468 (message "You must define `%S' to use this button"
1469 (cons fun args)))))))
1471 (defun gnus-button-message-id (message-id)
1474 (set-buffer gnus-summary-buffer)
1475 (gnus-summary-refer-article message-id)))
1477 (defun gnus-button-mailto (address)
1479 (gnus-new-mail address))
1481 (defun gnus-button-reply (address)
1482 ;; Reply to ADDRESS.
1483 (gnus-mail-reply t address))
1485 (defun gnus-button-url (address)
1487 (funcall browse-url-browser-function address))
1489 ;;; Next/prev buttons in the article buffer.
1491 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
1492 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
1494 (defvar gnus-prev-page-map nil)
1495 (unless gnus-prev-page-map
1496 (setq gnus-prev-page-map (make-sparse-keymap))
1497 (define-key gnus-prev-page-map gnus-mouse-2 'gnus-article-prev-page)
1498 (define-key gnus-prev-page-map "\r" 'gnus-article-prev-page))
1500 (defun gnus-insert-prev-page-button ()
1501 (let ((buffer-read-only nil))
1503 gnus-prev-page-line-format nil
1504 `(gnus-prev t local-map ,gnus-prev-page-map
1505 gnus-callback gnus-article-prev-page))))
1507 (defvar gnus-next-page-map nil)
1508 (unless gnus-next-page-map
1509 (setq gnus-next-page-map (make-keymap))
1510 (suppress-keymap gnus-prev-page-map)
1511 (define-key gnus-next-page-map gnus-mouse-2 'gnus-article-next-page)
1512 (define-key gnus-next-page-map "\r" 'gnus-article-next-page))
1514 (defun gnus-insert-next-page-button ()
1515 (let ((buffer-read-only nil))
1516 (gnus-eval-format gnus-next-page-line-format nil
1517 `(gnus-next t local-map ,gnus-next-page-map
1518 gnus-callback gnus-article-prev-page))))
1520 ;;; Compatibility Functions:
1522 (or (fboundp 'rassoc)
1523 ;; Introduced in Emacs 19.29.
1524 (defun rassoc (elt list)
1525 "Return non-nil if ELT is `equal' to the cdr of an element of LIST.
1526 The value is actually the element of LIST whose cdr is ELT."
1529 (setq result (car list))
1530 (if (equal (cdr result) elt)
1536 ; (require 'gnus-cus)
1540 ;;; gnus-vis.el ends here