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

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