cgit.sxemacs.org Git - gnus/blob - lisp/gnus-vis.el

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