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